From db745584e77bc8dec3fdbea3a82e536100ebe7fe Mon Sep 17 00:00:00 2001
From: pfdietz <pfdietz@localhost>
Date: Tue, 25 May 2004 12:11:13 +0000
Subject: [PATCH] More cons printing tests (with circularity)

---
 ansi-tests/print-cons.lsp  | 20 +++++++++++++++++++-
 ansi-tests/printer-aux.lsp |  3 ++-
 2 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/ansi-tests/print-cons.lsp b/ansi-tests/print-cons.lsp
index 51ea9588..c4a735cb 100644
--- a/ansi-tests/print-cons.lsp
+++ b/ansi-tests/print-cons.lsp
@@ -59,6 +59,22 @@
    10)
   nil)
 
+;; random circular cons graphs
+(deftest print.cons.random.2
+  (loop repeat 50
+	nconc
+	(let* ((n 50)
+	       (conses (apply #'vector
+			      (loop repeat n collect (cons nil nil)))))
+	  (loop for x across conses
+		for j = (random n)
+		for k = (random n)
+		do (setf (car x) (elt conses j)
+			 (cdr x) (elt conses k)))
+	  (randomly-check-readability (elt conses 0) :test #'is-similar
+				      :circle t)))
+  nil)
+
 ;;; Printing with *print-length*
 
 (deftest print.cons.length.1
@@ -136,4 +152,6 @@
    (write-to-string '(#(a) #*1101 "abc")
 		    :case :downcase :level 1
 		    :readably nil :pretty nil))
-  "(# #*1101 \"abc\")")
\ No newline at end of file
+  "(# #*1101 \"abc\")")
+
+
diff --git a/ansi-tests/printer-aux.lsp b/ansi-tests/printer-aux.lsp
index 2fe65232..4b829a68 100644
--- a/ansi-tests/printer-aux.lsp
+++ b/ansi-tests/printer-aux.lsp
@@ -26,6 +26,7 @@
 				       (can-fail nil)
 				       (test #'equal)
 				       (readable t)
+				       (circle nil circle-p)
 				       (escape nil escape-p)
 				       (gensym nil gensym-p))
   (declare (type function test))
@@ -35,7 +36,7 @@
 	 (*print-base* (+ 2 (random 34)))
 	 (*print-radix* (coin))
 	 (*print-case* (random-from-seq #(:upcase :downcase :capitalize)))
-	 (*print-circle* (coin))
+	 (*print-circle* (if circle-p circle (coin)))
 	 (*print-escape* (if escape-p escape (coin)))
 	 (*print-gensym* (if gensym-p gensym (coin)))
 	 (*print-level* (random 50))
-- 
GitLab