~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/print-array.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
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
    (subseq (write-to-string a :readably nil :array nil) 0 2))
 
29
  "#<")
 
30
 
 
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)))
 
35
  "#0A0")
 
36
 
 
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)))
 
42
  "#0A0")
 
43
 
 
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)))
 
49
  "#0A0")
 
50
 
 
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))
 
54
  nil)
 
55
 
 
56
(deftest print.array.0.8
 
57
  (loop for i from 1 to 64
 
58
        for type = `(unsigned-byte ,i)
 
59
        nconc
 
60
        (let ((a (make-array nil :initial-element 1 :element-type type)))
 
61
          (loop repeat 5 nconc (randomly-check-readability a :test #'is-similar
 
62
                                                           :can-fail t))))
 
63
  nil)
 
64
 
 
65
(deftest print.array.0.9
 
66
  (loop for a = (make-array nil :initial-element (random 1000000) :adjustable t)
 
67
        repeat 30
 
68
        nconc (randomly-check-readability a :test #'is-similar))
 
69
  nil)
 
70
 
 
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))
 
75
  nil)
 
76
 
 
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
 
81
                            :element-type type)
 
82
        nconc
 
83
        (loop repeat 30 nconc (randomly-check-readability a :test #'is-similar
 
84
                                                          :can-fail t)))
 
85
  nil)
 
86
 
 
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
 
92
                            :element-type type)
 
93
        nconc
 
94
        (loop repeat 30 nconc (randomly-check-readability a :test #'is-similar
 
95
                                                          :can-fail t)))
 
96
  nil)
 
97
 
 
98
(deftest print.array.0.13
 
99
  (subseq (write-to-string (make-array nil :initial-element 0)
 
100
                           :readably nil :array nil)
 
101
          0 2)
 
102
  "#<")
 
103
 
 
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))
 
111
  nil)
 
112
 
 
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))
 
120
  nil)
 
121
 
 
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))
 
129
  nil)
 
130
 
 
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))
 
140
  nil)
 
141
 
 
142
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
143
;; Two-d arrays
 
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)))
 
148
  "#2A((1))")
 
149
 
 
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))")
 
155
 
 
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)))
 
160
  "#2A()")
 
161
 
 
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)))
 
166
  "#2A(())")
 
167
 
 
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)))
 
172
  "#2A()")
 
173
 
 
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(() () () () () () () () () ())")
 
179
 
 
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))")
 
187
 
 
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))")
 
195
 
 
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))")
 
203
 
 
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
 
208
                        :adjustable t)))
 
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.11
 
214
  (let* ((a (make-array '(3 4)
 
215
                        :initial-contents '((7 8 9 10) (65 12 42 -1) (:|W| :|X| :|Y| :|Z| ))
 
216
                        :adjustable t)))
 
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))")
 
220
 
 
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)))
 
230
  nil)
 
231
 
 
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)))
 
241
  nil)
 
242
 
 
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)
 
247
                              :adjustable t
 
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)))
 
253
  nil)
 
254
 
 
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)
 
259
                              :adjustable t
 
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)))
 
265
  nil)
 
266
 
 
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
 
272
                              :adjustable t
 
273
                              :initial-contents '((0 1 1) (1 1 0)))
 
274
          for b = (make-array '(2 2) :displaced-to a :displaced-index-offset 2
 
275
                              :element-type type)
 
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)))
 
280
  nil)
 
281
 
 
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
 
287
                              :adjustable t
 
288
                              :initial-contents '((0 1 1) (-1 -2 0)))
 
289
          for b = (make-array '(2 2) :displaced-to a :displaced-index-offset 2
 
290
                              :element-type type)
 
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)))
 
295
  nil)
 
296
 
 
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)))
 
303
  "#2A((3 8) (2 67))")
 
304
 
 
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
 
309
                                                     :can-fail t))
 
310
  nil)
 
311
 
 
312
(deftest print.array.2.22
 
313
  (loop for a = (make-array (list (random 4) (random 4))
 
314
                            :initial-element (- (random 1000000) 500000)
 
315
                            :adjustable t)
 
316
        repeat 100 nconc (randomly-check-readability a :test #'is-similar
 
317
                                                     :can-fail t))
 
318
  nil)
 
319
 
 
320
(deftest print.array.2.23
 
321
  (loop for d1 = (random 10)
 
322
        for d2 = (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
 
331
                                                     :can-fail t))
 
332
  nil)
 
333
 
 
334
(deftest print.array.2.24
 
335
  (loop for i from 1 to 64
 
336
        for type = `(unsigned-byte ,i)
 
337
        nconc
 
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
 
340
                                                           :can-fail t))))
 
341
  nil)
 
342
 
 
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
 
346
                                                      :can-fail t)))
 
347
  nil)
 
348
 
 
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
 
352
                                                      :can-fail t)))
 
353
  nil)
 
354
 
 
355
 
 
356
(deftest print.array.2.27
 
357
  (subseq (write-to-string (make-array '(2 3) :initial-element 0)
 
358
                           :readably nil :array nil)
 
359
          0 2)
 
360
  "#<")
 
361
 
 
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))
 
369
  nil)
 
370
 
 
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))
 
378
  nil)
 
379
 
 
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))
 
387
  nil)
 
388
 
 
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))
 
398
  nil)
 
399
 
 
400
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
401
;;; Three D arrays
 
402
 
 
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
 
408
     (values
 
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)))")
 
413
 
 
414
 
 
415
;;; Multidimensional arrays
 
416
 
 
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)
 
421
                          :test #'<=)
 
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 =
 
427
         (concatenate 'string
 
428
                      (format nil "#~DA" d)
 
429
                      (make-string d :initial-element #\()
 
430
                      "0"
 
431
                      (make-string d :initial-element #\)))
 
432
         unless (string= result expected-result)
 
433
         collect (list d result expected-result)))
 
434
  nil)
 
435
 
 
436
(deftest print.array.multi-dim.2
 
437
  (with-standard-io-syntax
 
438
   (loop for d = (+ 4 (random (min (- array-rank-limit 4) 1000)))
 
439
         for p = (random d)
 
440
         for dims = (let ((list (make-list d :initial-element 1)))
 
441
                      (setf (elt list p) 0)
 
442
                      list)
 
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 =
 
447
         (concatenate 'string
 
448
                      (format nil "#~DA" d)
 
449
                      (make-string (1+ p) :initial-element #\()
 
450
                      (make-string (1+ p) :initial-element #\)))
 
451
         repeat 50
 
452
         unless (string= result expected-result)
 
453
         collect (list d result expected-result)))
 
454
  nil)
 
455
 
 
456
;;; To add: more tests for high dimensional arrays, including arrays with
 
457
;;; element types