1;; -*- Lisp -*- vim:filetype=lisp
2
3(FORMAT T "~%double-float arrays~%")   NIL
4
5(EQUALP
6 (SETQ DA1 (MAKE-ARRAY (QUOTE (4 2 3)) :INITIAL-CONTENTS
7                       '(((1.0D0 2.0D0 3.0D0) (4.0D0 5.0D0 6.0D0))
8                         ((7.0D0 8.0D0 9.0D0) (10.0D0 11.0D0 12.0D0))
9                         ((13.0D0 14.0D0 15.0D0) (16.0D0 17.0D0 18.0D0))
10                         ((19.0D0 20.0D0 21.0D0) (22.0D0 23.0D0 24.0D0)))
11                       :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)))
12 '#3A(((1.0D0 2.0D0 3.0D0)(4.0D0 5.0D0 6.0D0))
13      ((7.0D0 8.0D0 9.0D0)(10.0D0 11.0D0 12.0D0))
14      ((13.0D0 14.0D0 15.0D0)(16.0D0 17.0D0 18.0D0))
15      ((19.0D0 20.0D0 21.0D0) (22.0D0 23.0D0 24.0D0))))
16T
17
18(AREF DA1 0 0 0)   1.0D0
19
20(AREF DA1 0 0 1)   2.0D0
21
22(AREF DA1 0 0 2)   3.0D0
23
24(AREF DA1 0 1 0)   4.0D0
25
26(AREF DA1 0 1 1)   5.0D0
27
28(AREF DA1 0 1 2)   6.0D0
29
30(AREF DA1 1 0 0)   7.0D0
31
32(AREF DA1 1 0 1)   8.0D0
33
34(AREF DA1 1 0 2)   9.0D0
35
36(AREF DA1 1 1 0)   10.0D0
37
38(AREF DA1 1 1 1)   11.0D0
39
40(AREF DA1 1 1 2)   12.0D0
41
42(AREF DA1 2 0 0)   13.0D0
43
44(AREF DA1 2 0 1)   14.0D0
45
46(AREF DA1 2 0 2)   15.0D0
47
48(AREF DA1 2 1 0)   16.0D0
49
50(AREF DA1 2 1 1)   17.0D0
51
52(AREF DA1 2 1 2)   18.0D0
53
54(AREF DA1 3 0 0)   19.0D0
55
56(AREF DA1 3 0 1)   20.0D0
57
58(AREF DA1 3 0 2)   21.0D0
59
60(AREF DA1 3 1 0)   22.0D0
61
62(AREF DA1 3 1 1)   23.0D0
63
64(AREF DA1 3 1 1)   23.0D0
65
66(FORMAT T "~%single-float arrays~%")   NIL
67
68(EQUALP (SETQ FA1 (MAKE-ARRAY (QUOTE (4 2 3)) :INITIAL-CONTENTS
69                              '(((1.0 2.0 3.0) (4.0 5.0 6.0))
70                                ((7.0 8.0 9.0) (10.0 11.0 12.0))
71                                ((13.0 14.0 15.0) (16.0 17.0 18.0))
72                                ((19.0 20.0 21.0) (22.0 23.0 24.0)))
73                              :ELEMENT-TYPE (QUOTE SINGLE-FLOAT)))
74        '#3A(((1.0 2.0 3.0)(4.0 5.0 6.0))
75             ((7.0 8.0 9.0)(10.0 11.0 12.0))
76             ((13.0 14.0 15.0)(16.0 17.0 18.0))
77             ((19.0 20.0 21.0)(22.0 23.0 24.0))))
78T
79
80(AREF FA1 0 0 0)   1.0
81
82(AREF FA1 0 0 1)   2.0
83
84(AREF FA1 0 0 2)   3.0
85
86(AREF FA1 0 1 0)   4.0
87
88(AREF FA1 0 1 1)   5.0
89
90(AREF FA1 0 1 2)   6.0
91
92(AREF FA1 1 0 0)   7.0
93
94(AREF FA1 1 0 1)   8.0
95
96(AREF FA1 1 0 2)   9.0
97
98(AREF FA1 1 1 0)   10.0
99
100(AREF FA1 1 1 1)   11.0
101
102(AREF FA1 1 1 2)   12.0
103
104(AREF FA1 2 0 0)   13.0
105
106(AREF FA1 2 0 1)   14.0
107
108(AREF FA1 2 0 2)   15.0
109
110(AREF FA1 2 1 0)   16.0
111
112(AREF FA1 2 1 1)   17.0
113
114(AREF FA1 2 1 2)   18.0
115
116(AREF FA1 3 0 0)   19.0
117
118(AREF FA1 3 0 1)   20.0
119
120(AREF FA1 3 0 2)   21.0
121
122(AREF FA1 3 1 0)   22.0
123
124(AREF FA1 3 1 1)   23.0
125
126(AREF FA1 3 1 1)   23.0
127
128(FORMAT T "~%array limits~%")   NIL
129
130(let ((s (prin1-to-string ARRAY-RANK-LIMIT )))
131  (or #+XCL (equal s "256")
132      #+CLISP (equal s "4294967296") #+CLISP (equal s "65536")
133      #+CLISP (equal s (prin1-to-string lambda-parameters-limit))
134      #+(or AKCL ECL) (equal s "64") #+GCL (equal s "63")
135      #+ALLEGRO (equal s "65536")
136      #+(or CMU SBCL) (equal s "65529")
137      #+OpenMCL (equal s "8192")
138      #+LISPWORKS (equal s "253")
139      #-(or XCL CLISP AKCL ECL GCL ALLEGRO CMU SBCL OpenMCL LISPWORKS) "UNKNOWN"))
140T
141
142(let ((s (prin1-to-string ARRAY-DIMENSION-LIMIT )))
143  (or #+XCL (equal s "17920")
144      #+(or AKCL ECL) (equal s "16777216") #+GCL (equal s "2147483647")
145      #+CLISP (equal s "4294967296")
146      #+CLISP (equal s (prin1-to-string most-positive-fixnum))
147      #+(and CLISP MACOS WORD-SIZE=64) (equal s "16777215")
148      #+ALLEGRO (equal s "16777216")
149      #+(or CMU SBCL) (equal s "536870911")
150      #+OpenMCL (equal s "16777216")
151      #+LISPWORKS (equal s "8388607")
152      #-(or XCL CLISP AKCL ECL GCL ALLEGRO CMU SBCL OpenMCL LISPWORKS) "UNKNOWN"))
153T
154
155(let ((s (prin1-to-string ARRAY-TOTAL-SIZE-LIMIT )))
156  (or #+XCL (equal s "17920")
157      #+(or AKCL ECL) (equal s "16777216") #+GCL (equal s "2147483647")
158      #+CLISP (equal s "4294967296")
159      #+CLISP (equal s (prin1-to-string most-positive-fixnum))
160      #+(and CLISP MACOS WORD-SIZE=64) (equal s "16777215")
161      #+ALLEGRO (equal s "16777216")
162      #+(or CMU SBCL) (equal s "536870911")
163      #+OpenMCL (equal s "16777216")
164      #+LISPWORKS (equal s "1048448")
165      #-(or XCL CLISP AKCL ECL GCL ALLEGRO CMU SBCL OpenMCL LISPWORKS) "UNKNOWN"))
166T
167
168(<= ARRAY-DIMENSION-LIMIT ARRAY-TOTAL-SIZE-LIMIT)
169T
170
171(FORMAT T "~%simple vectors~%")   NIL
172
173(EQUALP (SETQ SV (VECTOR (QUOTE A) (QUOTE B) (QUOTE C) 1.0S0 3.7D0 4.1))
174        '#(A B C 1.0S0 3.7D0 4.1))
175T
176
177(SVREF SV 0)   A
178
179(SVREF SV 1)   B
180
181(SVREF SV 2)   C
182
183(SVREF SV 3)   1.0S0
184
185(SVREF SV 4)   3.7D0
186
187(FORMAT T "~%set elements~%")   NIL
188
189(SETF (SVREF SV 0) (QUOTE TEST))   TEST
190
191(EQUALP SV '#(TEST B C 1.0S0 3.7D0 4.1))   T
192
193(FORMAT T "~%test array-element-type~%")   NIL
194
195(ARRAY-ELEMENT-TYPE SV)   T
196
197(ARRAY-ELEMENT-TYPE DA1)
198#+(or XCL ALLEGRO CMU SBCL OpenMCL LISPWORKS) DOUBLE-FLOAT #+CLISP T #+(or AKCL ECL) LONG-FLOAT
199#-(or XCL CLISP AKCL ECL ALLEGRO CMU SBCL OpenMCL LISPWORKS) UNKNOWN
200
201(FORMAT T "~%test rank~%")   NIL
202
203(ARRAY-RANK DA1)   3
204
205(ARRAY-RANK FA1)   3
206
207(FORMAT T "~%test individual dimensions~%")   NIL
208
209(ARRAY-DIMENSION DA1 0)   4
210
211(ARRAY-DIMENSION DA1 1)   2
212
213(ARRAY-DIMENSION DA1 2)   3
214
215(ARRAY-DIMENSION DA1 3)   ERROR
216
217(FORMAT T "~%0-dim. array pseudo-scalar with contents mod 5~%")   NIL
218
219(PROGN (SETQ ZERO (MAKE-ARRAY (QUOTE NIL) :ELEMENT-TYPE (QUOTE (MOD 5)))) T)
220T
221
222(ARRAY-RANK ZERO)   0
223
224(SETF (AREF ZERO) 4)   4
225
226(SETF (AREF ZERO) 1.0)
227#+(or XCL CLISP AKCL ECL ALLEGRO CMU SBCL OpenMCL LISPWORKS) ERROR
228#-(or XCL CLISP AKCL ECL ALLEGRO CMU SBCL OpenMCL LISPWORKS) UNKNOWN
229
230(FORMAT T "~%3-dim general array~%")   NIL
231
232(EQUALP (SETQ A1 (MAKE-ARRAY (QUOTE (4 2 3)) :INITIAL-CONTENTS
233                             '(((A B C) (1 2 3)) ((D E F) (3 1 2))
234                               ((G H I) (2 3 1)) ((J K L) (0 0 0)))))
235        '#3A(((A B C)(1 2 3))((D E F)(3 1 2))
236             ((G H I)(2 3 1))((J K L)(0 0 0))))
237T
238
239(AREF A1 0 0 0)   A
240
241(AREF A1 0 0 1)   B
242
243(AREF A1 0 0 2)   C
244
245(AREF A1 0 1 0)   1
246
247(AREF A1 0 1 1)   2
248
249(AREF A1 0 1 2)   3
250
251(AREF A1 1 0 0)   D
252
253(AREF A1 1 0 1)   E
254
255(AREF A1 1 0 2)   F
256
257(AREF A1 1 1 0)   3
258
259(AREF A1 1 1 1)   1
260
261(AREF A1 1 1 2)   2
262
263(AREF A1 2 0 0)   G
264
265(AREF A1 2 0 1)   H
266
267(AREF A1 2 0 2)   I
268
269(AREF A1 2 1 0)   2
270
271(AREF A1 2 1 1)   3
272
273(AREF A1 2 1 2)   1
274
275(AREF A1 3 0 0)   J
276
277(AREF A1 3 0 1)   K
278
279(AREF A1 3 0 2)   L
280
281(AREF A1 3 1 0)   0
282
283(AREF A1 3 1 1)   0
284
285(AREF A1 3 1 1)   0
286
287(FORMAT T "~%2-dim adjustable displaced array~%") NIL
288
289(PROGN (SETQ M (MAKE-ARRAY (QUOTE (4 4)) :ADJUSTABLE T :INITIAL-CONTENTS
290                           '((ALPHA BETA GAMMA DELTA) (EPSILON ZETA ETA THETA)
291                             (IOTA KAPPA LAMBDA MU) (NU XI OMICRON PI)))) T)
292T
293
294(AREF M 0 0)   ALPHA
295
296(AREF M 0 1)   BETA
297
298(AREF M 0 2)   GAMMA
299
300(AREF M 0 3)   DELTA
301
302(AREF M 1 0)   EPSILON
303
304(AREF M 1 1)   ZETA
305
306(AREF M 1 2)   ETA
307
308(AREF M 1 3)   THETA
309
310(AREF M 2 0)   IOTA
311
312(AREF M 2 1)   KAPPA
313
314(AREF M 2 2)   LAMBDA
315
316(AREF M 2 3)   MU
317
318(AREF M 3 0)   NU
319
320(AREF M 3 1)   XI
321
322(AREF M 3 2)   OMICRON
323
324(AREF M 3 3)   PI
325
326(FORMAT T "~%sisplaced~%")   NIL
327
328(equalp (SETQ MD0 (MAKE-ARRAY 4 :DISPLACED-TO M))
329        '#(ALPHA BETA GAMMA DELTA))
330t
331
332(equalp (SETQ MD1 (MAKE-ARRAY 4 :DISPLACED-TO M :DISPLACED-INDEX-OFFSET 4))
333        '#(EPSILON ZETA ETA THETA))
334t
335
336(equalp (SETQ MD2 (MAKE-ARRAY 4 :DISPLACED-TO M :DISPLACED-INDEX-OFFSET 8))
337        '#(IOTA KAPPA LAMBDA MU))
338t
339
340(FORMAT T "~%adjust m~%")   NIL
341
342(PROGN (ADJUST-ARRAY M (QUOTE (3 5)) :INITIAL-ELEMENT (QUOTE BAZ)) T)   T
343
344(AREF M 0 0)   ALPHA
345
346(AREF M 0 1)   BETA
347
348(AREF M 0 2)   GAMMA
349
350(AREF M 0 3)   DELTA
351
352(AREF M 0 4)   BAZ
353
354(AREF M 1 0)   EPSILON
355
356(AREF M 1 1)   ZETA
357
358(AREF M 1 2)   ETA
359
360(AREF M 1 3)   THETA
361
362(AREF M 1 4)   BAZ
363
364(AREF M 2 0)   IOTA
365
366(AREF M 2 1)   KAPPA
367
368(AREF M 2 2)   LAMBDA
369
370(FORMAT T "~%Test interaction of the keywords~%")   NIL
371
372(PROGN (SETQ DV (MAKE-ARRAY 10 :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
373                            :INITIAL-CONTENTS
374                            '(0.0D0 1.0D0 2.0D0 3.0D0 4.0D0 5.0D0 6.0D0
375                              7.0D0 8.0D0 9.0D0)))
376       T)
377T
378#| ***************************************************************************
379 (SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
380                       :INITIAL-CONTENTS '((1.0D0 2.0D0) (3.0D0 4.0D0 5.0D0))))
381 ERROR
382
383 (SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
384                       :INITIAL-CONTENTS '((1.0D0 2.0D0) (3.0D0 4.0D0))
385                       :DISPLACED-TO DV :DISPLACED-INDEX-OFFSET 8))
386 ERROR
387
388 (SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
389                       :INITIAL-CONTENTS (QUOTE ((1.0D0 2.0D0) (3.0D0 4.0D0)))
390                       :DISPLACED-TO DV :DISPLACED-INDEX-OFFSET 8))
391 ERROR
392
393 (SETQ DVE (MAKE-ARRAY (QUOTE (2 2)) :ELEMENT-TYPE (QUOTE DOUBLE-FLOAT)
394                       :DISPLACED-TO DV :DISPLACED-INDEX-OFFSET 8))
395 ERROR
396***************************************************************************|#
397
398(AREF DV 0)   0.0D0
399
400(AREF DV 1)   1.0D0
401
402(AREF DV 2)   2.0D0
403
404(AREF DV 3)   3.0D0
405
406(AREF DV 4)   4.0D0
407
408(AREF DV 5)   5.0D0
409
410(AREF DV 6)   6.0D0
411
412(AREF DV 7)   7.0D0
413
414(AREF DV 8)   8.0D0
415
416(AREF DV 9)   9.0D0
417
418(SETF (AREF DV 5) -5.0D0)   -5.0D0
419
420(FORMAT T "~%test indeces~%")   NIL
421
422(DEFUN ARRAY-INDEX-TEST (A &REST SUBS)
423  (UNLESS (APPLY (FUNCTION ARRAY-IN-BOUNDS-P) A SUBS)
424    (RETURN-FROM ARRAY-INDEX-TEST (QUOTE ERROR)))
425  (= (APPLY (FUNCTION ARRAY-ROW-MAJOR-INDEX) A SUBS)
426     (APPLY (FUNCTION +)
427            (MAPLIST #'(LAMBDA (X Y) (* (CAR X) (APPLY (FUNCTION *) (CDR Y))))
428                     SUBS (ARRAY-DIMENSIONS A)))))
429ARRAY-INDEX-TEST
430
431(ARRAY-INDEX-TEST (MAKE-ARRAY (QUOTE (5 4 3 2 1))) 4 2 2 1 0)
432T
433
434(ARRAY-INDEX-TEST (MAKE-ARRAY (QUOTE (5 4 3 2 1))) 3 4 2 1 2)
435ERROR
436
437(FORMAT T "~%bitvectors~%")   NIL
438
439(SETQ BVZERO (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0))
440#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
441
442(SETQ BVONE (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 1))
443#*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
444
445(SETQ BV3 (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0))
446#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
447
448(SETQ BV2 (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0))
449#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
450
451(SETQ BV1 (MAKE-ARRAY 100 :ELEMENT-TYPE (QUOTE BIT) :INITIAL-ELEMENT 0))
452#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
453
454(FORMAT T "~%set bitvectors~%")   NIL
455
456(DOTIMES (I 50 BV1) (SETF (SBIT BV1 (* I 2)) 1))
457#*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010
458
459(DOTIMES (I 50 BV2) (SETF (BIT BV2 (* I 2)) 1))
460#*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010
461
462(EQUALP BV1 BV2)   T
463(DOTIMES (I 25 BV3) (SETF (SBIT BV3 (* I 4)) 1))
464#*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000
465
466(BIT-AND BV1 BV3)
467#*1000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000
468
469(BIT-IOR BV1 BV3)
470#*1010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010
471
472(BIT-XOR BV1 BV3)
473#*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010
474
475(BIT-EQV BV1 BV3)
476#*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101
477
478(BIT-NAND BV1 BV3)
479#*0111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111
480
481(BIT-ANDC1 BV1 BV3)
482#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
483
484(BIT-ANDC2 BV1 BV3)
485#*0010001000100010001000100010001000100010001000100010001000100010001000100010001000100010001000100010
486
487(BIT-ORC1 BV1 BV3)
488#*1101110111011101110111011101110111011101110111011101110111011101110111011101110111011101110111011101
489
490(BIT-ORC2 BV1 BV3)
491#*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
492
493(BIT-NOT BV1)
494#*0101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101010101
495
496(BIT-NOT BVZERO)
497#*1111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111111
498
499(BIT-NOT BVONE)
500#*0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000
501
502(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
503       (s2 (make-array nil :initial-element 1 :element-type 'bit)))
504  (list (bit-xor s1 s2) s1 s2))
505(#0A1 #0A0 #0A1)
506
507(let* ((a1 (make-array '(2 2) :element-type 'bit :initial-contents '((0 1) (0 1))))
508       (a2 (make-array '(2 2) :element-type 'bit :initial-contents '((0 0) (1 1))))
509       (result (bit-and a1 a2)))
510  (list a1 a2 result))
511(#2A((0 1) (0 1)) #2A((0 0) (1 1)) #2A((0 0) (0 1)))
512
513(FORMAT T "~%test operations with fill-pointer~%")   NIL
514
515(MAKE-ARRAY (QUOTE (3 4 5)) :FILL-POINTER T)   ERROR
516
517(equalp (MAKE-ARRAY 5 :FILL-POINTER 5)
518        #+(or XCL CMU SBCL OpenMCL) '#(0 0 0 0 0) #-(or XCL CMU SBCL OpenMCL) '#(nil nil nil nil nil))
519T
520
521(MAKE-ARRAY 5 :FILL-POINTER -5)   ERROR
522
523(FORMAT T "~%general vector with fillpointer~%")   NIL
524
525(PROGN (SETQ VMF (MAKE-ARRAY 5 :FILL-POINTER 0)) T)   T
526
527(FILL-POINTER VMF)   0
528
529(VECTOR-PUSH (QUOTE A) VMF)   0
530
531(FILL-POINTER VMF)   1
532
533(VECTOR-PUSH (QUOTE B) VMF)   1
534
535(VECTOR-PUSH (QUOTE C) VMF)   2
536
537(VECTOR-PUSH (QUOTE D) VMF)   3
538
539(VECTOR-PUSH (QUOTE E) VMF)   4
540
541(VECTOR-PUSH (QUOTE VOLL) VMF)   NIL
542
543(VECTOR-POP VMF)   E
544
545(VECTOR-POP VMF)   D
546
547(VECTOR-POP VMF)   C
548
549(VECTOR-POP VMF)   B
550
551(VECTOR-POP VMF)   A
552
553(VECTOR-POP VMF)   ERROR
554
555(format t "~%adjustable general vector with fillpointer~%")   NIL
556
557(PROGN (SETQ VMFA (MAKE-ARRAY 5 :FILL-POINTER 0 :ADJUSTABLE T)) T)
558T
559
560(FILL-POINTER VMFA)   0
561
562(VECTOR-PUSH-EXTEND (QUOTE A) VMFA)   0
563
564(FILL-POINTER VMFA)   1
565
566(VECTOR-PUSH-EXTEND (QUOTE B) VMFA)   1
567
568(VECTOR-PUSH-EXTEND (QUOTE C) VMFA)   2
569
570(VECTOR-PUSH-EXTEND (QUOTE D) VMFA)   3
571
572(VECTOR-PUSH-EXTEND (QUOTE E) VMFA)   4
573
574(VECTOR-PUSH-EXTEND (QUOTE VOLL) VMFA)   5
575
576(VECTOR-POP VMFA)   VOLL
577
578(VECTOR-POP VMFA)   E
579
580(VECTOR-POP VMFA)   D
581
582(VECTOR-POP VMFA)   C
583
584(VECTOR-POP VMFA)   B
585
586(VECTOR-POP VMFA)   A
587
588(FORMAT T "~%Doppeltgen. Vector mit Fillpointer ~%")   NIL
589
590(PROGN (SETQ VMFD (MAKE-ARRAY 5 :FILL-POINTER 0 :ELEMENT-TYPE 'DOUBLE-FLOAT))
591       T)
592T
593
594(FILL-POINTER VMFD)   0
595
596(VECTOR-PUSH 0.0D0 VMFD)   0
597
598(FILL-POINTER VMFD)   1
599
600(VECTOR-PUSH 1.0D0 VMFD)   1
601
602(VECTOR-PUSH 2.0D0 VMFD)   2
603
604(VECTOR-PUSH 3.0D0 VMFD)   3
605
606(VECTOR-PUSH 4.0D0 VMFD)   4
607
608(VECTOR-PUSH 5.0D0 VMFD)   NIL
609
610(VECTOR-POP VMFD)   4.0D0
611
612(VECTOR-POP VMFD)   3.0D0
613
614(VECTOR-POP VMFD)   2.0D0
615
616(VECTOR-POP VMFD)   1.0D0
617
618(VECTOR-POP VMFD)   0.0D0
619
620(VECTOR-POP VMFD)   ERROR
621
622(PROGN (SETQ VMFAD (MAKE-ARRAY 5 :FILL-POINTER 0 :ELEMENT-TYPE 'DOUBLE-FLOAT
623                               :ADJUSTABLE T))
624       T)
625T
626
627(FILL-POINTER VMFAD)   0
628
629(VECTOR-PUSH-EXTEND 0.0D0 VMFAD)   0
630
631(FILL-POINTER VMFAD)   1
632
633(VECTOR-PUSH-EXTEND 1.0D0 VMFAD)   1
634
635(VECTOR-PUSH-EXTEND 2.0D0 VMFAD)   2
636
637(VECTOR-PUSH-EXTEND 3.0D0 VMFAD)   3
638
639(VECTOR-PUSH-EXTEND 4.0D0 VMFAD)   4
640
641(VECTOR-PUSH-EXTEND 5.0D0 VMFAD)   5
642
643(setf (fill-pointer vmfad) 3)      3
644
645(aref vmfad 5)                     5.0D0
646
647(elt  vmfad 5)                     error
648
649(setf (fill-pointer vmfad) 6)      6
650
651VMFAD                   #(0d0 1d0 2d0 3d0 4d0 5d0)
652
653(REVERSE VMFAD)         #(5d0 4d0 3d0 2d0 1d0 0d0)
654
655(NREVERSE VMFAD)        #(5d0 4d0 3d0 2d0 1d0 0d0)
656
657VMFAD                   #(5d0 4d0 3d0 2d0 1d0 0d0)
658
659(VECTOR-POP VMFAD)   0.0D0
660
661(VECTOR-POP VMFAD)   1.0D0
662
663(VECTOR-POP VMFAD)   2.0D0
664
665(VECTOR-POP VMFAD)   3.0D0
666
667(VECTOR-POP VMFAD)   4.0D0
668
669(VECTOR-POP VMFAD)   5.0D0
670
671(VECTOR-PUSH-EXTEND 5.0S0 VMFAD)
672#+(or XCL GCL ALLEGRO CMU SBCL OpenMCL) ERROR #+(or CLISP (and AKCL (not GCL)) ECL LISPWORKS) 0
673#-(or XCL CLISP AKCL ECL ALLEGRO CMU SBCL OpenMCL LISPWORKS) UNKNOWN
674
675;; (VECTOR NIL)
676(upgraded-array-element-type nil)
677nil
678
679(arrayp (setq nil-arr (make-array '(10 20) :element-type nil)))
680t
681
682(array-element-type
683 (setq nil-vec (make-array 4 :element-type nil
684                             :displaced-to nil-arr
685                             :displaced-index-offset 2)))
686nil
687
688(typep nil-vec 'sequence)
689t
690
691(aref nil-arr 2 2)
692error
693
694(setf (aref nil-vec 1) 0)
695error
696
697(fill nil-vec 1)
698error
699
700(replace nil-vec #(0 1 0 1))
701error
702
703(replace #(0 1 0 1) nil-vec)
704error
705
706(progn (copy-seq nil-vec) #-CLISP nil)
707#+CLISP #A(NIL (4))
708#-CLISP NIL
709
710(setq nil-vec nil nil-arr nil)
711nil
712
713;; <http://www.ai.mit.edu/projects/iiip/doc/CommonLISP/HyperSpec/Body/fun_adjust-array.html>
714(adjustable-array-p
715 (setq ada (adjust-array
716            (make-array '(2 3)
717                        :adjustable t
718                        :initial-contents '((a b c) (1 2 3)))
719            '(4 6))))
720T
721(array-dimensions ada)   (4 6)
722(aref ada 1 1)           2
723(setq beta (make-array '(2 3) :adjustable t))
724#+(or CMU SBCL OpenMCL)
725#2A((0 0 0) (0 0 0))
726#-(or CMU SBCL OpenMCL)
727#2A((NIL NIL NIL) (NIL NIL NIL))
728(adjust-array beta '(4 6) :displaced-to ada)
729#+(or CMU SBCL OpenMCL)
730#2A((A B C 0 0 0)
731    (1 2 3 0 0 0)
732    (0 0 0 0 0 0)
733    (0 0 0 0 0 0))
734#-(or CMU SBCL OpenMCL)
735#2A((A B C NIL NIL NIL)
736    (1 2 3 NIL NIL NIL)
737    (NIL NIL NIL NIL NIL NIL)
738    (NIL NIL NIL NIL NIL NIL))
739(array-dimensions beta)  (4 6)
740(aref beta 1 1)          2
741
742(adjust-array
743 #2A(( alpha     beta      gamma     delta )
744     ( epsilon   zeta      eta       theta )
745     ( iota      kappa     lambda    mu    )
746     ( nu        xi        omicron   pi    ))
747 '(3 5) :initial-element 'baz)
748#2A(( alpha     beta      gamma     delta     baz )
749    ( epsilon   zeta      eta       theta     baz )
750    ( iota      kappa     lambda    mu        baz ))
751
752
753(adjust-array #(1 2 3 4) '(6))
754#+(or CMU SBCL OpenMCL)
755#(1 2 3 4 0 0)
756#-(or CMU SBCL OpenMCL)
757#(1 2 3 4 NIL NIL)
758
759(let* ((a1 (make-array 5 :initial-contents '(a b c d e) :fill-pointer 3))
760       (a2 (adjust-array a1 8 :fill-pointer 5 :initial-element 'x)))
761  (assert (if (adjustable-array-p a1) (eq a1 a2)
762              (equal (array-dimensions a1) '(5))))
763  (assert (not (array-displacement a2)))
764  (list (array-dimensions a2) (fill-pointer a2) a2
765        (aref a2 5) (aref a2 6) (aref a2 7)))
766((8) 5 #(A B C D E) X X X)
767
768(equal (make-string 0) (make-array 0 :element-type nil)) T
769(equalp (make-array '(1 2 0)) (make-array '(1 2 0) :element-type nil)) T
770
771(row-major-aref "abcd" 3)
772#\d
773(setf (row-major-aref "abcd" 3) 17)
774ERROR
775
776;; from pfd's ansi tests
777(LET* ((A1 (MAKE-ARRAY 5 :INITIAL-CONTENTS "abcde" :FILL-POINTER 3
778                       :ADJUSTABLE T :ELEMENT-TYPE 'CHARACTER))
779       (A2 (ADJUST-ARRAY A1 8 :FILL-POINTER 5 :INITIAL-ELEMENT #\x
780                         :ELEMENT-TYPE 'CHARACTER)))
781  (ASSERT (OR (NOT (ADJUSTABLE-ARRAY-P A1)) (EQ A1 A2)))
782  (ASSERT (OR (ADJUSTABLE-ARRAY-P A1) (EQUAL (ARRAY-DIMENSIONS A1) '(5))))
783  (ASSERT (EQUAL (ARRAY-DIMENSIONS A2) '(8)))
784  (ASSERT (NOT (ARRAY-DISPLACEMENT A2)))
785  (ASSERT (EQUAL (LIST (AREF A2 5) (AREF A2 6) (AREF A2 7)) '(#\x #\x #\x)))
786  (list (FILL-POINTER A2) A2))
787(5 "abcde")
788