From f67527e241844d6a878a4580d660f6d7a900ed70 Mon Sep 17 00:00:00 2001
From: camm <camm@localhost>
Date: Sat, 24 Jul 2004 15:16:21 +0000
Subject: [PATCH] *** empty log message ***

---
 ansi-tests/printer-aux.lsp | 154 ++++++++++++++++++-------------------
 1 file changed, 76 insertions(+), 78 deletions(-)

diff --git a/ansi-tests/printer-aux.lsp b/ansi-tests/printer-aux.lsp
index b7bbbb06..821c0a24 100644
--- a/ansi-tests/printer-aux.lsp
+++ b/ansi-tests/printer-aux.lsp
@@ -59,84 +59,82 @@
    settings before trying a test.  This is intended for cases where the
    error that occurs is fatal.")
 
-(defun randomly-check-readability (&rest r) nil)
-
-;(defun randomly-check-readability (obj &key
-;				       (can-fail nil)
-;				       (test #'equal)
-;				       (readable t)
-;				       (circle nil circle-p)
-;				       (escape nil escape-p)
-;				       (gensym nil gensym-p)
-;				       (debug *random-read-check-debug*))
-;  (declare (type function test))
-;  ;; Generate random printer-control values
-;  (my-with-standard-io-syntax
-;   (let ((*print-array* (coin))
-;	 (*print-base* (+ 2 (random 34)))
-;	 (*print-radix* (coin))
-;	 (*print-case* (random-from-seq #(:upcase :downcase :capitalize)))
-;	 (*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))
-;	 (*print-length* (if readable (random 50) nil))
-;	 (*print-lines* (if readable (random 50) nil))
-;	 (*print-miser-width* (and (coin) (random 100)))
-;	 (*print-pretty* (coin))
-;	 (*print-right-margin* (and (coin) (random 100)))
-;	 (*print-readably* readable)
-;	 (*read-default-float-format* (rcase (1 'short-float) (1 'single-float)
-;					     (1 'double-float) (1 'long-float)
-;					     (1 *read-default-float-format*)))
-;	 (*readtable* (copy-readtable))
-;	 (readcase (random-from-seq #(:upcase :downcase :preserve :invert)))
-;	 )
-;     (flet ((%params ()
-;		     (list (list '*print-readably* *print-readably*)
-;			   (list '*print-array* *print-array*)
-;			   (list '*print-base* *print-base*)
-;			   (list '*print-radix* *print-radix*)
-;			   (list '*print-case* *print-case*)
-;			   (list '*print-circle* *print-circle*)
-;			   (list '*print-escape* *print-escape*)
-;			   (list '*print-gensym* *print-gensym*)
-;			   (list '*print-level* *print-level*)
-;			   (list '*print-length* *print-length*)
-;			   (list '*print-lines* *print-lines*)
-;			   (list '*print-miser-width* *print-miser-width*)
-;			   (list '*print-pretty* *print-pretty*)
-;			   (list '*print-right-margin* *print-right-margin*)
-;			   (list '*read-default-float-format* *read-default-float-format*)
-;			   (list 'readtable-case readcase))))
-;       (when t
-;	 (let ((params (%params)))
-;	   (with-standard-io-syntax (format *debug-io* "~%~A~%" params)))
-;	 (finish-output *debug-io*))
-;       
-;;       (setf (readtable-case *readtable*) readcase)
-;       (let* ((str (handler-case
-;		    (with-output-to-string (s) (write obj :stream s))
-;		    (print-not-readable
-;		     ()
-;		     (if can-fail
-;			 (return-from randomly-check-readability nil)
-;		       ":print-not-readable-error"))))
-;	      (obj2 (let ((*read-base* *print-base*))
-;		      (handler-case
-;		       (let ((*readtable* (if *print-readably*
-;					      (copy-readtable nil)
-;					    *readtable*)))
-;			 (read-from-string str))
-;		       (reader-error () :reader-error)
-;		       (end-of-file () :end-of-file)
-;		       (stream-error () :stream-error)
-;		       (file-error () :file-error)
-;		       ))))
-;	 (unless (funcall test obj obj2)
-;	   (list
-;	    (list* obj str obj2 (%params)
-;		   ))))))))
+(defun randomly-check-readability (obj &key
+				       (can-fail nil)
+				       (test #'equal)
+				       (readable t)
+				       (circle nil circle-p)
+				       (escape nil escape-p)
+				       (gensym nil gensym-p)
+				       (debug *random-read-check-debug*))
+  (declare (type function test))
+  ;; Generate random printer-control values
+  (my-with-standard-io-syntax
+   (let ((*print-array* (coin))
+	 (*print-base* (+ 2 (random 34)))
+	 (*print-radix* (coin))
+	 (*print-case* (random-from-seq #(:upcase :downcase :capitalize)))
+	 (*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))
+	 (*print-length* (if readable (random 50) nil))
+	 (*print-lines* (if readable (random 50) nil))
+	 (*print-miser-width* (and (coin) (random 100)))
+	 (*print-pretty* (coin))
+	 (*print-right-margin* (and (coin) (random 100)))
+	 (*print-readably* readable)
+	 (*read-default-float-format* (rcase (1 'short-float) (1 'single-float)
+					     (1 'double-float) (1 'long-float)
+					     (1 *read-default-float-format*)))
+	 (*readtable* (copy-readtable))
+	 (readcase (random-from-seq #(:upcase :downcase :preserve :invert)))
+	 )
+     (flet ((%params ()
+		     (list (list '*print-readably* *print-readably*)
+			   (list '*print-array* *print-array*)
+			   (list '*print-base* *print-base*)
+			   (list '*print-radix* *print-radix*)
+			   (list '*print-case* *print-case*)
+			   (list '*print-circle* *print-circle*)
+			   (list '*print-escape* *print-escape*)
+			   (list '*print-gensym* *print-gensym*)
+			   (list '*print-level* *print-level*)
+			   (list '*print-length* *print-length*)
+			   (list '*print-lines* *print-lines*)
+			   (list '*print-miser-width* *print-miser-width*)
+			   (list '*print-pretty* *print-pretty*)
+			   (list '*print-right-margin* *print-right-margin*)
+			   (list '*read-default-float-format* *read-default-float-format*)
+			   (list 'readtable-case readcase))))
+       (when debug
+	 (let ((params (%params)))
+	   (with-standard-io-syntax (format *debug-io* "~%~A~%" params)))
+	 (finish-output *debug-io*))
+       
+       (setf (readtable-case *readtable*) readcase)
+       (let* ((str (handler-case
+		    (with-output-to-string (s) (write obj :stream s))
+		    (print-not-readable
+		     ()
+		     (if can-fail
+			 (return-from randomly-check-readability nil)
+		       ":print-not-readable-error"))))
+	      (obj2 (let ((*read-base* *print-base*))
+		      (handler-case
+		       (let ((*readtable* (if *print-readably*
+					      (copy-readtable nil)
+					    *readtable*)))
+			 (read-from-string str))
+		       (reader-error () :reader-error)
+		       (end-of-file () :end-of-file)
+		       (stream-error () :stream-error)
+		       (file-error () :file-error)
+		       ))))
+	 (unless (funcall test obj obj2)
+	   (list
+	    (list* obj str obj2 (%params)
+		   ))))))))
 
 (defun parse-escaped-string (string)
   "Parse a string into a list of either characters (representing
-- 
GitLab