mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00
Code Issues Projects Releases Wiki Activity

Make cl-print respect print-level and print-length (bug#31559)

Browse source 
* lisp/emacs-lisp/cl-print.el (cl-print--depth): New variable.
(cl-print-object) <cons>: Print ellipsis if printing depth greater
than 'print-level' or length of list greater than 'print-length'.
(cl-print-object) <vector>: Truncate printing with ellipsis if
vector is longer than 'print-length'.
(cl-print-object) <cl-structure-object>: Truncate printing with
ellipsis if structure has more slots than 'print-length'.
(cl-print-object) <:around>: Bind 'cl-print--depth'.
* test/lisp/emacs-lisp/cl-print-tests.el
(cl-print-tests-3, cl-print-tests-4): New tests.

(cherry picked from commit 0f48d18fd2)
This commit is contained in:
Gemini Lasswell 2018-05-27 11:38:00 -07:00
parent 03697e648c
commit 5d448ca98c
2 changed files with 93 additions and 47 deletions
Download patch file Download diff file Expand all files Collapse all files

25
test/lisp/emacs-lisp/cl-print-tests.el
View file

@ -47,6 +47,31 @@
"\\`(#1=#s(foo 1 2 3) #1#)\\'"
(cl-prin1-to-string (list x x)))))))
(cl-defstruct (cl-print-tests-struct
(:constructor cl-print-tests-con))
a b c d e)
(ert-deftest cl-print-tests-3 ()
"CL printing observes `print-length'."
(let ((long-list (make-list 5 'a))
(long-vec (make-vector 5 'b))
(long-struct (cl-print-tests-con))
(print-length 4))
(should (equal "(a a a a ...)" (cl-prin1-to-string long-list)))
(should (equal "[b b b b ...]" (cl-prin1-to-string long-vec)))
(should (equal "#s(cl-print-tests-struct :a nil :b nil :c nil :d nil ...)"
(cl-prin1-to-string long-struct)))))
(ert-deftest cl-print-tests-4 ()
"CL printing observes `print-level'."
(let ((deep-list '(a (b (c (d (e))))))
(deep-struct (cl-print-tests-con))
(print-level 4))
(setf (cl-print-tests-struct-a deep-struct) deep-list)
(should (equal "(a (b (c (d ...))))" (cl-prin1-to-string deep-list)))
(should (equal "#s(cl-print-tests-struct :a (a (b (c ...))) :b nil :c nil :d nil :e nil)"
(cl-prin1-to-string deep-struct)))))
(ert-deftest cl-print-circle ()
(let ((x '(#1=(a . #1#) #1#)))
(let ((print-circle nil))