GNU bug report logs - #31146
cl-prin1 infloops when printing list with circularity in the tail

Previous Next

Full log

Message #8 received at 31146 <at> debbugs.gnu.org (full text, mbox):

From: Noam Postavsky <npostavs <at> gmail.com>
To: "Basil L. Contovounesios" <contovob <at> tcd.ie>
Cc: 31146 <at> debbugs.gnu.org
Subject: Re: bug#31146: 27.0.50;
 ielm via cl-prin1 infloops when printing circular object
Date: Sat, 14 Apr 2018 01:16:00 -0400

[Message part 1 (text/plain, inline)]

retitle 31146 cl-prin1 infloops when printing list with circularity in the tail
tags 31146 + patch
quit

"Basil L. Contovounesios" <contovob <at> tcd.ie> writes:

> 1. emacs -Q
> 2. M-x ielm RET
> 3. (let ((l (make-list 2 0)))
>      (nconc l (cdr l)))
> 4. C-m
>      => infloop

Right, though the bug is really about cl-prin1, ielm is just incidental.

Here's a patch.  Hmm, how should cl-defmethod changes be specified in
the ChangeLog?  I just put (cl-print-object), but is there some notation
to indicate it's this particular defmethod?

    (cl-defmethod cl-print-object ((object cons) stream)

[v1-0001-Fix-cl-print-for-circular-sublists-Bug-31146.patch (text/x-diff, inline)]

From 57d1b421826b0b605abf2e9023e1a4f004b3502e Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs <at> gmail.com>
Date: Sat, 14 Apr 2018 01:02:25 -0400
Subject: [PATCH v1] Fix cl-print for circular sublists (Bug#31146)

* lisp/emacs-lisp/cl-print.el (cl-print-object): 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.
---
 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 78cd6f9d9e..ada5923515 100644
--- a/lisp/emacs-lisp/cl-print.el
+++ b/lisp/emacs-lisp/cl-print.el
@@ -62,9 +62,12 @@ cl-print--currently-printing
       (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 660d5c8069..d986c4015d 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.
-- 
2.11.0

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.