[Emacs-diffs] emacs-26 9552485 06/10: Fix cl-print for circular sublists (Bug#31146)

[Noam Postavsky]

branch: emacs-26
commit 9552485c4d471a02cd3973d4458d8513a81f9c85
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>

    Fix cl-print for circular sublists (Bug#31146)
    
    * lisp/emacs-lisp/cl-print.el (cl-print-object) <cons>: Push each
    element of list being printed onto cl-print--currently-printing.
    * test/lisp/emacs-lisp/cl-print-tests.el (cl-print-circle-2): New
    test.
    
    (cherry picked from commit b8aa7ecf54c9b164a59f1b0e9f9fe90531dadd20)
---
 lisp/emacs-lisp/cl-print.el            |  9 ++++++---
 test/lisp/emacs-lisp/cl-print-tests.el | 10 ++++++++++
 2 files changed, 16 insertions(+), 3 deletions(-)

diff --git a/lisp/emacs-lisp/cl-print.el b/lisp/emacs-lisp/cl-print.el
index de41d82..7c0e81c 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -62,9 +62,12 @@ call other entry points instead, such as `cl-prin1'."
       (princ "(" stream)
       (cl-print-object car stream)
       (while (and (consp object)
-                  (not (if cl-print--number-table
-                           (numberp (gethash object cl-print--number-table))
-                         (memq object cl-print--currently-printing))))
+                  (not (cond
+                        (cl-print--number-table
+                         (numberp (gethash object cl-print--number-table)))
+                        ((memq object cl-print--currently-printing))
+                        (t (push object cl-print--currently-printing)
+                           nil))))
         (princ " " stream)
         (cl-print-object (pop object) stream))
       (when object
diff --git a/test/lisp/emacs-lisp/cl-print-tests.el 
b/test/lisp/emacs-lisp/cl-print-tests.el
index 660d5c8..d986c40 100644
--- a/test/lisp/emacs-lisp/cl-print-tests.el
+++ b/test/lisp/emacs-lisp/cl-print-tests.el
@@ -55,4 +55,14 @@
     (let ((print-circle t))
       (should (equal "(#1=(a . #1#) #1#)" (cl-prin1-to-string x))))))
 
+(ert-deftest cl-print-circle-2 ()
+  ;; Bug#31146.
+  (let ((x '(0 . #1=(0 . #1#))))
+    (let ((print-circle nil))
+      (should (string-match "\\`(0 0 . #[0-9])\\'"
+                            (cl-prin1-to-string x))))
+    (let ((print-circle t))
+      (should (equal "(0 . #1=(0 . #1#))" (cl-prin1-to-string x))))))
+
+
 ;;; cl-print-tests.el ends here.