From 78330b0b81f090955b0cd09ae1586e2f0b7ed2a0 Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Wed, 7 Jul 2004 12:33:27 +0000
Subject: [PATCH] More pprint-pop tests, dealing with length and
 circularity/sharing

---
 ansi-tests/pprint-exit-if-list-exhausted.lsp | 136 ++++++++++++++-----
 1 file changed, 105 insertions(+), 31 deletions(-)

diff --git a/ansi-tests/pprint-exit-if-list-exhausted.lsp b/ansi-tests/pprint-exit-if-list-exhausted.lsp
index 8eaf8729..6f6261a5 100644
--- a/ansi-tests/pprint-exit-if-list-exhausted.lsp
+++ b/ansi-tests/pprint-exit-if-list-exhausted.lsp
@@ -160,41 +160,115 @@
   "{...}")
 
 (deftest pprint-pop.5
-  (with-standard-io-syntax
-   (let ((*print-pretty* t)
-	 (*print-escape* nil)
-	 (*print-right-margin* 100)
-	 (*print-readably* nil)
-	 (*print-length* 2))
-     (with-output-to-string
-       (os)
-       (pprint-logical-block
-	(os '(1 2 3 4 5) :prefix "{" :suffix "}")
-	(pprint-exit-if-list-exhausted)
-	(write (pprint-pop) :stream os)
-	(loop (write #\Space :stream os)
-	      (pprint-exit-if-list-exhausted)
-	      (write (pprint-pop) :stream os))))))
-  "{1 2 ...}")
+  (flet ((%f (len)
+	     (with-standard-io-syntax
+	      (let ((*print-pretty* t)
+		    (*print-escape* nil)
+		    (*print-right-margin* 100)
+		    (*print-readably* nil)
+		    (*print-length* len))
+		(with-output-to-string
+		  (os)
+		  (pprint-logical-block
+		   (os '(1 2 3 4 5) :prefix "{" :suffix "}")
+		   (pprint-exit-if-list-exhausted)
+		   (write (pprint-pop) :stream os)
+		   (loop (pprint-exit-if-list-exhausted)
+			 (write #\Space :stream os)
+			 (write (pprint-pop) :stream os))))))))
+    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 4) (%f 5) (%f 6)))
+  "{...}"
+  "{1 ...}"
+  "{1 2 ...}"
+  "{1 2 3 ...}"
+  "{1 2 3 4 ...}"
+  "{1 2 3 4 5}"
+  "{1 2 3 4 5}")
 
 (deftest pprint-pop.6
-  (with-standard-io-syntax
-   (let ((*print-pretty* t)
-	 (*print-escape* nil)
-	 (*print-right-margin* 100)
-	 (*print-readably* nil)
-	 (*print-length* 2))
-     (with-output-to-string
-       (os)
-       (pprint-logical-block
-	(os '(1 2 . 3) :prefix "{" :suffix "}")
-	(pprint-exit-if-list-exhausted)
-	(write (pprint-pop) :stream os)
-	(loop (write #\Space :stream os)
-	      (pprint-exit-if-list-exhausted)
-	      (write (pprint-pop) :stream os))))))
+  (flet ((%f (len)
+	     (with-standard-io-syntax
+	      (let ((*print-pretty* t)
+		    (*print-escape* nil)
+		    (*print-right-margin* 100)
+		    (*print-readably* nil)
+		    (*print-length* len))
+		(with-output-to-string
+		  (os)
+		  (pprint-logical-block
+		   (os '(1 2 . 3) :prefix "{" :suffix "}")
+		   (pprint-exit-if-list-exhausted)
+		   (write (pprint-pop) :stream os)
+		   (loop (pprint-exit-if-list-exhausted)
+			 (write #\Space :stream os)
+			 (write (pprint-pop) :stream os))))))))
+    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
+  "{...}"
+  "{1 ...}"
+  "{1 2 . 3}"
+  "{1 2 . 3}"
   "{1 2 . 3}")
 
+;;; pprint-pop and circularity/sharing
+
+(deftest pprint-pop.7
+  (flet ((%f (len)
+	     (with-standard-io-syntax
+	      (let ((*print-pretty* t)
+		    (*print-escape* nil)
+		    (*print-right-margin* 100)
+		    (*print-readably* nil)
+		    (*print-length* len)
+		    (*print-circle* t))
+		(with-output-to-string
+		  (os)
+		  (let* ((tail (list 1))
+			 (x (list* tail 2 tail)))
+		    (pprint-logical-block
+		     (os x :prefix "<" :suffix ">")
+		     (pprint-exit-if-list-exhausted)
+		     (write (pprint-pop) :stream os)
+		     (loop (pprint-exit-if-list-exhausted)
+			   (write #\Space :stream os)
+			   (write (pprint-pop) :stream os)))))))))
+    (values (%f nil) (%f 0) (%f 1) (%f 2) (%f 3) (%f 4)))
+  "<#1=(1) 2 . #1#>"
+  "<...>"
+  "<(1) ...>"
+  "<(1) 2 ...>"
+  "<#1=(1) 2 . #1#>"
+  "<#1=(1) 2 . #1#>")
+
+(deftest pprint-pop.8
+  (flet ((%f (len)
+	     (with-standard-io-syntax
+	      (let ((*print-pretty* t)
+		    (*print-escape* nil)
+		    (*print-right-margin* 100)
+		    (*print-readably* nil)
+		    (*print-length* len)
+		    (*print-circle* t))
+		(with-output-to-string
+		  (os)
+		  (let* ((tail (list 2))
+			 (x (list* 1 tail)))
+		    (setf (cdr tail) tail)
+		    (pprint-logical-block
+		     (os x :prefix "[[" :suffix "]]")
+		     (pprint-exit-if-list-exhausted)
+		     (write (pprint-pop) :stream os)
+		     (loop (pprint-exit-if-list-exhausted)
+			   (write #\Space :stream os)
+			   (write (pprint-pop) :stream os)))))))))
+    (values (%f 0) (%f 1) (%f 2) (%f 3) (%f 10) (%f 20)))
+  "[[...]]"
+  "[[1 ...]]"
+  "[[1 2 ...]]"
+  "[[1 . #1=(2 . #1#)]]"
+  "[[1 . #1=(2 . #1#)]]"
+  "[[1 . #1=(2 . #1#)]]")
+
+
 ;;; Error cases
 
 (deftest pprint-exit-if-list-exhausted.error.1
-- 
GitLab