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

* 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.

1 files changed, 25 insertions, 0 deletions

diff --git a/test/lisp/emacs-lisp/cl-print-tests.el b/test/lisp/emacs-lisp/cl-print-tests.el
index d986c4015d7..bfce4a16cec 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -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))