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

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

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

File size: 20.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Fri Sep 20 06:47:37 2002
4;;;; Contains: Tests for MAKE-ARRAY
5
6(in-package :cl-test)
7
8(compile-and-load "array-aux.lsp")
9
10(deftest make-array.1
11  (let ((a (make-array-with-checks 10)))
12    (and (symbolp a) a))
13  nil)
14
15(deftest make-array.1a
16  (let ((a (make-array-with-checks '(10))))
17    (and (symbolp a) a))
18  nil)
19
20(deftest make-array.2
21  (make-array-with-checks 3 :initial-element 'z)
22  #(z z z))
23
24(deftest make-array.2a
25  (make-array-with-checks 3 :initial-contents '(a b c))
26  #(a b c))
27
28(deftest make-array.2b
29  (make-array-with-checks 3 :initial-contents #(a b c))
30  #(a b c))
31
32(deftest make-array.2c
33  (make-array-with-checks 3 :initial-contents "abc")
34  #(#\a #\b #\c))
35
36(deftest make-array.2d
37  (make-array-with-checks 3 :initial-contents #*010)
38  #(0 1 0))
39
40(deftest make-array.3
41  (let ((a (make-array-with-checks 5 :element-type 'bit)))
42    (and (symbolp a) a))
43  nil)
44
45(deftest make-array.4
46  (make-array-with-checks 5 :element-type 'bit :initial-element 1)
47  #*11111)
48
49(deftest make-array.4a
50  (make-array-with-checks 5 :element-type 'bit :initial-contents '(1 0 0 1 0))
51  #*10010)
52
53(deftest make-array.4b
54  (make-array-with-checks 5 :element-type 'bit :initial-contents #(1 0 0 1 0))
55  #*10010)
56
57(deftest make-array.4c
58  (make-array-with-checks 5 :element-type 'bit :initial-contents #*10010)
59  #*10010)
60
61(deftest make-array.5
62  (let ((a (make-array-with-checks 4 :element-type 'character)))
63    (and (symbolp a) a))
64  nil)
65
66(deftest make-array.5a
67  (let ((a (make-array-with-checks '(4) :element-type 'character)))
68    (and (symbolp a) a))
69  nil)
70
71(deftest make-array.6
72  (make-array-with-checks 4 :element-type 'character
73                          :initial-element #\x)
74  "xxxx")
75
76(deftest make-array.6a
77  (make-array-with-checks 4 :element-type 'character
78                          :initial-contents '(#\a #\b #\c #\d))
79  "abcd")
80
81(deftest make-array.6b
82  (make-array-with-checks 4 :element-type 'character
83                          :initial-contents "abcd")
84  "abcd")
85
86(deftest make-array.7
87  (make-array-with-checks 5 :element-type 'symbol
88                          :initial-element 'a)
89  #(a a a a a))
90
91(deftest make-array.7a
92  (make-array-with-checks 5 :element-type 'symbol
93                          :initial-contents '(a b c d e))
94  #(a b c d e))
95
96(deftest make-array.7b
97  (make-array-with-checks '(5) :element-type 'symbol
98                          :initial-contents '(a b c d e))
99  #(a b c d e))
100
101(deftest make-array.8
102  (let ((a (make-array-with-checks 8 :element-type '(integer 0 (256)))))
103    ;; Should return a symbol only in error situations
104    (and (symbolp a) a))
105  nil)
106
107(deftest make-array.8a
108  (make-array-with-checks 8 :element-type '(integer 0 (256))
109                          :initial-element 9)
110  #(9 9 9 9 9 9 9 9))
111
112(deftest make-array.8b
113  (make-array-with-checks '(8) :element-type '(integer 0 (256))
114                          :initial-contents '(4 3 2 1 9 8 7 6))
115  #(4 3 2 1 9 8 7 6))
116
117(deftest make-array.8c
118  (loop for i from 1 to 32
119        for tp = `(unsigned-byte ,i)
120        for a = (make-array 5 :fill-pointer 3 :element-type tp :initial-contents '(1 1 0 0 1))
121        when (symbolp a)
122        collect (list i tp a))
123  nil)
124
125(deftest make-array.8d
126  (loop for i from 2 to 32
127        for tp = `(signed-byte ,i)
128        for a = (make-array 5 :fill-pointer 3 :element-type tp :initial-contents '(1 1 0 0 1))
129        when (symbolp a)
130        collect (list i tp a))
131  nil)
132
133(deftest make-array.8e
134  (loop for tp in '(short-float single-float double-float long-float)
135        for v in '(1.0s0 1.0f0 1.0d0 1.0l0)
136        for a = (make-array 5 :fill-pointer 3 :element-type tp :initial-element v)
137        when (symbolp a)
138        collect (list tp v a))
139  nil)
140
141(deftest make-array.8f
142  (loop for tp in '(short-float single-float double-float long-float)
143        for v in '(1.0s0 1.0f0 1.0d0 1.0l0)
144        for a = (make-array 5 :fill-pointer 3 :element-type `(complex ,tp)
145                            :initial-element (complex v))
146        when (symbolp a)
147        collect (list tp v a))
148  nil)
149
150;;; Zero dimensional arrays
151
152(deftest make-array.9
153  (let ((a (make-array-with-checks nil)))
154    (and (symbolp a) a))
155  nil)
156
157(deftest make-array.10
158  (make-array-with-checks nil :initial-element 1)
159  #0a1)
160
161(deftest make-array.11
162  (make-array-with-checks nil :initial-contents 2)
163  #0a2)
164
165(deftest make-array.12
166  (make-array-with-checks nil :element-type 'bit :initial-contents 1)
167  #0a1)
168
169(deftest make-array.12a
170  (make-array-with-checks 10 :element-type 'bit :initial-contents '(1 0 0 1 1 0 0 1 0 0)
171                          :fill-pointer 6)
172  #*100110)
173
174(deftest make-array.12b
175  (make-array-with-checks 10 :element-type 'character
176                          :initial-contents "abcdefghij"
177                          :fill-pointer 8)
178  "abcdefgh")
179
180(deftest make-array.12c
181  (make-array-with-checks 10 :element-type 'base-char
182                          :initial-contents "abcdefghij"
183                          :fill-pointer 8)
184  "abcdefgh")
185
186(deftest make-array.13
187  (make-array-with-checks nil :element-type t :initial-contents 'a)
188  #0aa)
189
190;;; Higher dimensional arrays
191
192(deftest make-array.14
193  (let ((a (make-array-with-checks '(2 3))))
194    (and (symbolp a) a))
195  nil)
196
197(deftest make-array.15
198  (make-array-with-checks '(2 3) :initial-element 'x)
199  #2a((x x x) (x x x)))
200
201(deftest make-array.16
202  (equalpt (make-array-with-checks '(0 0))
203           (read-from-string "#2a()"))
204  t)
205
206(deftest make-array.17
207  (make-array-with-checks '(2 3) :initial-contents '((a b c) (d e f)))
208  #2a((a b c) (d e f)))
209
210(deftest make-array.18
211  (make-array-with-checks '(2 3) :initial-contents '(#(a b c) #(d e f)))
212  #2a((a b c) (d e f)))
213
214(deftest make-array.19
215  (make-array-with-checks '(4) :initial-contents
216                          (make-array '(10) :initial-element 1
217                                      :fill-pointer 4))
218  #(1 1 1 1))
219
220(deftest make-array.20
221  (let ((a (make-array '(10) :initial-element 1
222                       :fill-pointer 4)))
223    (make-array-with-checks '(3 4) :initial-contents
224                            (list a a a)))
225  #2a((1 1 1 1) (1 1 1 1) (1 1 1 1)))
226
227(deftest make-array.21
228  (make-array-with-checks '(3 4) :initial-contents
229                          (make-array '(10) :initial-element '(1 2 3 4)
230                                      :fill-pointer 3))
231  #2a((1 2 3 4) (1 2 3 4) (1 2 3 4)))
232
233(deftest make-array.22
234  (loop for i from 3 below (min array-rank-limit 128)
235        always
236        (equalpt (make-array-with-checks (make-list i :initial-element 0))
237                 (read-from-string (format nil "#~Aa()" i))))
238  t)
239
240(deftest make-array.23
241  (let ((len (1- array-rank-limit)))
242    (equalpt (make-array-with-checks (make-list len :initial-element 0))
243             (read-from-string (format nil "#~Aa()" len))))
244  t)
245
246;;; (deftest make-array.24
247;;;  (make-array-with-checks '(5) :initial-element 'a :displaced-to nil)
248;;;  #(a a a a a))
249
250(deftest make-array.25
251  (make-array '(4) :initial-element 'x :nonsense-argument t
252              :allow-other-keys t)
253  #(x x x x))
254
255(deftest make-array.26
256  (make-array '(4) :initial-element 'x
257              :allow-other-keys nil)
258  #(x x x x))
259
260(deftest make-array.27
261  (make-array '(4) :initial-element 'x
262              :allow-other-keys t
263              :allow-other-keys nil
264              :nonsense-argument t)
265  #(x x x x))
266
267(deftest make-array.28
268  (let ((*package* (find-package :cl-test)))
269    (let ((len (1- (min 10000 array-rank-limit))))
270      (equalpt (make-array (make-list len :initial-element 1) :initial-element 'x)
271               (read-from-string (concatenate
272                                  'string
273                                  (format nil "#~dA" len)
274                                  (make-string len :initial-element #\()
275                                  "x"
276                                  (make-string len :initial-element #\)))))))
277  t)
278
279(deftest make-array.29
280  (make-array-with-checks '(5) :element-type '(integer 0 (256))
281                          :initial-contents '(0 5 255 119 57))
282  #(0 5 255 119 57))
283
284(deftest make-array.30
285  (make-array-with-checks '(5) :element-type '(integer -128 127)
286                          :initial-contents '(-10 5 -128 86 127))
287  #(-10 5 -128 86 127))
288
289(deftest make-array.31
290  (make-array-with-checks '(5) :element-type '(integer 0 (65536))
291                          :initial-contents '(0 100 65535 7623 13))
292  #(0 100 65535 7623 13))
293
294(deftest make-array.32
295  (make-array-with-checks '(5) :element-type 'fixnum
296                          :initial-contents '(1 2 3 4 5))
297  #(1 2 3 4 5))
298
299(deftest make-array.33
300  (make-array-with-checks '(5) :element-type 'short-float
301                          :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
302  #(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
303
304(deftest make-array.34
305  (make-array-with-checks '(5) :element-type 'single-float
306                          :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
307  #(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
308
309(deftest make-array.35
310  (make-array-with-checks '(5) :element-type 'double-float
311                          :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
312  #(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
313
314(deftest make-array.36
315  (make-array-with-checks '(5) :element-type 'long-float
316                          :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
317  #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
318
319
320;;; Adjustable arrays
321
322(deftest make-array.adjustable.1
323  (let ((a (make-array-with-checks '(10) :adjustable t)))
324    (and (symbolp a) a))
325  nil)
326
327(deftest make-array.adjustable.2
328 (make-array-with-checks '(4) :adjustable t
329                         :initial-element 6)
330 #(6 6 6 6))
331
332(deftest make-array.adjustable.3
333  (make-array-with-checks nil :adjustable t :initial-element 7)
334  #0a7)
335
336(deftest make-array.adjustable.4
337  (make-array-with-checks '(2 3) :adjustable t :initial-element 7)
338  #2a((7 7 7) (7 7 7)))
339
340(deftest make-array.adjustable.5
341  (make-array-with-checks '(2 3) :adjustable t
342                          :initial-contents '((1 2 3) "abc"))
343  #2a((1 2 3) (#\a #\b #\c)))
344
345(deftest make-array.adjustable.6
346 (make-array-with-checks '(4) :adjustable t
347                         :initial-contents '(a b c d))
348 #(a b c d))
349
350(deftest make-array.adjustable.7
351 (make-array-with-checks '(4) :adjustable t
352                         :fill-pointer t
353                         :initial-contents '(a b c d))
354 #(a b c d))
355
356(deftest make-array.adjustable.7a
357 (make-array-with-checks '(4) :adjustable t
358                         :element-type 'bit
359                         :fill-pointer t
360                         :initial-contents '(1 0 0 1))
361 #(1 0 0 1))
362
363(deftest make-array.adjustable.7b
364 (make-array-with-checks '(4) :adjustable t
365                         :element-type 'base-char
366                         :fill-pointer t
367                         :initial-contents "abcd")
368 "abcd")
369
370(deftest make-array.adjustable.7c
371 (make-array-with-checks '(4) :adjustable t
372                         :element-type 'character
373                         :fill-pointer t
374                         :initial-contents "abcd")
375 "abcd")
376
377(deftest make-array.adjustable.8
378 (make-array-with-checks '(4) :adjustable t
379                         :element-type '(integer 0 (256))
380                         :initial-contents '(1 4 7 9))
381 #(1 4 7 9))
382
383(deftest make-array.adjustable.9
384 (make-array-with-checks '(4) :adjustable t
385                         :element-type 'base-char
386                         :initial-contents "abcd")
387 "abcd")
388
389(deftest make-array.adjustable.10
390 (make-array-with-checks '(4) :adjustable t
391                         :element-type 'bit
392                         :initial-contents '(0 1 1 0))
393 #*0110)
394
395(deftest make-array.adjustable.11
396 (make-array-with-checks '(4) :adjustable t
397                         :element-type 'symbol
398                         :initial-contents '(a b c d))
399 #(a b c d))
400
401;;; Displaced arrays
402
403(deftest make-array.displaced.1
404  (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))))
405    (make-array-with-checks '(5) :displaced-to a))
406  #(a b c d e))
407
408(deftest make-array.displaced.2
409  (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))))
410    (make-array-with-checks '(5) :displaced-to a
411                            :displaced-index-offset 3))
412  #(d e f g h))
413
414(deftest make-array.displaced.3
415  (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))))
416    (make-array-with-checks '(5) :displaced-to a
417                            :displaced-index-offset 5))
418  #(f g h i j))
419
420(deftest make-array.displaced.4
421  (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))))
422    (make-array-with-checks '(0) :displaced-to a
423                            :displaced-index-offset 10))
424  #())
425
426(deftest make-array.displaced.5
427  (let ((a (make-array '(10) :element-type '(integer 0 (256))
428                       :initial-contents '(1 3 5 7 9 11 13 15 17 19))))
429    (make-array-with-checks '(5) :element-type '(integer 0 (256))
430                            :displaced-to a))
431  #(1 3 5 7 9))
432
433(deftest make-array.displaced.6
434  (let ((a (make-array '(10) :element-type '(integer 0 (256))
435                       :initial-contents '(1 3 5 7 9 11 13 15 17 19))))
436    (loop for i from 0 to 5 collect
437          (make-array-with-checks '(5) :element-type '(integer 0 (256))
438                                  :displaced-to a
439                                  :displaced-index-offset i)))
440  (#(1 3 5 7 9)
441   #(3 5 7 9 11)
442   #(5 7 9 11 13)
443   #(7 9 11 13 15)
444   #(9 11 13 15 17)
445   #(11 13 15 17 19)))
446
447(deftest make-array.displaced.7
448  (let ((a (make-array '(10) :element-type '(integer 0 (256))
449                       :initial-contents '(1 3 5 7 9 11 13 15 17 19))))
450    (make-array-with-checks '(0) :element-type '(integer 0 (256))
451                            :displaced-to a
452                            :displaced-index-offset 10))
453  #())
454
455(deftest make-array.displaced.8
456  (let ((a (make-array '(10) :element-type 'bit
457                       :initial-contents '(0 1 1 0 1 1 1 0 1 0))))
458    (make-array-with-checks '(5) :element-type 'bit
459                            :displaced-to a))
460  #*01101)
461
462(deftest make-array.displaced.9
463  (let ((a (make-array '(10) :element-type 'bit
464                       :initial-contents '(0 1 1 0 1 1 1 0 1 0))))
465    (loop for i from 0 to 5 collect
466          (make-array-with-checks '(5) :element-type 'bit
467                                  :displaced-to a
468                                  :displaced-index-offset i)))
469  (#*01101 #*11011 #*10111 #*01110 #*11101 #*11010))
470
471(deftest make-array.displaced.10
472  (let ((a (make-array '(10) :element-type 'bit
473                       :initial-contents '(0 1 1 0 1 1 1 0 1 0))))
474    (make-array-with-checks '(0) :element-type 'bit
475                            :displaced-to a
476                            :displaced-index-offset 10))
477  #*)
478
479(deftest make-array.displaced.11
480  (let ((a (make-array '(10) :element-type 'base-char
481                       :initial-contents "abcdefghij")))
482    (make-array-with-checks '(5) :element-type 'base-char
483                            :displaced-to a))
484  "abcde")
485
486(deftest make-array.displaced.12
487  (let ((a (make-array '(10) :element-type 'base-char
488                       :initial-contents "abcdefghij")))
489    (loop for i from 0 to 5 collect
490          (make-array-with-checks '(5) :element-type 'base-char
491                                  :displaced-to a
492                                  :displaced-index-offset i)))
493  ("abcde"
494   "bcdef"
495   "cdefg"
496   "defgh"
497   "efghi"
498   "fghij"))
499
500(deftest make-array.displaced.13
501  (let ((a (make-array '(10) :element-type 'base-char
502                       :initial-contents "abcdefghij")))
503    (make-array-with-checks '(0) :element-type 'base-char
504                            :displaced-to a
505                            :displaced-index-offset 10))
506  "")
507
508(deftest make-array.displaced.14
509  (let ((a (make-array '(10) :element-type 'character
510                       :initial-contents "abcdefghij")))
511    (make-array-with-checks '(5) :element-type 'character
512                            :displaced-to a))
513  "abcde")
514
515(deftest make-array.displaced.15
516  (let ((a (make-array '(10) :element-type 'character
517                       :initial-contents "abcdefghij")))
518    (loop for i from 0 to 5 collect
519          (make-array-with-checks '(5) :element-type 'character
520                                  :displaced-to a
521                                  :displaced-index-offset i)))
522  ("abcde"
523   "bcdef"
524   "cdefg"
525   "defgh"
526   "efghi"
527   "fghij"))
528
529(deftest make-array.displaced.16
530  (let ((a (make-array '(10) :element-type 'character
531                       :initial-contents "abcdefghij")))
532    (make-array-with-checks '(0) :element-type 'character
533                            :displaced-to a
534                            :displaced-index-offset 10))
535  "")
536
537;;; Multidimensional displaced arrays
538
539(deftest make-array.displaced.17
540  (let ((a (make-array '(3 4) :initial-contents '((1 2 3 4) (5 6 7 8)
541                                                  (9 10 11 12)))))
542    (make-array-with-checks '(8) :displaced-to a))
543  #(1 2 3 4 5 6 7 8))
544
545(deftest make-array.displaced.18
546  (let ((a (make-array '(3 4) :initial-contents '((1 2 3 4) (5 6 7 8)
547                                                  (9 10 11 12)))))
548    (make-array-with-checks '(8) :displaced-to a
549                            :displaced-index-offset 3))
550  #(4 5 6 7 8 9 10 11))
551
552(deftest make-array.displaced.19
553  (let ((a (make-array '(3 4) :initial-contents '((1 2 3 4) (5 6 7 8)
554                                                  (9 10 11 12)))))
555    (make-array-with-checks '(2 4) :displaced-to a
556                            :displaced-index-offset 4))
557  #2a((5 6 7 8) (9 10 11 12)))
558
559(deftest make-array.displaced.20
560  (let ((a (make-array '(2 3 4)
561                       :initial-contents '(((a b c d) (e f g h) (i j k l))
562                                           ((m n o p) (q r s t) (u v w x))))))
563    (make-array-with-checks '(24) :displaced-to a))
564  #(a b c d e f g h i j k l m n o p q r s t u v w x))
565
566(deftest make-array.displaced.21
567  (let ((a (make-array '(2 3 4)
568                       :initial-contents '(((a b c d) (e f g h) (i j k l))
569                                           ((m n o p) (q r s t) (u v w x))))))
570    (make-array-with-checks '(3 8) :displaced-to a))
571  #2a((a b c d e f g h) (i j k l m n o p) (q r s t u v w x)))
572
573(deftest make-array.displaced.22
574  (let ((a (make-array '(2 3 4)
575                       :initial-contents '(((a b c d) (e f g h) (i j k l))
576                                           ((m n o p) (q r s t) (u v w x))))))
577    (make-array-with-checks '(10) :displaced-to a
578                            :displaced-index-offset 5))
579  #(f g h i j k l m n o))
580
581(deftest make-array.displaced.23
582  (let ((a (make-array '(2 3 4)
583                       :initial-contents '(((a b c d) (e f g h) (i j k l))
584                                           ((m n o p) (q r s t) (u v w x))))))
585    (make-array-with-checks '(10) :displaced-to a
586                            :displaced-index-offset 5
587                            :fill-pointer t))
588  #(f g h i j k l m n o))
589
590(deftest make-array.displaced.24
591  (let ((a (make-array '(2 3 4)
592                       :initial-contents '(((a b c d) (e f g h) (i j k l))
593                                           ((m n o p) (q r s t) (u v w x))))))
594    (make-array-with-checks '(10) :displaced-to a
595                            :displaced-index-offset 5
596                            :fill-pointer 5))
597  #(f g h i j))
598
599(deftest make-array.displaced.25
600  (let ((a (make-array '(2 3 4)
601                       :initial-contents '(((a b c d) (e f g h) (i j k l))
602                                           ((m n o p) (q r s t) (u v w x))))))
603    (make-array-with-checks '(10) :displaced-to a
604                            :displaced-index-offset 5
605                            :adjustable t))
606  #(f g h i j k l m n o))
607
608(deftest make-array.displaced.26
609  (let ((a (make-array '(2 3 4)
610                       :initial-contents '(((a b c d) (e f g h) (i j k l))
611                                           ((m n o p) (q r s t) (u v w x))))))
612    (make-array-with-checks '(10) :displaced-to a
613                            :displaced-index-offset 5
614                            :fill-pointer 8
615                            :adjustable t))
616  #(f g h i j k l m))
617
618(deftest make-array.displaced.27
619  (let ((a (make-array '(10)
620                       :initial-contents '(1 2 3 4 5 6 7 8 9 10)
621                       :fill-pointer t)))
622    (make-array-with-checks '(2 4) :displaced-to a))
623  #2a((1 2 3 4) (5 6 7 8)))
624
625(deftest make-array.displaced.28
626  (let ((a (make-array '(10)
627                       :initial-contents '(1 2 3 4 5 6 7 8 9 10)
628                       :fill-pointer 4)))
629    (make-array-with-checks '(2 4) :displaced-to a))
630  #2a((1 2 3 4) (5 6 7 8)))
631
632(deftest make-array.displaced.29
633  (let ((a (make-array '(10) :initial-element 0)))
634    (prog1
635        (make-array-with-checks '(2 4) :displaced-to a)
636      (loop for i below 10 do (setf (aref a i) (1+ i)))))
637  #2a((1 2 3 4) (5 6 7 8)))
638
639(deftest make-array.displaced.30
640  (let* ((a1 (make-array '(10) :initial-element 0))
641         (a2 (make-array '(10) :displaced-to a1)))
642    (prog1
643        (make-array-with-checks '(2 4) :displaced-to a2)
644      (loop for i below 10 do (setf (aref a2 i) (1+ i)))))
645  #2a((1 2 3 4) (5 6 7 8)))
646
647(deftest make-array.displaced.31
648  (let* ((a1 (make-array '(10) :initial-element 0))
649         (a2 (make-array '(10) :displaced-to a1)))
650    (prog1
651        (make-array-with-checks '(2 4) :displaced-to a2)
652      (loop for i below 10 do (setf (aref a1 i) (1+ i)))))
653  #2a((1 2 3 4) (5 6 7 8)))
654
655
656;;; Keywords tests
657
658(deftest make-array.allow-other-keys.1
659  (make-array '(5) :initial-element 'a :allow-other-keys t)
660  #(a a a a a))
661
662(deftest make-array.allow-other-keys.2
663  (make-array '(5) :initial-element 'a :allow-other-keys nil)
664  #(a a a a a))
665
666(deftest make-array.allow-other-keys.3
667  (make-array '(5) :initial-element 'a :allow-other-keys t '#:bad t)
668  #(a a a a a))
669
670(deftest make-array.allow-other-keys.4
671  (make-array '(5) :initial-element 'a :bad t :allow-other-keys t)
672  #(a a a a a))
673
674(deftest make-array.allow-other-keys.5
675  (make-array '(5) :bad t :initial-element 'a :allow-other-keys t)
676  #(a a a a a))
677
678(deftest make-array.allow-other-keys.6
679  (make-array '(5) :bad t :initial-element 'a :allow-other-keys t
680              :allow-other-keys nil :also-bad nil)
681  #(a a a a a))
682
683(deftest make-array.allow-other-keys.7
684  (make-array '(5) :allow-other-keys t :initial-element 'a)
685  #(a a a a a))
686
687(deftest make-array.keywords.8.
688  (make-array '(5) :initial-element 'x :initial-element 'a)
689  #(x x x x x))
690
691;;; Error tests
692
693(deftest make-array.error.1
694  (signals-error (make-array) program-error)
695  t)
696
697(deftest make-array.error.2
698  (signals-error (make-array '(10) :bad t) program-error)
699  t)
700
701(deftest make-array.error.3
702  (signals-error (make-array '(10) :allow-other-keys nil :bad t)
703                 program-error)
704  t)
705
706(deftest make-array.error.4
707  (signals-error (make-array '(10) :allow-other-keys nil
708                              :allow-other-keys t :bad t)
709                 program-error)
710  t)
711
712(deftest make-array.error.5
713  (signals-error (make-array '(10) :bad) program-error)
714  t)
715
716(deftest make-array.error.6
717  (signals-error (make-array '(10) 1 2) program-error)
718  t)
719
720;;; Order of evaluation tests
721
722(deftest make-array.order.1
723  (let ((i 0) a b c e)
724    (values
725     (make-array (progn (setf a (incf i)) 5)
726                 :initial-element (progn (setf b (incf i)) 'a)
727                 :fill-pointer (progn (setf c (incf i)) nil)
728                 ;; :displaced-to (progn (setf d (incf i)) nil)
729                 :element-type (progn (setf e (incf i)) t)
730                 )
731     i a b c e))
732  #(a a a a a) 4 1 2 3 4)
733
734(deftest make-array.order.2
735  (let ((i 0) a b d e)
736    (values
737     (make-array (progn (setf a (incf i)) 5)
738                 :element-type (progn (setf b (incf i)) t)
739                 ;; :displaced-to (progn (setf c (incf i)) nil)
740                 :fill-pointer (progn (setf d (incf i)) nil)
741                 :initial-element (progn (setf e (incf i)) 'a)
742                 )
743     i a b d e))
744  #(a a a a a) 4 1 2 3 4)
745
746;; Must add back order tests for :displaced-to and :displaced-index-offset
747
Note: See TracBrowser for help on using the repository browser.