2
;;;; Author: Paul Dietz
3
;;;; Created: Thu Apr 22 22:38:11 2004
4
;;;; Contains: Tests of printing of arrays (other than vectors)
6
(compile-and-load "printer-aux.lsp")
10
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11
;; Zero dimensional arrays
13
(deftest print.array.0.1
14
(let ((a (make-array nil :initial-element 0)))
15
(with-standard-io-syntax
16
(write-to-string a :readably nil :array t)))
19
(deftest print.array.0.2
20
(with-standard-io-syntax
21
(let ((a (make-array nil :initial-element '|A|))
22
(*package* (find-package "CL-TEST")))
23
(write-to-string a :readably nil :array t)))
26
(deftest print.array.0.3
27
(let ((a (make-array nil :initial-element 0)))
28
(subseq (write-to-string a :readably nil :array nil) 0 2))
31
(deftest print.array.0.4
32
(let ((a (make-array nil :initial-element 0 :adjustable t)))
33
(with-standard-io-syntax
34
(write-to-string a :readably nil :array t)))
37
(deftest print.array.0.5
38
(let* ((a (make-array nil :initial-element 0 :adjustable t))
39
(b (make-array nil :displaced-to a :displaced-index-offset 0)))
40
(with-standard-io-syntax
41
(write-to-string b :readably nil :array t)))
44
(deftest print.array.0.6
45
(let ((a (make-array nil :initial-element 0
46
:element-type '(integer 0 2))))
47
(with-standard-io-syntax
48
(write-to-string a :readably nil :array t)))
51
(deftest print.array.0.7
52
(loop for a = (make-array nil :initial-element (- (random 1000000) 500000))
53
repeat 30 nconc (randomly-check-readability a :test #'is-similar))
56
(deftest print.array.0.8
57
(loop for i from 1 to 64
58
for type = `(unsigned-byte ,i)
60
(let ((a (make-array nil :initial-element 1 :element-type type)))
61
(loop repeat 5 nconc (randomly-check-readability a :test #'is-similar
65
(deftest print.array.0.9
66
(loop for a = (make-array nil :initial-element (random 1000000) :adjustable t)
68
nconc (randomly-check-readability a :test #'is-similar))
71
(deftest print.array.0.10
72
(loop for a = (make-array nil :initial-element (random 1000000000))
73
for b = (make-array nil :displaced-to a :displaced-index-offset 0)
74
repeat 30 nconc (randomly-check-readability b :test #'is-similar))
77
(deftest print.array.0.11
78
(loop for type in '(short-float single-float double-float long-float float)
79
for zero = (coerce 0 type)
80
for a = (make-array nil :initial-element zero
83
(loop repeat 30 nconc (randomly-check-readability a :test #'is-similar
87
(deftest print.array.0.12
88
(loop for type0 in '(short-float single-float double-float long-float float)
89
for type = `(complex ,type0)
90
for zero = (complex (coerce 0.0s0 type0))
91
for a = (make-array nil :initial-element zero
94
(loop repeat 30 nconc (randomly-check-readability a :test #'is-similar
98
(deftest print.array.0.13
99
(subseq (write-to-string (make-array nil :initial-element 0)
100
:readably nil :array nil)
104
(deftest print.array.0.14
105
(loop for i from 1 to 64
106
for type = `(unsigned-byte ,i)
107
for a = (make-array nil :element-type type :initial-element 1)
108
for result = (write-to-string a :readably nil :array nil)
109
unless (string= (subseq result 0 2) "#<")
110
collect (list i result))
113
(deftest print.array.0.15
114
(loop for i from 1 to 64
115
for type = `(signed-byte ,i)
116
for a = (make-array nil :element-type type :initial-element -1)
117
for result = (write-to-string a :readably nil :array nil)
118
unless (string= (subseq result 0 2) "#<")
119
collect (list i result))
122
(deftest print.array.0.16
123
(loop for type in '(short-float single-float double-float long-float)
124
for a = (make-array nil :element-type type
125
:initial-element (coerce 17 type))
126
for result = (write-to-string a :readably nil :array nil)
127
unless (string= (subseq result 0 2) "#<")
128
collect (list type result))
131
(deftest print.array.0.17
132
(loop for type0 in '(short-float single-float double-float
133
long-float float real)
134
for type = `(complex ,type0)
135
for a = (make-array nil :element-type type
136
:initial-element (complex 0 (coerce 3 type0)))
137
for result = (write-to-string a :readably nil :array nil)
138
unless (string= (subseq result 0 2) "#<")
139
collect (list type result))
142
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
144
(deftest print.array.2.1
145
(let ((a (make-array '(1 1) :initial-contents '((1)))))
146
(with-standard-io-syntax
147
(write-to-string a :readably nil :array t)))
150
(deftest print.array.2.2
151
(let ((a (make-array '(2 3) :initial-contents '((1 3 8)(2 6 10)))))
152
(with-standard-io-syntax
153
(write-to-string a :readably nil :array t)))
154
"#2A((1 3 8) (2 6 10))")
156
(deftest print.array.2.3
157
(let ((a (make-array '(0 1))))
158
(with-standard-io-syntax
159
(write-to-string a :readably nil :array t)))
162
(deftest print.array.2.4
163
(let ((a (make-array '(1 0))))
164
(with-standard-io-syntax
165
(write-to-string a :readably nil :array t)))
168
(deftest print.array.2.5
169
(let ((a (make-array '(0 0))))
170
(with-standard-io-syntax
171
(write-to-string a :readably nil :array t)))
174
(deftest print.array.2.6
175
(let ((a (make-array '(10 0))))
176
(with-standard-io-syntax
177
(write-to-string a :readably nil :array t)))
178
"#2A(() () () () () () () () () ())")
180
(deftest print.array.2.7
181
(let* ((a (make-array '(3 3) :initial-contents '((1 3 8) (2 67 121) (65 432 6))))
182
(b (make-array '(3 3) :displaced-to a
183
:displaced-index-offset 0)))
184
(with-standard-io-syntax
185
(write-to-string b :readably nil :array t)))
186
"#2A((1 3 8) (2 67 121) (65 432 6))")
188
(deftest print.array.2.8
189
(let* ((a (make-array '(3 3) :initial-contents '((1 3 8) (2 67 121) (65 432 6))))
190
(b (make-array '(2 3) :displaced-to a
191
:displaced-index-offset 0)))
192
(with-standard-io-syntax
193
(write-to-string b :readably nil :array t)))
194
"#2A((1 3 8) (2 67 121))")
196
(deftest print.array.2.9
197
(let* ((a (make-array '(3 3) :initial-contents '((1 3 8) (2 67 121) (65 432 6))))
198
(b (make-array '(2 2) :displaced-to a
199
:displaced-index-offset 4)))
200
(with-standard-io-syntax
201
(write-to-string b :readably nil :array t)))
202
"#2A((67 121) (65 432))")
204
(deftest print.array.2.10
205
(let* ((a (make-array '(3 3) :initial-contents '((1 3 8) (2 67 121) (65 432 6))))
206
(b (make-array '(2 2) :displaced-to a
207
:displaced-index-offset 4
209
(with-standard-io-syntax
210
(write-to-string b :readably nil :array t)))
211
"#2A((67 121) (65 432))")
213
(deftest print.array.2.11
214
(let* ((a (make-array '(3 4)
215
:initial-contents '((7 8 9 10) (65 12 42 -1) (:|W| :|X| :|Y| :|Z| ))
217
(with-standard-io-syntax
218
(write-to-string a :readably nil :array t)))
219
"#2A((7 8 9 10) (65 12 42 -1) (:W :X :Y :Z))")
221
(deftest print.array.2.12
222
(let ((desired-result "#2A((0 1 1) (1 1 0))"))
223
(loop for i from 2 to 64
224
for a = (make-array '(2 3) :element-type `(unsigned-byte ,i)
225
:initial-contents '((0 1 1) (1 1 0)))
226
for result = (with-standard-io-syntax
227
(write-to-string a :readably nil :array t))
228
unless (string= desired-result result)
229
collect (list i a result)))
232
(deftest print.array.2.13
233
(let ((desired-result "#2A((0 -1 -1) (-1 -1 0))"))
234
(loop for i from 1 to 64
235
for a = (make-array '(2 3) :element-type `(signed-byte ,i)
236
:initial-contents '((0 -1 -1) (-1 -1 0)))
237
for result = (with-standard-io-syntax
238
(write-to-string a :readably nil :array t))
239
unless (string= desired-result result)
240
collect (list i a result)))
243
(deftest print.array.2.14
244
(let ((desired-result "#2A((0 1 1) (1 1 0))"))
245
(loop for i from 2 to 64
246
for a = (make-array '(2 3) :element-type `(unsigned-byte ,i)
248
:initial-contents '((0 1 1) (1 1 0)))
249
for result = (with-standard-io-syntax
250
(write-to-string a :readably nil :array t))
251
unless (string= desired-result result)
252
collect (list i a result)))
255
(deftest print.array.2.15
256
(let ((desired-result "#2A((0 -1 -1) (-1 -1 0))"))
257
(loop for i from 1 to 64
258
for a = (make-array '(2 3) :element-type `(signed-byte ,i)
260
:initial-contents '((0 -1 -1) (-1 -1 0)))
261
for result = (with-standard-io-syntax
262
(write-to-string a :readably nil :array t))
263
unless (string= desired-result result)
264
collect (list i a result)))
267
(deftest print.array.2.16
268
(let ((desired-result "#2A((1 1) (1 0))"))
269
(loop for i from 2 to 64
270
for type = `(unsigned-byte ,i)
271
for a = (make-array '(2 3) :element-type type
273
:initial-contents '((0 1 1) (1 1 0)))
274
for b = (make-array '(2 2) :displaced-to a :displaced-index-offset 2
276
for result = (with-standard-io-syntax
277
(write-to-string b :readably nil :array t))
278
unless (string= desired-result result)
279
collect (list i b result)))
282
(deftest print.array.2.17
283
(let ((desired-result "#2A((1 -1) (-2 0))"))
284
(loop for i from 2 to 64
285
for type = `(signed-byte ,i)
286
for a = (make-array '(2 3) :element-type type
288
:initial-contents '((0 1 1) (-1 -2 0)))
289
for b = (make-array '(2 2) :displaced-to a :displaced-index-offset 2
291
for result = (with-standard-io-syntax
292
(write-to-string b :readably nil :array t))
293
unless (string= desired-result result)
294
collect (list i b result)))
297
(deftest print.array.2.20
298
(let* ((a (make-array '(9) :initial-contents '(1 3 8 2 67 121 65 432 6)))
299
(b (make-array '(2 2) :displaced-to a
300
:displaced-index-offset 1)))
301
(with-standard-io-syntax
302
(write-to-string b :readably nil :array t)))
305
(deftest print.array.2.21
306
(loop for a = (make-array (list (random 4) (random 4))
307
:initial-element (- (random 1000000) 500000))
308
repeat 100 nconc (randomly-check-readability a :test #'is-similar
312
(deftest print.array.2.22
313
(loop for a = (make-array (list (random 4) (random 4))
314
:initial-element (- (random 1000000) 500000)
316
repeat 100 nconc (randomly-check-readability a :test #'is-similar
320
(deftest print.array.2.23
321
(loop for d1 = (random 10)
323
for a = (make-array (list d1 d2)
324
:initial-element (- (random 1000000) 500000))
325
for d1a = (random (1+ d1))
326
for d2a = (random (1+ d2))
327
for offset = (random (1+ (- (* d1 d2) (* d1a d2a))))
328
for b = (make-array (list d1a d2a) :displaced-to a
329
:displaced-index-offset offset)
330
repeat 100 nconc (randomly-check-readability b :test #'is-similar
334
(deftest print.array.2.24
335
(loop for i from 1 to 64
336
for type = `(unsigned-byte ,i)
338
(let ((a (make-array '(3 4) :initial-element 1 :element-type type)))
339
(loop repeat 5 nconc (randomly-check-readability a :test #'is-similar
343
(deftest print.array.2.25
344
(let ((a (make-array '(3 4) :initial-element #\a :element-type 'character)))
345
(loop repeat 10 nconc (randomly-check-readability a :test #'is-similar
349
(deftest print.array.2.26
350
(let ((a (make-array '(3 4) :initial-element #\a :element-type 'base-char)))
351
(loop repeat 10 nconc (randomly-check-readability a :test #'is-similar
356
(deftest print.array.2.27
357
(subseq (write-to-string (make-array '(2 3) :initial-element 0)
358
:readably nil :array nil)
362
(deftest print.array.2.28
363
(loop for i from 1 to 64
364
for type = `(unsigned-byte ,i)
365
for a = (make-array '(4 3) :element-type type :initial-element 1)
366
for result = (write-to-string a :readably nil :array nil)
367
unless (string= (subseq result 0 2) "#<")
368
collect (list i result))
371
(deftest print.array.2.29
372
(loop for i from 1 to 64
373
for type = `(signed-byte ,i)
374
for a = (make-array '(4 8) :element-type type :initial-element -1)
375
for result = (write-to-string a :readably nil :array nil)
376
unless (string= (subseq result 0 2) "#<")
377
collect (list i result))
380
(deftest print.array.2.30
381
(loop for type in '(short-float single-float double-float long-float)
382
for a = (make-array '(5 7) :element-type type
383
:initial-element (coerce 17 type))
384
for result = (write-to-string a :readably nil :array nil)
385
unless (string= (subseq result 0 2) "#<")
386
collect (list type result))
389
(deftest print.array.2.31
390
(loop for type0 in '(short-float single-float double-float
391
long-float float real)
392
for type = `(complex ,type0)
393
for a = (make-array '(13 5) :element-type type
394
:initial-element (complex 0 (coerce 3 type0)))
395
for result = (write-to-string a :readably nil :array nil)
396
unless (string= (subseq result 0 2) "#<")
397
collect (list type result))
400
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
403
(deftest print.array.3.1
404
(let* ((a (make-array '(1 2 3) :initial-contents '(((:|A| :|B| :|C|) (:|D| :|E| :|F|)))))
405
(b (make-array '(3 2 1) :displaced-to a
406
:displaced-index-offset 0)))
407
(with-standard-io-syntax
409
(write-to-string a :readably nil :array t)
410
(write-to-string b :readably nil :array t))))
411
"#3A(((:A :B :C) (:D :E :F)))"
412
"#3A(((:A) (:B)) ((:C) (:D)) ((:E) (:F)))")
415
;;; Multidimensional arrays
417
(deftest print.array.multi-dim.1
418
(with-standard-io-syntax
419
(loop for d in (remove array-rank-limit
420
'(4 5 6 7 8 9 10 12 16 20 30 40 100 200 400 600 800 1023)
422
for dims = (make-list d :initial-element 1)
423
for a = (make-array dims :initial-element 0)
424
for result = (with-standard-io-syntax
425
(write-to-string a :readably nil :array t))
426
for expected-result =
428
(format nil "#~DA" d)
429
(make-string d :initial-element #\()
431
(make-string d :initial-element #\)))
432
unless (string= result expected-result)
433
collect (list d result expected-result)))
436
(deftest print.array.multi-dim.2
437
(with-standard-io-syntax
438
(loop for d = (+ 4 (random (min (- array-rank-limit 4) 1000)))
440
for dims = (let ((list (make-list d :initial-element 1)))
441
(setf (elt list p) 0)
443
for a = (make-array dims :initial-element 0)
444
for result = (with-standard-io-syntax
445
(write-to-string a :readably nil :array t))
446
for expected-result =
448
(format nil "#~DA" d)
449
(make-string (1+ p) :initial-element #\()
450
(make-string (1+ p) :initial-element #\)))
452
unless (string= result expected-result)
453
collect (list d result expected-result)))
456
;;; To add: more tests for high dimensional arrays, including arrays with