Less wrong printed circular list tail index (bug#55395)

When printing a circular list and `print-circle` is nil, use a
somewhat more meaningful ". #N" tail index.  The previous method for
calculating that index was based on Floyd circularity detection being
used so it had been broken ever since the change to Brent's algorithm.

The new index is correct with respect to the start of the list itself
which is what it used to be before being completely broken.
It does not take into account the nesting depth of the list context.

* src/print.c (struct print_stack_entry, print_object):
Keep track of the tortoise index (which is cheap) instead of trying
to derive it from the printed element index.
* test/src/print-tests.el (print-test-rho, print-circular):
New test.

diff --git a/src/print.c b/src/print.c
index d3808fd0e4bf68a948e1ebcb875128c71330a9e0..9968c2aef8fb29222e165871f2b2fc75e8e784f3 100644 (file)
--- a/src/print.c
+++ b/src/print.c
@@ -2033,13 +2033,14 @@ struct print_stack_entry
     struct
     {
       Lisp_Object last;                /* cons whose car was just printed  */
-      intmax_t idx;            /* index of next element */
-      intmax_t maxlen;         /* max length (from Vprint_length) */
-      /* State for Brent cycle detection.  See FOR_EACH_TAIL_INTERNAL
-        in lisp.h for more details.  */
+      intmax_t maxlen;         /* max number of elements left to print */
+      /* State for Brent cycle detection.  See
+        Brent RP. BIT. 1980;20(2):176-184. doi:10.1007/BF01933190
+        https://maths-people.anu.edu.au/~brent/pd/rpb051i.pdf */
       Lisp_Object tortoise;     /* slow pointer */
       ptrdiff_t n;             /* tortoise step countdown */
       ptrdiff_t m;             /* tortoise step period */
+      ptrdiff_t tortoise_idx;  /* index of tortoise */
     } list;
 
     struct
@@ -2421,10 +2422,10 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                  .type = PE_list,
                  .u.list.last = obj,
                  .u.list.maxlen = print_length,
-                 .u.list.idx = 1,
                  .u.list.tortoise = obj,
                  .u.list.n = 2,
                  .u.list.m = 2,
+                 .u.list.tortoise_idx = 0,
                });
              /* print the car */
              obj = XCAR (obj);
@@ -2588,17 +2589,15 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                        obj = next;
                        e->type = PE_rbrac;
                        goto print_obj;
-                   }
-               }
+                     }
+                 }
 
                /* list continues: print " " ELEM ... */
 
                printchar (' ', printcharfun);
 
-               /* FIXME: We wouldn't need to keep track of idx if we
-                  count down maxlen instead, and maintain a separate
-                  tortoise index if required.  */
-               if (e->u.list.idx >= e->u.list.maxlen)
+               --e->u.list.maxlen;
+               if (e->u.list.maxlen <= 0)
                  {
                    print_c_string ("...)", printcharfun);
                    --prstack.sp;
@@ -2607,22 +2606,21 @@ print_object (Lisp_Object obj, Lisp_Object printcharfun, bool escapeflag)
                  }
 
                e->u.list.last = next;
-               e->u.list.idx++;
                e->u.list.n--;
                if (e->u.list.n == 0)
                  {
                    /* Double tortoise update period and teleport it.  */
+                   e->u.list.tortoise_idx += e->u.list.m;
                    e->u.list.m <<= 1;
                    e->u.list.n = e->u.list.m;
                    e->u.list.tortoise = next;
                  }
                else if (BASE_EQ (next, e->u.list.tortoise))
                  {
-                   /* FIXME: This #N tail index is bug-compatible with
-                      previous implementations but actually nonsense;
+                   /* FIXME: This #N tail index is somewhat ambiguous;
                       see bug#55395.  */
                    int len = sprintf (buf, ". #%" PRIdMAX ")",
-                                      (e->u.list.idx >> 1) - 1);
+                                      e->u.list.tortoise_idx);
                    strout (buf, len, len, printcharfun);
                    --prstack.sp;
                    --print_depth;

diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 1b28fd19ee7a2f6b42a99d8b4cc86e36a74ad56d..6ff7e997837efcae4b3bf2ce2b946d29bfa78669 100644 (file)
--- a/test/src/print-tests.el
+++ b/test/src/print-tests.el
@@ -484,5 +484,51 @@ otherwise, use a different charset."
                               (apply #'concat suffix))))
         (should (equal (prin1-to-string x) expected))))))
 
+(defun print-test-rho (lead loop)
+  "A circular iota list with LEAD elements followed by LOOP in circle."
+ (let ((l (number-sequence 1 (+ lead loop))))
+   (setcdr (nthcdr (+ lead loop -1) l) (nthcdr lead l))
+   l))
+
+(ert-deftest print-circular ()
+  ;; Check printing of rho-shaped circular lists such as (1 2 3 4 5 4 5 4 . #6)
+  ;; when `print-circle' is nil.  The exact output may differ since the number
+  ;; of elements printed of the looping part can vary depending on when the
+  ;; circularity was detected.
+  (dotimes (lead 7)
+    (ert-info ((prin1-to-string lead) :prefix "lead: ")
+      (dolist (loop (number-sequence 1 7))
+        (ert-info ((prin1-to-string loop) :prefix "loop: ")
+          (let* ((rho (print-test-rho lead loop))
+                 (print-circle nil)
+                 (str (prin1-to-string rho)))
+            (should (string-match (rx "("
+                                      (group (+ (+ digit) " "))
+                                      ". #" (group (+ digit)) ")")
+                                  str))
+            (let* ((g1 (match-string 1 str))
+                   (g2 (match-string 2 str))
+                   (numbers (mapcar #'string-to-number (split-string g1)))
+                   (loopback-index (string-to-number g2)))
+              ;; Split the numbers in the lead and loop part.
+              (should (< lead (length numbers)))
+              (should (<= lead loopback-index))
+              (should (< loopback-index (length numbers)))
+              (let ((lead-part (butlast numbers (- (length numbers) lead)))
+                    (loop-part (nthcdr lead numbers)))
+                ;; The lead part must match exactly.
+                (should (equal lead-part (number-sequence 1 lead)))
+                ;; The loop part is at least LOOP long: make sure it matches.
+                (should (>= (length loop-part) loop))
+                (let ((expected-loop-part
+                       (mapcar (lambda (x) (+ lead 1 (% x loop)))
+                               (number-sequence 0 (1- (length loop-part))))))
+                  (should (equal loop-part expected-loop-part))
+                  ;; The loopback index must match the length of the
+                  ;; loop part.
+                  (should (equal (% (- (length numbers) loopback-index) loop)
+                                 0)))))))))))
+
+
 (provide 'print-tests)
 ;;; print-tests.el ends here