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