master 5a1a67a256: Less wrong printed circular list tail index (bug#55395)

[Mattias Engdegård]

branch: master
commit 5a1a67a2562fab77856b48a38d89713d7f2c96d7
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>

    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.
---
 src/print.c             | 28 +++++++++++++---------------
 test/src/print-tests.el | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 59 insertions(+), 15 deletions(-)

diff --git a/src/print.c b/src/print.c
index d3808fd0e4..9968c2aef8 100644
--- 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 1b28fd19ee..6ff7e99783 100644
--- 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