2
;;;; Author: Paul Dietz
3
;;;; Created: Tue Apr 20 22:36:53 2004
4
;;;; Contains: Tests of vector printing
6
(compile-and-load "printer-aux.lsp")
10
;;; Empty vector tests
12
(deftest print.vector.1
13
(with-standard-io-syntax
14
(write-to-string #() :readably nil :array t))
17
(deftest print.vector.2
18
(with-standard-io-syntax
19
(loop for i from 2 to 100
20
for a = (make-array '(0) :element-type `(unsigned-byte ,i))
21
for s = (write-to-string a :readably nil :array t :pretty nil)
22
unless (string= s "#()")
26
(deftest print.vector.3
27
(with-standard-io-syntax
28
(loop for i from 1 to 100
29
for a = (make-array '(0) :element-type `(signed-byte ,i))
30
for s = (write-to-string a :readably nil :array t :pretty nil)
31
unless (string= s "#()")
35
(deftest print.vector.4
36
(with-standard-io-syntax
37
(loop for type in '(short-float single-float double-float long-float)
38
for a = (make-array '(0) :element-type type)
39
for s = (write-to-string a :readably nil :array t :pretty nil)
40
unless (string= s "#()")
41
collect (list type s)))
46
(deftest print.vector.5
47
(with-standard-io-syntax
48
(let* ((*package* (find-package "CL-TEST"))
50
(write-to-string #(a b c)
51
:readably nil :array t
52
:pretty nil :case :downcase)))
53
(or (and (string= result "#(a b c)") t)
57
(deftest print.vector.6
58
(with-standard-io-syntax
61
for a = (make-array '(4) :element-type `(unsigned-byte ,i)
62
:initial-contents '(3 0 2 1))
63
for s = (write-to-string a :readably nil :array t :pretty nil)
64
unless (string= s "#(3 0 2 1)")
65
collect (list i a s)))
68
(deftest print.vector.7
69
(with-standard-io-syntax
72
for a = (make-array '(4) :element-type `(signed-byte ,i)
73
:initial-contents '(-2 -1 0 1))
74
for s = (write-to-string a :readably nil :array t :pretty nil)
75
unless (string= s "#(-2 -1 0 1)")
76
collect (list i a s)))
79
;;; Vectors with fill pointers
81
(deftest print.vector.fill.1
82
(with-standard-io-syntax
83
(let ((v (make-array '(10) :initial-contents '(a b c d e f g h i j)
85
(*package* (find-package "CL-TEST")))
86
(loop for i from 0 to 10
87
do (setf (fill-pointer v) i)
88
collect (write-to-string v :readably nil :array t :pretty nil
99
"#(a b c d e f g h i)"
100
"#(a b c d e f g h i j)"))
102
(deftest print.vector.fill.2
103
(with-standard-io-syntax
104
(let ((expected '("#()" "#(0)" "#(0 1)" "#(0 1 2)" "#(0 1 2 3)")))
105
(loop for i from 2 to 100
107
(let ((v (make-array '(4) :initial-contents '(0 1 2 3)
108
:element-type `(unsigned-byte ,i)
110
(loop for fp from 0 to 4
111
for expected-result in expected
114
(setf (fill-pointer v) fp)
115
(write-to-string v :readably nil :array t :pretty nil))
116
unless (string= expected-result actual-result)
117
collect (list i fp expected-result actual-result))))))
120
(deftest print.vector.fill.3
121
(with-standard-io-syntax
122
(let ((expected '("#()" "#(0)" "#(0 -1)" "#(0 -1 -2)" "#(0 -1 -2 1)")))
123
(loop for i from 2 to 100
125
(let ((v (make-array '(4) :initial-contents '(0 -1 -2 1)
126
:element-type `(signed-byte ,i)
128
(loop for fp from 0 to 4
129
for expected-result in expected
132
(setf (fill-pointer v) fp)
133
(write-to-string v :readably nil :array t :pretty nil))
134
unless (string= expected-result actual-result)
135
collect (list i fp expected-result actual-result))))))
138
;;; Displaced vectors
140
(deftest print.vector.displaced.1
141
(let* ((v1 (vector 'a 'b 'c 'd 'e 'f 'g))
142
(v2 (make-array 3 :displaced-to v1 :displaced-index-offset 4)))
143
(with-standard-io-syntax
144
(write-to-string v2 :readably nil :array t :case :downcase :pretty nil
148
(deftest print.vector.displaced.2
149
(with-standard-io-syntax
150
(loop for i from 2 to 100
152
(let* ((type `(unsigned-byte ,i))
153
(v1 (make-array 8 :element-type type
154
:initial-contents '(0 1 2 3 0 1 2 3)))
155
(v2 (make-array 5 :displaced-to v1
156
:displaced-index-offset 2
159
(write-to-string v2 :readably nil :array t :pretty nil)))
160
(unless (string= result "#(2 3 0 1 2)")
161
(list (list i v1 v2 result))))))
165
(deftest print.vector.displaced.3
166
(with-standard-io-syntax
167
(loop for i from 2 to 100
169
(let* ((type `(signed-byte ,i))
170
(v1 (make-array 8 :element-type type
171
:initial-contents '(0 1 -1 -2 0 1 -1 -2)))
172
(v2 (make-array 5 :displaced-to v1
173
:displaced-index-offset 2
176
(write-to-string v2 :readably nil :array t :pretty nil)))
177
(unless (string= result "#(-1 -2 0 1 -1)")
178
(list (list i v1 v2 result))))))
182
;;; Adjustable vectors
184
(deftest print.vector.adjustable.1
185
(with-standard-io-syntax
186
(let ((v (make-array '(10) :initial-contents '(a b c d e f g h i j)
188
(write-to-string v :readably nil :array t :case :downcase :pretty nil
190
"#(a b c d e f g h i j)")
192
(deftest print.vector.adjustable.2
193
(with-standard-io-syntax
194
(loop for i from 2 to 100
195
for type = `(unsigned-byte ,i)
196
for v = (make-array '(8) :initial-contents '(0 1 2 3 3 0 2 1)
199
(write-to-string v :readably nil :array t :case :downcase :pretty nil
201
unless (string= s "#(0 1 2 3 3 0 2 1)")
202
collect (list i v s)))
205
(deftest print.vector.adjustable.3
206
(with-standard-io-syntax
207
(loop for i from 2 to 100
208
for type = `(signed-byte ,i)
209
for v = (make-array '(8) :initial-contents '(0 1 -1 -2 -1 0 -2 1)
212
(write-to-string v :readably nil :array t :case :downcase :pretty nil
214
unless (string= s "#(0 1 -1 -2 -1 0 -2 1)")
215
collect (list i v s)))
218
;;; Printing with *print-array* and *print-readably* bound to nil
220
(deftest print.vector.unreadable.1
221
(with-standard-io-syntax
222
(subseq (write-to-string #(a b c d e) :array nil :readably nil) 0 2))
225
(deftest print.vector.unreadable.2
226
(with-standard-io-syntax
227
(loop for i from 2 to 100
228
for type = `(unsigned-byte ,i)
229
for v = (make-array '(4) :element-type type
230
:initial-contents '(0 1 2 3))
231
for result = (write-to-string v :array nil :readably nil)
232
unless (string= (subseq result 0 2) "#<")
233
collect (list i type v result)))
237
(deftest print.vector.unreadable.3
238
(with-standard-io-syntax
239
(loop for i from 2 to 100
240
for type = `(signed-byte ,i)
241
for v = (make-array '(4) :element-type type
242
:initial-contents '(0 1 -2 -1))
243
for result = (write-to-string v :array nil :readably nil)
244
unless (string= (subseq result 0 2) "#<")
245
collect (list i type v result)))
248
;;; Readability tests
250
(deftest print.vector.random.1
252
(loop for v in *universe*
256
nconc (randomly-check-readability
258
:can-fail (not (subtypep t (array-element-type v))))))
262
(deftest print.vector.random.2
264
(loop for i from 2 to 100
265
for type = `(unsigned-byte ,i)
266
for v = (make-array '(4) :element-type type
267
:initial-contents '(1 3 2 0))
270
nconc (randomly-check-readability v :test #'equalp
275
(deftest print.vector.random.3
277
(loop for i from 2 to 100
278
for type = `(signed-byte ,i)
279
for v = (make-array '(4) :element-type type
280
:initial-contents '(-1 1 0 -2))
283
nconc (randomly-check-readability v :test #'equalp
288
(deftest print.vector.random.4
290
(loop for v = (make-random-vector (1+ (random 100)))
292
nconc (randomly-check-readability v :test #'equalp))
296
;;; *print-length* checks
298
(deftest print.vector.length.1
299
(with-standard-io-syntax
300
(write-to-string #() :pretty nil :length 0 :readably nil))
303
(deftest print.vector.length.2
304
(with-standard-io-syntax
305
(write-to-string #(1) :pretty nil :length 0 :readably nil))
308
(deftest print.vector.length.3
309
(with-standard-io-syntax
310
(write-to-string #(1) :pretty nil :length 1 :readably nil))
313
(deftest print.vector.length.4
314
(with-standard-io-syntax
315
(write-to-string #(a b c d e f g h)
318
:length 5 :case :downcase
322
(deftest print.vector.length.5
323
(with-standard-io-syntax
324
(loop for i from 2 to 100
325
for type = `(unsigned-byte ,i)
326
for v = (make-array '(0) :element-type type)
327
for result = (write-to-string v :array t :readably nil
330
unless (string= result "#()")
331
collect (list i type v result)))
334
(deftest print.vector.length.6
335
(with-standard-io-syntax
336
(loop for i from 2 to 100
337
for type = `(unsigned-byte ,i)
338
for v = (make-array '(1) :element-type type :initial-contents '(2))
339
for result = (write-to-string v
344
unless (string= result "#(...)")
345
collect (list i type v result)))
348
(deftest print.vector.length.7
349
(with-standard-io-syntax
350
(loop for i from 1 to 100
351
for type = `(signed-byte ,i)
352
for v = (make-array '(1) :element-type type :initial-contents '(-1))
353
for result = (write-to-string v
358
unless (string= result "#(...)")
359
collect (list i type v result)))
362
(deftest print.vector.length.8
363
(with-standard-io-syntax
364
(loop for i from 2 to 100
365
for type = `(unsigned-byte ,i)
366
for v = (make-array '(4) :element-type type
367
:initial-contents '(1 3 0 2))
368
for result = (write-to-string v
373
unless (string= result "#(1 3 ...)")
374
collect (list i type v result)))
377
(deftest print.vector.length.9
378
(with-standard-io-syntax
379
(loop for i from 2 to 100
380
for type = `(signed-byte ,i)
381
for v = (make-array '(4) :element-type type
382
:initial-contents '(1 -2 0 -1))
383
for result = (write-to-string v
388
unless (string= result "#(1 -2 ...)")
389
collect (list i type v result)))
392
;;; Printing with *print-level* bound
394
(deftest print.vector.level.1
395
(with-standard-io-syntax
396
(write-to-string #() :level 0 :readably nil :pretty nil))
399
(deftest print.vector.level.2
400
(with-standard-io-syntax
401
(write-to-string #() :level 1 :readably nil :pretty nil))
404
(deftest print.vector.level.3
405
(with-standard-io-syntax
406
(write-to-string #(17) :level 1 :readably nil :pretty nil))
409
(deftest print.vector.level.4
410
(with-standard-io-syntax
411
(write-to-string #(4 (17) 9 (a) (b) 0) :level 1 :readably nil :pretty nil))
414
(deftest print.vector.level.5
415
(with-standard-io-syntax
416
(write-to-string '(#(a)) :level 1 :readably nil :pretty nil))
419
(deftest print.vector.level.6
420
(with-standard-io-syntax
421
(write-to-string '#(#(a)) :level 1 :readably nil :pretty nil))
added
removed
ansi-tests/print-vector.lsp
