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

Last change on this file since 12350 was 12350, checked in by gb, 11 years ago

Test make-array.28 needs more stack space than ppc32 ccl usually
has, so conditionalize it out.

test CCL.57900.1 may not cause a memory fault on ppc64.

File size: 20.8 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#-(and clozure ppc32-target)         ; uses more stack than we have
268(deftest make-array.28
269  (let ((*package* (find-package :cl-test)))
270    (let ((len (1- (min 10000 array-rank-limit))))
271      (equalpt (make-array (make-list len :initial-element 1) :initial-element 'x)
272               (read-from-string (concatenate
273                                  'string
274                                  (format nil "#~dA" len)
275                                  (make-string len :initial-element #\()
276                                  "x"
277                                  (make-string len :initial-element #\)))))))
278  t)
279
280(deftest make-array.29
281  (make-array-with-checks '(5) :element-type '(integer 0 (256))
282                          :initial-contents '(0 5 255 119 57))
283  #(0 5 255 119 57))
284
285(deftest make-array.30
286  (make-array-with-checks '(5) :element-type '(integer -128 127)
287                          :initial-contents '(-10 5 -128 86 127))
288  #(-10 5 -128 86 127))
289
290(deftest make-array.31
291  (make-array-with-checks '(5) :element-type '(integer 0 (65536))
292                          :initial-contents '(0 100 65535 7623 13))
293  #(0 100 65535 7623 13))
294
295(deftest make-array.32
296  (make-array-with-checks '(5) :element-type 'fixnum
297                          :initial-contents '(1 2 3 4 5))
298  #(1 2 3 4 5))
299
300(deftest make-array.33
301  (make-array-with-checks '(5) :element-type 'short-float
302                          :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
303  #(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
304
305(deftest make-array.34
306  (make-array-with-checks '(5) :element-type 'single-float
307                          :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
308  #(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
309
310(deftest make-array.35
311  (make-array-with-checks '(5) :element-type 'double-float
312                          :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
313  #(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
314
315(deftest make-array.36
316  (make-array-with-checks '(5) :element-type 'long-float
317                          :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
318  #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
319
320
321;;; Adjustable arrays
322
323(deftest make-array.adjustable.1
324  (let ((a (make-array-with-checks '(10) :adjustable t)))
325    (and (symbolp a) a))
326  nil)
327
328(deftest make-array.adjustable.2
329 (make-array-with-checks '(4) :adjustable t
330                         :initial-element 6)
331 #(6 6 6 6))
332
333(deftest make-array.adjustable.3
334  (make-array-with-checks nil :adjustable t :initial-element 7)
335  #0a7)
336
337(deftest make-array.adjustable.4
338  (make-array-with-checks '(2 3) :adjustable t :initial-element 7)
339  #2a((7 7 7) (7 7 7)))
340
341(deftest make-array.adjustable.5
342  (make-array-with-checks '(2 3) :adjustable t
343                          :initial-contents '((1 2 3) "abc"))
344  #2a((1 2 3) (#\a #\b #\c)))
345
346(deftest make-array.adjustable.6
347 (make-array-with-checks '(4) :adjustable t
348                         :initial-contents '(a b c d))
349 #(a b c d))
350
351(deftest make-array.adjustable.7
352 (make-array-with-checks '(4) :adjustable t
353                         :fill-pointer t
354                         :initial-contents '(a b c d))
355 #(a b c d))
356
357(deftest make-array.adjustable.7a
358 (make-array-with-checks '(4) :adjustable t
359                         :element-type 'bit
360                         :fill-pointer t
361                         :initial-contents '(1 0 0 1))
362 #(1 0 0 1))
363
364(deftest make-array.adjustable.7b
365 (make-array-with-checks '(4) :adjustable t
366                         :element-type 'base-char
367                         :fill-pointer t
368                         :initial-contents "abcd")
369 "abcd")
370
371(deftest make-array.adjustable.7c
372 (make-array-with-checks '(4) :adjustable t
373                         :element-type 'character
374                         :fill-pointer t
375                         :initial-contents "abcd")
376 "abcd")
377
378(deftest make-array.adjustable.8
379 (make-array-with-checks '(4) :adjustable t
380                         :element-type '(integer 0 (256))
381                         :initial-contents '(1 4 7 9))
382 #(1 4 7 9))
383
384(deftest make-array.adjustable.9
385 (make-array-with-checks '(4) :adjustable t
386                         :element-type 'base-char
387                         :initial-contents "abcd")
388 "abcd")
389
390(deftest make-array.adjustable.10
391 (make-array-with-checks '(4) :adjustable t
392                         :element-type 'bit
393                         :initial-contents '(0 1 1 0))
394 #*0110)
395
396(deftest make-array.adjustable.11
397 (make-array-with-checks '(4) :adjustable t
398                         :element-type 'symbol
399                         :initial-contents '(a b c d))
400 #(a b c d))
401
402;;; Displaced arrays
403
404(deftest make-array.displaced.1
405  (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))))
406    (make-array-with-checks '(5) :displaced-to a))
407  #(a b c d e))
408
409(deftest make-array.displaced.2
410  (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))))
411    (make-array-with-checks '(5) :displaced-to a
412                            :displaced-index-offset 3))
413  #(d e f g h))
414
415(deftest make-array.displaced.3
416  (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))))
417    (make-array-with-checks '(5) :displaced-to a
418                            :displaced-index-offset 5))
419  #(f g h i j))
420
421(deftest make-array.displaced.4
422  (let ((a (make-array '(10) :initial-contents '(a b c d e f g h i j))))
423    (make-array-with-checks '(0) :displaced-to a
424                            :displaced-index-offset 10))
425  #())
426
427(deftest make-array.displaced.5
428  (let ((a (make-array '(10) :element-type '(integer 0 (256))
429                       :initial-contents '(1 3 5 7 9 11 13 15 17 19))))
430    (make-array-with-checks '(5) :element-type '(integer 0 (256))
431                            :displaced-to a))
432  #(1 3 5 7 9))
433
434(deftest make-array.displaced.6
435  (let ((a (make-array '(10) :element-type '(integer 0 (256))
436                       :initial-contents '(1 3 5 7 9 11 13 15 17 19))))
437    (loop for i from 0 to 5 collect
438          (make-array-with-checks '(5) :element-type '(integer 0 (256))
439                                  :displaced-to a
440                                  :displaced-index-offset i)))
441  (#(1 3 5 7 9)
442   #(3 5 7 9 11)
443   #(5 7 9 11 13)
444   #(7 9 11 13 15)
445   #(9 11 13 15 17)
446   #(11 13 15 17 19)))
447
448(deftest make-array.displaced.7
449  (let ((a (make-array '(10) :element-type '(integer 0 (256))
450                       :initial-contents '(1 3 5 7 9 11 13 15 17 19))))
451    (make-array-with-checks '(0) :element-type '(integer 0 (256))
452                            :displaced-to a
453                            :displaced-index-offset 10))
454  #())
455
456(deftest make-array.displaced.8
457  (let ((a (make-array '(10) :element-type 'bit
458                       :initial-contents '(0 1 1 0 1 1 1 0 1 0))))
459    (make-array-with-checks '(5) :element-type 'bit
460                            :displaced-to a))
461  #*01101)
462
463(deftest make-array.displaced.9
464  (let ((a (make-array '(10) :element-type 'bit
465                       :initial-contents '(0 1 1 0 1 1 1 0 1 0))))
466    (loop for i from 0 to 5 collect
467          (make-array-with-checks '(5) :element-type 'bit
468                                  :displaced-to a
469                                  :displaced-index-offset i)))
470  (#*01101 #*11011 #*10111 #*01110 #*11101 #*11010))
471
472(deftest make-array.displaced.10
473  (let ((a (make-array '(10) :element-type 'bit
474                       :initial-contents '(0 1 1 0 1 1 1 0 1 0))))
475    (make-array-with-checks '(0) :element-type 'bit
476                            :displaced-to a
477                            :displaced-index-offset 10))
478  #*)
479
480(deftest make-array.displaced.11
481  (let ((a (make-array '(10) :element-type 'base-char
482                       :initial-contents "abcdefghij")))
483    (make-array-with-checks '(5) :element-type 'base-char
484                            :displaced-to a))
485  "abcde")
486
487(deftest make-array.displaced.12
488  (let ((a (make-array '(10) :element-type 'base-char
489                       :initial-contents "abcdefghij")))
490    (loop for i from 0 to 5 collect
491          (make-array-with-checks '(5) :element-type 'base-char
492                                  :displaced-to a
493                                  :displaced-index-offset i)))
494  ("abcde"
495   "bcdef"
496   "cdefg"
497   "defgh"
498   "efghi"
499   "fghij"))
500
501(deftest make-array.displaced.13
502  (let ((a (make-array '(10) :element-type 'base-char
503                       :initial-contents "abcdefghij")))
504    (make-array-with-checks '(0) :element-type 'base-char
505                            :displaced-to a
506                            :displaced-index-offset 10))
507  "")
508
509(deftest make-array.displaced.14
510  (let ((a (make-array '(10) :element-type 'character
511                       :initial-contents "abcdefghij")))
512    (make-array-with-checks '(5) :element-type 'character
513                            :displaced-to a))
514  "abcde")
515
516(deftest make-array.displaced.15
517  (let ((a (make-array '(10) :element-type 'character
518                       :initial-contents "abcdefghij")))
519    (loop for i from 0 to 5 collect
520          (make-array-with-checks '(5) :element-type 'character
521                                  :displaced-to a
522                                  :displaced-index-offset i)))
523  ("abcde"
524   "bcdef"
525   "cdefg"
526   "defgh"
527   "efghi"
528   "fghij"))
529
530(deftest make-array.displaced.16
531  (let ((a (make-array '(10) :element-type 'character
532                       :initial-contents "abcdefghij")))
533    (make-array-with-checks '(0) :element-type 'character
534                            :displaced-to a
535                            :displaced-index-offset 10))
536  "")
537
538;;; Multidimensional displaced arrays
539
540(deftest make-array.displaced.17
541  (let ((a (make-array '(3 4) :initial-contents '((1 2 3 4) (5 6 7 8)
542                                                  (9 10 11 12)))))
543    (make-array-with-checks '(8) :displaced-to a))
544  #(1 2 3 4 5 6 7 8))
545
546(deftest make-array.displaced.18
547  (let ((a (make-array '(3 4) :initial-contents '((1 2 3 4) (5 6 7 8)
548                                                  (9 10 11 12)))))
549    (make-array-with-checks '(8) :displaced-to a
550                            :displaced-index-offset 3))
551  #(4 5 6 7 8 9 10 11))
552
553(deftest make-array.displaced.19
554  (let ((a (make-array '(3 4) :initial-contents '((1 2 3 4) (5 6 7 8)
555                                                  (9 10 11 12)))))
556    (make-array-with-checks '(2 4) :displaced-to a
557                            :displaced-index-offset 4))
558  #2a((5 6 7 8) (9 10 11 12)))
559
560(deftest make-array.displaced.20
561  (let ((a (make-array '(2 3 4)
562                       :initial-contents '(((a b c d) (e f g h) (i j k l))
563                                           ((m n o p) (q r s t) (u v w x))))))
564    (make-array-with-checks '(24) :displaced-to a))
565  #(a b c d e f g h i j k l m n o p q r s t u v w x))
566
567(deftest make-array.displaced.21
568  (let ((a (make-array '(2 3 4)
569                       :initial-contents '(((a b c d) (e f g h) (i j k l))
570                                           ((m n o p) (q r s t) (u v w x))))))
571    (make-array-with-checks '(3 8) :displaced-to a))
572  #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)))
573
574(deftest make-array.displaced.22
575  (let ((a (make-array '(2 3 4)
576                       :initial-contents '(((a b c d) (e f g h) (i j k l))
577                                           ((m n o p) (q r s t) (u v w x))))))
578    (make-array-with-checks '(10) :displaced-to a
579                            :displaced-index-offset 5))
580  #(f g h i j k l m n o))
581
582(deftest make-array.displaced.23
583  (let ((a (make-array '(2 3 4)
584                       :initial-contents '(((a b c d) (e f g h) (i j k l))
585                                           ((m n o p) (q r s t) (u v w x))))))
586    (make-array-with-checks '(10) :displaced-to a
587                            :displaced-index-offset 5
588                            :fill-pointer t))
589  #(f g h i j k l m n o))
590
591(deftest make-array.displaced.24
592  (let ((a (make-array '(2 3 4)
593                       :initial-contents '(((a b c d) (e f g h) (i j k l))
594                                           ((m n o p) (q r s t) (u v w x))))))
595    (make-array-with-checks '(10) :displaced-to a
596                            :displaced-index-offset 5
597                            :fill-pointer 5))
598  #(f g h i j))
599
600(deftest make-array.displaced.25
601  (let ((a (make-array '(2 3 4)
602                       :initial-contents '(((a b c d) (e f g h) (i j k l))
603                                           ((m n o p) (q r s t) (u v w x))))))
604    (make-array-with-checks '(10) :displaced-to a
605                            :displaced-index-offset 5
606                            :adjustable t))
607  #(f g h i j k l m n o))
608
609(deftest make-array.displaced.26
610  (let ((a (make-array '(2 3 4)
611                       :initial-contents '(((a b c d) (e f g h) (i j k l))
612                                           ((m n o p) (q r s t) (u v w x))))))
613    (make-array-with-checks '(10) :displaced-to a
614                            :displaced-index-offset 5
615                            :fill-pointer 8
616                            :adjustable t))
617  #(f g h i j k l m))
618
619(deftest make-array.displaced.27
620  (let ((a (make-array '(10)
621                       :initial-contents '(1 2 3 4 5 6 7 8 9 10)
622                       :fill-pointer t)))
623    (make-array-with-checks '(2 4) :displaced-to a))
624  #2a((1 2 3 4) (5 6 7 8)))
625
626(deftest make-array.displaced.28
627  (let ((a (make-array '(10)
628                       :initial-contents '(1 2 3 4 5 6 7 8 9 10)
629                       :fill-pointer 4)))
630    (make-array-with-checks '(2 4) :displaced-to a))
631  #2a((1 2 3 4) (5 6 7 8)))
632
633(deftest make-array.displaced.29
634  (let ((a (make-array '(10) :initial-element 0)))
635    (prog1
636        (make-array-with-checks '(2 4) :displaced-to a)
637      (loop for i below 10 do (setf (aref a i) (1+ i)))))
638  #2a((1 2 3 4) (5 6 7 8)))
639
640(deftest make-array.displaced.30
641  (let* ((a1 (make-array '(10) :initial-element 0))
642         (a2 (make-array '(10) :displaced-to a1)))
643    (prog1
644        (make-array-with-checks '(2 4) :displaced-to a2)
645      (loop for i below 10 do (setf (aref a2 i) (1+ i)))))
646  #2a((1 2 3 4) (5 6 7 8)))
647
648(deftest make-array.displaced.31
649  (let* ((a1 (make-array '(10) :initial-element 0))
650         (a2 (make-array '(10) :displaced-to a1)))
651    (prog1
652        (make-array-with-checks '(2 4) :displaced-to a2)
653      (loop for i below 10 do (setf (aref a1 i) (1+ i)))))
654  #2a((1 2 3 4) (5 6 7 8)))
655
656
657;;; Keywords tests
658
659(deftest make-array.allow-other-keys.1
660  (make-array '(5) :initial-element 'a :allow-other-keys t)
661  #(a a a a a))
662
663(deftest make-array.allow-other-keys.2
664  (make-array '(5) :initial-element 'a :allow-other-keys nil)
665  #(a a a a a))
666
667(deftest make-array.allow-other-keys.3
668  (make-array '(5) :initial-element 'a :allow-other-keys t '#:bad t)
669  #(a a a a a))
670
671(deftest make-array.allow-other-keys.4
672  (make-array '(5) :initial-element 'a :bad t :allow-other-keys t)
673  #(a a a a a))
674
675(deftest make-array.allow-other-keys.5
676  (make-array '(5) :bad t :initial-element 'a :allow-other-keys t)
677  #(a a a a a))
678
679(deftest make-array.allow-other-keys.6
680  (make-array '(5) :bad t :initial-element 'a :allow-other-keys t
681              :allow-other-keys nil :also-bad nil)
682  #(a a a a a))
683
684(deftest make-array.allow-other-keys.7
685  (make-array '(5) :allow-other-keys t :initial-element 'a)
686  #(a a a a a))
687
688(deftest make-array.keywords.8.
689  (make-array '(5) :initial-element 'x :initial-element 'a)
690  #(x x x x x))
691
692;;; Error tests
693
694(deftest make-array.error.1
695  (signals-error (make-array) program-error)
696  t)
697
698(deftest make-array.error.2
699  (signals-error (make-array '(10) :bad t) program-error)
700  t)
701
702(deftest make-array.error.3
703  (signals-error (make-array '(10) :allow-other-keys nil :bad t)
704                 program-error)
705  t)
706
707(deftest make-array.error.4
708  (signals-error (make-array '(10) :allow-other-keys nil
709                              :allow-other-keys t :bad t)
710                 program-error)
711  t)
712
713(deftest make-array.error.5
714  (signals-error (make-array '(10) :bad) program-error)
715  t)
716
717(deftest make-array.error.6
718  (signals-error (make-array '(10) 1 2) program-error)
719  t)
720
721;;; Order of evaluation tests
722
723(deftest make-array.order.1
724  (let ((i 0) a b c e)
725    (values
726     (make-array (progn (setf a (incf i)) 5)
727                 :initial-element (progn (setf b (incf i)) 'a)
728                 :fill-pointer (progn (setf c (incf i)) nil)
729                 ;; :displaced-to (progn (setf d (incf i)) nil)
730                 :element-type (progn (setf e (incf i)) t)
731                 )
732     i a b c e))
733  #(a a a a a) 4 1 2 3 4)
734
735(deftest make-array.order.2
736  (let ((i 0) a b d e)
737    (values
738     (make-array (progn (setf a (incf i)) 5)
739                 :element-type (progn (setf b (incf i)) t)
740                 ;; :displaced-to (progn (setf c (incf i)) nil)
741                 :fill-pointer (progn (setf d (incf i)) nil)
742                 :initial-element (progn (setf e (incf i)) 'a)
743                 )
744     i a b d e))
745  #(a a a a a) 4 1 2 3 4)
746
747;; Must add back order tests for :displaced-to and :displaced-index-offset
748
Note: See TracBrowser for help on using the repository browser.