source: trunk/source/tests/ansi-tests/print-array.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 15.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Thu Apr 22 22:38:11 2004
4;;;; Contains: Tests of printing of arrays (other than vectors)
5
6(compile-and-load "printer-aux.lsp")
7
8(in-package :cl-test)
9
10;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11;; Zero dimensional arrays
12
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)))
17  "#0A0")
18
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)))
24  "#0AA")
25
26(deftest print.array.0.3
27  (let* ((a (make-array nil :initial-element 0))
28         (result (write-to-string a :readably nil :array nil)))
29    (values
30     (subseq result 0 2)
31     (subseq result (1- (length result)))))
32  "#<" ">")
33
34(deftest print.array.0.4
35   (let ((a (make-array nil :initial-element 0 :adjustable t)))
36    (with-standard-io-syntax
37     (write-to-string a :readably nil :array t)))
38  "#0A0")
39
40(deftest print.array.0.5
41   (let* ((a (make-array nil :initial-element 0 :adjustable t))
42          (b (make-array nil :displaced-to a :displaced-index-offset 0)))
43    (with-standard-io-syntax
44     (write-to-string b :readably nil :array t)))
45  "#0A0")
46
47(deftest print.array.0.6
48  (let ((a (make-array nil :initial-element 0
49                       :element-type '(integer 0 2))))
50    (with-standard-io-syntax
51     (write-to-string a :readably nil :array t)))
52  "#0A0")
53
54(deftest print.array.0.7
55  (loop for a = (make-array nil :initial-element (- (random 1000000) 500000))
56        repeat 30 nconc (randomly-check-readability a :test #'is-similar))
57  nil)
58
59(deftest print.array.0.8
60  (loop for i from 1 to 64
61        for type = `(unsigned-byte ,i)
62        nconc
63        (let ((a (make-array nil :initial-element 1 :element-type type)))
64          (loop repeat 5 nconc (randomly-check-readability a :test #'is-similar
65                                                           :can-fail t))))
66  nil)
67
68(deftest print.array.0.9
69  (loop for a = (make-array nil :initial-element (random 1000000) :adjustable t)
70        repeat 30
71        nconc (randomly-check-readability a :test #'is-similar))
72  nil)
73
74(deftest print.array.0.10
75  (loop for a = (make-array nil :initial-element (random 1000000000))
76        for b = (make-array nil :displaced-to a :displaced-index-offset 0)
77        repeat 30 nconc (randomly-check-readability b :test #'is-similar))
78  nil)
79
80(deftest print.array.0.11
81  (loop for type in '(short-float single-float double-float long-float float)
82        for zero = (coerce 0 type)
83        for a = (make-array nil :initial-element zero
84                            :element-type type)
85        nconc
86        (loop repeat 30 nconc (randomly-check-readability a :test #'is-similar
87                                                          :can-fail t)))
88  nil)
89
90(deftest print.array.0.12
91  (loop for type0 in '(short-float single-float double-float long-float float)
92        for type = `(complex ,type0)
93        for zero = (complex (coerce 0.0s0 type0))
94        for a = (make-array nil :initial-element zero
95                            :element-type type)
96        nconc
97        (loop repeat 30 nconc (randomly-check-readability a :test #'is-similar
98                                                          :can-fail t)))
99  nil)
100
101(deftest print.array.0.13
102  (let ((result (write-to-string (make-array nil :initial-element 0)
103                                 :readably nil :array nil)))
104    (values
105     (subseq result 0 2)
106     (subseq result (1- (length result)))))
107  "#<" ">")
108
109(deftest print.array.0.14
110  (loop for i from 1 to 64
111        for type = `(unsigned-byte ,i)
112        for a = (make-array nil :element-type type :initial-element 1)
113        for result = (write-to-string a :readably nil :array nil)
114        unless (and (string= (subseq result 0 2) "#<")
115                    (string= (subseq result (1- (length result))) ">"))
116        collect (list i result))
117  nil)
118
119(deftest print.array.0.15
120  (loop for i from 1 to 64
121        for type = `(signed-byte ,i)
122        for a = (make-array nil :element-type type :initial-element -1)
123        for result = (write-to-string a :readably nil :array nil)
124        unless (and (string= (subseq result 0 2) "#<")
125                    (string= (subseq result (1- (length result))) ">"))
126        collect (list i result))
127  nil)
128
129(deftest print.array.0.16
130  (loop for type in '(short-float single-float double-float long-float)
131        for a = (make-array nil :element-type type
132                            :initial-element (coerce 17 type))
133        for result = (write-to-string a :readably nil :array nil)
134        unless (and (string= (subseq result 0 2) "#<")
135                    (string= (subseq result (1- (length result))) ">"))
136        collect (list type result))
137  nil)
138
139(deftest print.array.0.17
140  (loop for type0 in '(short-float single-float double-float
141                                   long-float float real)
142        for type = `(complex ,type0)
143        for a = (make-array nil :element-type type
144                            :initial-element (complex 0 (coerce 3 type0)))
145        for result = (write-to-string a :readably nil :array nil)
146        unless (and (string= (subseq result 0 2) "#<")
147                    (string= (subseq result (1- (length result))) ">"))
148        collect (list type result))
149  nil)
150
151;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
152;; Two-d arrays
153(deftest print.array.2.1
154  (let ((a (make-array '(1 1) :initial-contents '((1)))))
155    (with-standard-io-syntax
156     (write-to-string a :readably nil :array t)))
157  "#2A((1))")
158
159(deftest print.array.2.2
160  (let ((a (make-array '(2 3) :initial-contents '((1 3 8)(2 6 10)))))
161    (with-standard-io-syntax
162     (write-to-string a :readably nil :array t)))
163  "#2A((1 3 8) (2 6 10))")
164
165(deftest print.array.2.3
166  (let ((a (make-array '(0 1))))
167    (with-standard-io-syntax
168     (write-to-string a :readably nil :array t)))
169  "#2A()")
170
171(deftest print.array.2.4
172  (let ((a (make-array '(1 0))))
173    (with-standard-io-syntax
174     (write-to-string a :readably nil :array t)))
175  "#2A(())")
176
177(deftest print.array.2.5
178  (let ((a (make-array '(0 0))))
179    (with-standard-io-syntax
180     (write-to-string a :readably nil :array t)))
181  "#2A()")
182
183(deftest print.array.2.6
184  (let ((a (make-array '(10 0))))
185    (with-standard-io-syntax
186     (write-to-string a :readably nil :array t)))
187  "#2A(() () () () () () () () () ())")
188
189(deftest print.array.2.7
190  (let* ((a (make-array '(3 3) :initial-contents '((1 3 8) (2 67 121) (65 432 6))))
191         (b (make-array '(3 3) :displaced-to a
192                        :displaced-index-offset 0)))
193    (with-standard-io-syntax
194     (write-to-string b :readably nil :array t)))
195  "#2A((1 3 8) (2 67 121) (65 432 6))")
196
197(deftest print.array.2.8
198  (let* ((a (make-array '(3 3) :initial-contents '((1 3 8) (2 67 121) (65 432 6))))
199         (b (make-array '(2 3) :displaced-to a
200                        :displaced-index-offset 0)))
201    (with-standard-io-syntax
202     (write-to-string b :readably nil :array t)))
203  "#2A((1 3 8) (2 67 121))")
204
205(deftest print.array.2.9
206  (let* ((a (make-array '(3 3) :initial-contents '((1 3 8) (2 67 121) (65 432 6))))
207         (b (make-array '(2 2) :displaced-to a
208                        :displaced-index-offset 4)))
209    (with-standard-io-syntax
210     (write-to-string b :readably nil :array t)))
211  "#2A((67 121) (65 432))")
212
213(deftest print.array.2.10
214  (let* ((a (make-array '(3 3) :initial-contents '((1 3 8) (2 67 121) (65 432 6))))
215         (b (make-array '(2 2) :displaced-to a
216                        :displaced-index-offset 4
217                        :adjustable t)))
218    (with-standard-io-syntax
219     (write-to-string b :readably nil :array t)))
220  "#2A((67 121) (65 432))")
221
222(deftest print.array.2.11
223  (let* ((a (make-array '(3 4)
224                        :initial-contents '((7 8 9 10) (65 12 42 -1) (:|W| :|X| :|Y| :|Z| ))
225                        :adjustable t)))
226    (with-standard-io-syntax
227     (write-to-string a :readably nil :array t)))
228  "#2A((7 8 9 10) (65 12 42 -1) (:W :X :Y :Z))")
229
230(deftest print.array.2.12
231  (let ((desired-result "#2A((0 1 1) (1 1 0))"))
232    (loop for i from 2 to 64
233          for a = (make-array '(2 3) :element-type `(unsigned-byte ,i)
234                              :initial-contents '((0 1 1) (1 1 0)))
235          for result = (with-standard-io-syntax
236                        (write-to-string a :readably nil :array t))
237          unless (string= desired-result result)
238          collect (list i a result)))
239  nil)
240
241(deftest print.array.2.13
242  (let ((desired-result "#2A((0 -1 -1) (-1 -1 0))"))
243    (loop for i from 1 to 64
244          for a = (make-array '(2 3) :element-type `(signed-byte ,i)
245                              :initial-contents '((0 -1 -1) (-1 -1 0)))
246          for result = (with-standard-io-syntax
247                        (write-to-string a :readably nil :array t))
248          unless (string= desired-result result)
249          collect (list i a result)))
250  nil)
251
252(deftest print.array.2.14
253  (let ((desired-result "#2A((0 1 1) (1 1 0))"))
254    (loop for i from 2 to 64
255          for a = (make-array '(2 3) :element-type `(unsigned-byte ,i)
256                              :adjustable t
257                              :initial-contents '((0 1 1) (1 1 0)))
258          for result = (with-standard-io-syntax
259                        (write-to-string a :readably nil :array t))
260          unless (string= desired-result result)
261          collect (list i a result)))
262  nil)
263
264(deftest print.array.2.15
265  (let ((desired-result "#2A((0 -1 -1) (-1 -1 0))"))
266    (loop for i from 1 to 64
267          for a = (make-array '(2 3) :element-type `(signed-byte ,i)
268                              :adjustable t
269                              :initial-contents '((0 -1 -1) (-1 -1 0)))
270          for result = (with-standard-io-syntax
271                        (write-to-string a :readably nil :array t))
272          unless (string= desired-result result)
273          collect (list i a result)))
274  nil)
275
276(deftest print.array.2.16
277  (let ((desired-result "#2A((1 1) (1 0))"))
278    (loop for i from 2 to 64
279          for type = `(unsigned-byte ,i)
280          for a = (make-array '(2 3) :element-type type
281                              :adjustable t
282                              :initial-contents '((0 1 1) (1 1 0)))
283          for b = (make-array '(2 2) :displaced-to a :displaced-index-offset 2
284                              :element-type type)
285          for result = (with-standard-io-syntax
286                        (write-to-string b :readably nil :array t))
287          unless (string= desired-result result)
288          collect (list i b result)))
289  nil)
290
291(deftest print.array.2.17
292  (let ((desired-result "#2A((1 -1) (-2 0))"))
293    (loop for i from 2 to 64
294          for type = `(signed-byte ,i)
295          for a = (make-array '(2 3) :element-type type
296                              :adjustable t
297                              :initial-contents '((0 1 1) (-1 -2 0)))
298          for b = (make-array '(2 2) :displaced-to a :displaced-index-offset 2
299                              :element-type type)
300          for result = (with-standard-io-syntax
301                        (write-to-string b :readably nil :array t))
302          unless (string= desired-result result)
303          collect (list i b result)))
304  nil)
305
306(deftest print.array.2.20
307  (let* ((a (make-array '(9) :initial-contents '(1 3 8 2 67 121 65 432 6)))
308         (b (make-array '(2 2) :displaced-to a
309                        :displaced-index-offset 1)))
310    (with-standard-io-syntax
311     (write-to-string b :readably nil :array t)))
312  "#2A((3 8) (2 67))")
313
314(deftest print.array.2.21
315  (trim-list
316   (loop
317      for dims = (list (random 4) (random 4))
318      for a = (make-array dims :initial-element (- (random 1000000) 500000))
319      repeat 100
320      nconc (let ((result (randomly-check-readability a :test #'is-similar :can-fail t)))
321              (and result (list (cons dims (first result))))))
322   10)
323  nil)
324
325(deftest print.array.2.22
326  (loop for a = (make-array (list (random 4) (random 4))
327                            :initial-element (- (random 1000000) 500000)
328                            :adjustable t)
329        repeat 100 nconc (randomly-check-readability a :test #'is-similar
330                                                     :can-fail t))
331  nil)
332
333(deftest print.array.2.23
334  (loop for d1 = (random 10)
335        for d2 = (random 10)
336        for a = (make-array (list d1 d2)
337                            :initial-element (- (random 1000000) 500000))
338        for d1a = (random (1+ d1))
339        for d2a = (random (1+ d2))
340        for offset = (random (1+ (- (* d1 d2) (* d1a d2a))))
341        for b = (make-array (list d1a d2a) :displaced-to a
342                            :displaced-index-offset offset)
343        repeat 100 nconc (randomly-check-readability b :test #'is-similar
344                                                     :can-fail t))
345  nil)
346
347(deftest print.array.2.24
348  (loop for i from 1 to 64
349        for type = `(unsigned-byte ,i)
350        nconc
351        (let ((a (make-array '(3 4) :initial-element 1 :element-type type)))
352          (loop repeat 5 nconc (randomly-check-readability a :test #'is-similar
353                                                           :can-fail t))))
354  nil)
355
356(deftest print.array.2.25
357  (let ((a (make-array '(3 4) :initial-element #\a :element-type 'character)))
358    (loop repeat 10 nconc (randomly-check-readability a :test #'is-similar
359                                                      :can-fail t)))
360  nil)
361
362(deftest print.array.2.26
363  (let ((a (make-array '(3 4) :initial-element #\a :element-type 'base-char)))
364    (loop repeat 10 nconc (randomly-check-readability a :test #'is-similar
365                                                      :can-fail t)))
366  nil)
367
368
369(deftest print.array.2.27
370  (let ((str (write-to-string (make-array '(2 3) :initial-element 0)
371                              :readably nil :array nil)))
372    (values (subseq str 0 2) (subseq str (1- (length str)))))
373  "#<" ">")
374
375(deftest print.array.2.28
376  (loop for i from 1 to 64
377        for type = `(unsigned-byte ,i)
378        for a = (make-array '(4 3) :element-type type :initial-element 1)
379        for result = (write-to-string a :readably nil :array nil)
380        unless (and (string= (subseq result 0 2) "#<")
381                    (string= (subseq result (1- (length result))) ">"))
382        collect (list i result))
383  nil)
384
385(deftest print.array.2.29
386  (loop for i from 1 to 64
387        for type = `(signed-byte ,i)
388        for a = (make-array '(4 8) :element-type type :initial-element -1)
389        for result = (write-to-string a :readably nil :array nil)
390        unless (and (string= (subseq result 0 2) "#<")
391                    (string= (subseq result (1- (length result))) ">"))
392        collect (list i result))
393  nil)
394
395(deftest print.array.2.30
396  (loop for type in '(short-float single-float double-float long-float)
397        for a = (make-array '(5 7) :element-type type
398                            :initial-element (coerce 17 type))
399        for result = (write-to-string a :readably nil :array nil)
400        unless (and (string= (subseq result 0 2) "#<")
401                    (string= (subseq result (1- (length result))) ">"))
402        collect (list type result))
403  nil)
404
405(deftest print.array.2.31
406  (loop for type0 in '(short-float single-float double-float
407                                   long-float float real)
408        for type = `(complex ,type0)
409        for a = (make-array '(13 5) :element-type type
410                            :initial-element (complex 0 (coerce 3 type0)))
411        for result = (write-to-string a :readably nil :array nil)
412        unless (and (string= (subseq result 0 2) "#<")
413                    (string= (subseq result (1- (length result))) ">"))
414        collect (list type result))
415  nil)
416
417;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
418;;; Three D arrays
419
420(deftest print.array.3.1
421  (let* ((a (make-array '(1 2 3) :initial-contents '(((:|A| :|B| :|C|) (:|D| :|E| :|F|)))))
422         (b (make-array '(3 2 1) :displaced-to a
423                        :displaced-index-offset 0)))
424    (with-standard-io-syntax
425     (values
426      (write-to-string a :readably nil :array t)
427      (write-to-string b :readably nil :array t))))
428  "#3A(((:A :B :C) (:D :E :F)))"
429  "#3A(((:A) (:B)) ((:C) (:D)) ((:E) (:F)))")
430
431
432;;; Multidimensional arrays
433
434(deftest print.array.multi-dim.1
435  (with-standard-io-syntax
436   (loop for d in (remove array-rank-limit
437                          '(4 5 6 7 8 9 10 12 16 20 30 40 100 200 400 600 800 1023)
438                          :test #'<=)
439         for dims = (make-list d :initial-element 1)
440         for a = (make-array dims :initial-element 0)
441         for result = (with-standard-io-syntax
442                       (write-to-string a :readably nil :array t))
443         for expected-result =
444         (concatenate 'string
445                      (format nil "#~DA" d)
446                      (make-string d :initial-element #\()
447                      "0"
448                      (make-string d :initial-element #\)))
449         unless (string= result expected-result)
450         collect (list d result expected-result)))
451  nil)
452
453(deftest print.array.multi-dim.2
454  (with-standard-io-syntax
455   (loop for d = (+ 4 (random (min (- array-rank-limit 4) 1000)))
456         for p = (random d)
457         for dims = (let ((list (make-list d :initial-element 1)))
458                      (setf (elt list p) 0)
459                      list)
460         for a = (make-array dims :initial-element 0)
461         for result = (with-standard-io-syntax
462                       (write-to-string a :readably nil :array t))
463         for expected-result =
464         (concatenate 'string
465                      (format nil "#~DA" d)
466                      (make-string (1+ p) :initial-element #\()
467                      (make-string (1+ p) :initial-element #\)))
468         repeat 50
469         unless (string= result expected-result)
470         collect (list d result expected-result)))
471  nil)
472
473;;; To add: more tests for high dimensional arrays, including arrays with
474;;; element types
Note: See TracBrowser for help on using the repository browser.