Commit ee08831b authored by pfdietz's avatar pfdietz

More cons printing tests.

parent df12e57d
......@@ -3,31 +3,33 @@
;;;; Created: Mon Apr 19 07:28:40 2004
;;;; Contains: Tests of printing of conses
(compile-and-load "printer-aux.lsp")
(in-package :cl-test)
(deftest print.cons.1
(with-standard-io-syntax
(write-to-string '(a) :case :upcase :pretty nil :escape nil :readably nil))
(write-to-string '(|A|) :case :upcase :pretty nil :escape nil :readably nil))
"(A)")
(deftest print.cons.2
(with-standard-io-syntax
(write-to-string '(a b) :case :upcase :pretty nil :escape nil :readably nil))
(write-to-string '(|A| |B|) :case :upcase :pretty nil :escape nil :readably nil))
"(A B)")
(deftest print.cons.3
(with-standard-io-syntax
(write-to-string (cons 'a 'b) :case :upcase :pretty nil :escape nil :readably nil))
(write-to-string (cons '|A| '|B|) :case :upcase :pretty nil :escape nil :readably nil))
"(A . B)")
(deftest print.cons.4
(with-standard-io-syntax
(write-to-string (let ((s '#:x)) (cons s s)) :case :upcase :pretty nil :escape t :readably nil))
(write-to-string (let ((s '#:|X|)) (cons s s)) :case :upcase :pretty nil :escape t :readably nil))
"(#:X . #:X)")
(deftest print.cons.5
(with-standard-io-syntax
(write-to-string (let ((s '#:x)) (cons s s)) :case :upcase :pretty nil :escape t :circle t :readably nil))
(write-to-string (let ((s '#:|X|)) (cons s s)) :case :upcase :pretty nil :escape t :circle t :readably nil))
"(#1=#:X . #1#)")
(deftest print.cons.6
......@@ -38,9 +40,22 @@
:case :upcase :pretty nil :escape t :circle t :readably nil))
"(#1=#:X #2=#:X #1# #2#)")
(deftest print.cons.7
(with-standard-io-syntax
(write-to-string (let ((a (list 17 nil)))
(setf (cdr a) a)
a)
:circle t :pretty nil :escape nil :readably nil))
"#1=(17 . #1#)")
;;; Random printing
(deftest print.cons.random.1
(loop
for x = (make-random-cons-tree (random 100))
repeat 500
nconc (randomly-check-readability x))
nil)
\ No newline at end of file
......@@ -139,3 +139,17 @@
(null (symbol-package s2))
(string= (symbol-name s1)
(symbol-name s2))))
(defun make-random-cons-tree (size)
(if (<= size 1)
(rcase
(5 nil)
(1 (random 1000))
(1 (random 1000.0))
(2 (random-from-seq #(a b c d e f g |1| |2| |.|))))
(let ((s1 (1+ (random (1- size)))))
(cons (make-random-cons-tree s1)
(make-random-cons-tree (- size s1))))))
\ No newline at end of file
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