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.

1 files changed, 46 insertions, 0 deletions

diff --git a/test/src/print-tests.el b/test/src/print-tests.el
index 1b28fd19ee7..6ff7e997837 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