Commit 9aef3bce authored by pfdietz's avatar pfdietz

Modify vector printing tests so that specialized vectors don't necessarily have to print readably.

parent 229f4126
......@@ -252,7 +252,9 @@
when (vectorp v)
nconc
(loop repeat 10
nconc (randomly-check-readability v :test #'equalp)))
nconc (randomly-check-readability
v :test #'equalp
:can-fail (not (subtypep t (array-element-type v))))))
nil)
(deftest print.vector.random.2
......@@ -262,7 +264,8 @@
:initial-contents '(1 3 2 0))
nconc
(loop repeat 10
nconc (randomly-check-readability v :test #'equalp)))
nconc (randomly-check-readability v :test #'equalp
:can-fail t)))
nil)
(deftest print.vector.random.3
......@@ -272,7 +275,8 @@
:initial-contents '(-1 1 0 -2))
nconc
(loop repeat 10
nconc (randomly-check-readability v :test #'equalp)))
nconc (randomly-check-readability v :test #'equalp
:can-fail t)))
nil)
;;; *print-length* checks
......
......@@ -23,6 +23,7 @@
;;; argument TEST is used to compared the reread object and obj.
(defun randomly-check-readability (obj &key
(can-fail nil)
(test #'equal)
(readable t)
(escape nil escape-p)
......@@ -51,10 +52,17 @@
(readcase (random-from-seq #(:upcase :downcase :preserve :invert)))
)
(setf (readtable-case *readtable*) readcase)
(let* ((str (with-output-to-string (s) (write obj :stream s)))
(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)
(let ((*readtable* (if *print-readably*
(copy-readtable nil)
*readtable*)))
(read-from-string str))
(reader-error () :error)))))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment