print-cons.lsp 4.53 KB
Newer Older
1
2
3
4
5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Mon Apr 19 07:28:40 2004
;;;; Contains: Tests of printing of conses

pfdietz's avatar
pfdietz committed
6
7
(compile-and-load "printer-aux.lsp")

8
9
10
(in-package :cl-test)

(deftest print.cons.1
pfdietz's avatar
pfdietz committed
11
12
13
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(|A|) :case :upcase :pretty nil :escape nil)))
14
15
16
  "(A)")

(deftest print.cons.2
pfdietz's avatar
pfdietz committed
17
18
19
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(|A| |B|) :case :upcase :pretty nil :escape nil)))
20
21
22
  "(A B)")

(deftest print.cons.3
pfdietz's avatar
pfdietz committed
23
24
25
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (cons '|A| '|B|) :case :upcase :pretty nil :escape nil)))
26
27
28
  "(A . B)")

(deftest print.cons.4
pfdietz's avatar
pfdietz committed
29
30
31
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (let ((s '#:|X|)) (cons s s)) :case :upcase :pretty nil :escape t)))
32
33
34
  "(#:X . #:X)")

(deftest print.cons.5
pfdietz's avatar
pfdietz committed
35
36
37
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (let ((s '#:|X|)) (cons s s)) :case :upcase :pretty nil :escape t :circle t)))
38
39
40
  "(#1=#:X . #1#)")

(deftest print.cons.6
pfdietz's avatar
pfdietz committed
41
42
43
44
45
46
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (let ((s1 (make-symbol "X"))
			    (s2 (make-symbol "X")))
			(list s1 s2 s1 s2))
		      :case :upcase :pretty nil :escape t :circle t)))
47
48
  "(#1=#:X #2=#:X #1# #2#)")

pfdietz's avatar
pfdietz committed
49
(deftest print.cons.7
pfdietz's avatar
pfdietz committed
50
51
52
53
54
55
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string (let ((a (list 17 nil)))
			(setf (cdr a) a)
			a)
		      :circle t :pretty nil :escape nil)))
pfdietz's avatar
pfdietz committed
56
57
58
59
60
  "#1=(17 . #1#)")

;;; Random printing

(deftest print.cons.random.1
pfdietz's avatar
pfdietz committed
61
62
63
64
65
66
  (trim-list
   (loop
    for x = (make-random-cons-tree (random 100))
    repeat 500
    nconc (randomly-check-readability x))
   10)
pfdietz's avatar
pfdietz committed
67
68
  nil)

69
70
71
72
(deftest print.backquote.random.1
  (let ((x '`(a ,b ,@c (d . ,e) ,.f #(1 2 ,p ,@q ,.r s) g)))
    (loop
     repeat 20
pfdietz's avatar
pfdietz committed
73
     nconc (randomly-check-readability x :test #'is-similar)))
74
75
  nil)

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
;; 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)

92
93
94
;;; Printing with *print-length*

(deftest print.cons.length.1
pfdietz's avatar
pfdietz committed
95
96
97
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a) :length 0 :pretty nil :escape nil)))
98
99
100
  "(...)")

(deftest print.cons.length.2
pfdietz's avatar
pfdietz committed
101
102
103
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(81) :length 1 :pretty nil :escape nil)))
104
105
106
  "(81)")

(deftest print.cons.length.3
pfdietz's avatar
pfdietz committed
107
108
109
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(4 . 8) :length 1 :pretty nil :escape nil)))
110
111
112
  "(4 . 8)")

(deftest print.cons.length.4
pfdietz's avatar
pfdietz committed
113
114
115
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))   
     (write-to-string '(4 8) :length 1 :pretty nil :escape nil)))
116
117
118
  "(4 ...)")

(deftest print.cons.length.5
pfdietz's avatar
pfdietz committed
119
120
121
122
123
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a b c d e f g h i j k l m n o p)
		      :case :downcase :length 10
		      :pretty nil :escape nil)))
124
125
126
127
  "(a b c d e f g h i j ...)")


(deftest print.cons.length.6
pfdietz's avatar
pfdietz committed
128
129
130
131
132
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))   
     (write-to-string '(((((((0)))))))
		      :case :downcase :length 3
		      :pretty nil :escape nil)))
133
134
135
136
137
  "(((((((0)))))))")

;;; Printing with *print-level*

(deftest print.cons.level.1
pfdietz's avatar
pfdietz committed
138
139
140
141
142
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a)
		      :case :downcase :level 0
		      :escape nil :pretty nil)))
143
144
145
  "#")

(deftest print.cons.level.2
pfdietz's avatar
pfdietz committed
146
147
148
149
150
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a)
		      :case :downcase :level 1
		      :escape nil :pretty nil)))
151
152
153
  "(a)")

(deftest print.cons.level.3
pfdietz's avatar
pfdietz committed
154
155
156
157
158
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '((a))
		      :case :downcase :level 1
		      :escape nil :pretty nil)))
159
160
161
162
  "(#)")


(deftest print.cons.level.4
pfdietz's avatar
pfdietz committed
163
164
165
166
167
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(a)
		      :case :downcase :level 2
		      :escape nil :pretty nil)))
168
169
170
  "(a)")

(deftest print.cons.level.5
pfdietz's avatar
pfdietz committed
171
172
173
174
175
  (my-with-standard-io-syntax
   (let ((*print-readably* nil))
     (write-to-string '(#(a) #*1101 "abc")
		      :case :downcase :level 1
		      :pretty nil)))
176
  "(# #*1101 \"abc\")")