9 |
|
|
10 |
;; elt on lists |
;; elt on lists |
11 |
|
|
12 |
(deftest elt-1 |
(deftest elt.1 |
13 |
(classify-error (elt nil 0)) |
(classify-error (elt nil 0)) |
14 |
type-error) |
type-error) |
15 |
|
|
16 |
(deftest elt-1a |
(deftest elt.1a |
17 |
(classify-error (elt nil -10)) |
(classify-error (elt nil -10)) |
18 |
type-error) |
type-error) |
19 |
|
|
20 |
(deftest elt-1b |
(deftest elt.1b |
21 |
(classify-error (locally (elt nil 0) t)) |
(classify-error (locally (elt nil 0) t)) |
22 |
type-error) |
type-error) |
23 |
|
|
24 |
(deftest elt-2 |
(deftest elt.2 |
25 |
(classify-error (elt nil 1000000)) |
(classify-error (elt nil 1000000)) |
26 |
type-error) |
type-error) |
27 |
|
|
28 |
(deftest elt-3 (elt '(a b c d e) 0) a) |
(deftest elt.3 (elt '(a b c d e) 0) a) |
29 |
(deftest elt-4 (elt '(a b c d e) 2) c) |
(deftest elt.4 (elt '(a b c d e) 2) c) |
30 |
(deftest elt-5 (elt '(a b c d e) 4) e) |
(deftest elt.5 (elt '(a b c d e) 4) e) |
31 |
(deftest elt-5a |
(deftest elt.5a |
32 |
(classify-error (elt '(a b c d e) -4)) |
(classify-error (elt '(a b c d e) -4)) |
33 |
type-error) |
type-error) |
34 |
|
|
35 |
(deftest elt-6 |
(deftest elt.6 |
36 |
(let ((x (make-int-list 1000))) |
(let ((x (make-int-list 1000))) |
37 |
(notnot-mv |
(notnot-mv |
38 |
(every |
(every |
40 |
x))) |
x))) |
41 |
t) |
t) |
42 |
|
|
43 |
(deftest elt-7 |
(deftest elt.7 |
44 |
(let* ((x (list 'a 'b 'c 'd)) |
(let* ((x (list 'a 'b 'c 'd)) |
45 |
(y (setf (elt x 0) 'e))) |
(y (setf (elt x 0) 'e))) |
46 |
(list x y)) |
(list x y)) |
47 |
((e b c d) e)) |
((e b c d) e)) |
48 |
|
|
49 |
(deftest elt-8 |
(deftest elt.8 |
50 |
(let* ((x (list 'a 'b 'c 'd)) |
(let* ((x (list 'a 'b 'c 'd)) |
51 |
(y (setf (elt x 1) 'e))) |
(y (setf (elt x 1) 'e))) |
52 |
(list x y)) |
(list x y)) |
53 |
((a e c d) e)) |
((a e c d) e)) |
54 |
|
|
55 |
(deftest elt-9 |
(deftest elt.9 |
56 |
(let* ((x (list 'a 'b 'c 'd)) |
(let* ((x (list 'a 'b 'c 'd)) |
57 |
(y (setf (elt x 3) 'e))) |
(y (setf (elt x 3) 'e))) |
58 |
(list x y)) |
(list x y)) |
59 |
((a b c e) e)) |
((a b c e) e)) |
60 |
|
|
61 |
(deftest elt-10 |
(deftest elt.10 |
62 |
(classify-error |
(classify-error |
63 |
(let ((x (list 'a 'b 'c))) |
(let ((x (list 'a 'b 'c))) |
64 |
(setf (elt x 4) 'd))) |
(setf (elt x 4) 'd))) |
65 |
type-error) |
type-error) |
66 |
|
|
67 |
(deftest elt-11 |
(deftest elt.11 |
68 |
(let ((x (list 'a 'b 'c 'd 'e))) |
(let ((x (list 'a 'b 'c 'd 'e))) |
69 |
(let ((y (loop for c on x collect c))) |
(let ((y (loop for c on x collect c))) |
70 |
(setf (elt x 2) 'f) |
(setf (elt x 2) 'f) |
74 |
(loop for c on x collect c))))) |
(loop for c on x collect c))))) |
75 |
t) |
t) |
76 |
|
|
77 |
(deftest elt-12 |
(deftest elt.12 |
78 |
(let ((x (make-int-list 100000))) |
(let ((x (make-int-list 100000))) |
79 |
(elt x 90000)) |
(elt x 90000)) |
80 |
90000) |
90000) |
81 |
|
|
82 |
(deftest elt-13 |
(deftest elt.13 |
83 |
(let ((x (make-int-list 100000))) |
(let ((x (make-int-list 100000))) |
84 |
(setf (elt x 80000) 'foo) |
(setf (elt x 80000) 'foo) |
85 |
(list (elt x 79999) |
(list (elt x 79999) |
87 |
(elt x 80001))) |
(elt x 80001))) |
88 |
(79999 foo 80001)) |
(79999 foo 80001)) |
89 |
|
|
90 |
(deftest elt-14 |
(deftest elt.14 |
91 |
(classify-error |
(classify-error |
92 |
(let ((x (list 'a 'b 'c))) |
(let ((x (list 'a 'b 'c))) |
93 |
(elt x 10))) |
(elt x 10))) |
94 |
type-error) |
type-error) |
95 |
|
|
96 |
(deftest elt-15 |
(deftest elt.15 |
97 |
(classify-error |
(classify-error |
98 |
(let ((x (list 'a 'b 'c))) |
(let ((x (list 'a 'b 'c))) |
99 |
(elt x 'a))) |
(elt x 'a))) |
100 |
type-error) |
type-error) |
101 |
|
|
102 |
(deftest elt-16 |
(deftest elt.16 |
103 |
(classify-error |
(classify-error |
104 |
(let ((x (list 'a 'b 'c))) |
(let ((x (list 'a 'b 'c))) |
105 |
(elt x 10.0))) |
(elt x 10.0))) |
106 |
type-error) |
type-error) |
107 |
|
|
108 |
(deftest elt-17 |
(deftest elt.17 |
109 |
(classify-error |
(classify-error |
110 |
(let ((x (list 'a 'b 'c))) |
(let ((x (list 'a 'b 'c))) |
111 |
(elt x -1))) |
(elt x -1))) |
112 |
type-error) |
type-error) |
113 |
|
|
114 |
(deftest elt-18 |
(deftest elt.18 |
115 |
(classify-error |
(classify-error |
116 |
(let ((x (list 'a 'b 'c))) |
(let ((x (list 'a 'b 'c))) |
117 |
(elt x -100000000000000000))) |
(elt x -100000000000000000))) |
118 |
type-error) |
type-error) |
119 |
|
|
120 |
(deftest elt-19 |
(deftest elt.19 |
121 |
(classify-error |
(classify-error |
122 |
(let ((x (list 'a 'b 'c))) |
(let ((x (list 'a 'b 'c))) |
123 |
(elt x #\w))) |
(elt x #\w))) |
124 |
type-error) |
type-error) |
125 |
|
|
126 |
(deftest elt.20 |
(deftest elt.order.1 |
127 |
(let ((i 0) x y) |
(let ((i 0) x y) |
128 |
(values |
(values |
129 |
(elt (progn (setf x (incf i)) '(a b c d e)) |
(elt (progn (setf x (incf i)) '(a b c d e)) |
131 |
i x y)) |
i x y)) |
132 |
d 2 1 2) |
d 2 1 2) |
133 |
|
|
134 |
(deftest elt.21 |
(deftest elt.order.2 |
135 |
(let ((i 0) x y z) |
(let ((i 0) x y z) |
136 |
(let ((a (make-array 1 :initial-element (list 'a 'b 'c 'd 'e)))) |
(let ((a (make-array 1 :initial-element (list 'a 'b 'c 'd 'e)))) |
137 |
(values |
(values |
142 |
i x y z))) |
i x y z))) |
143 |
k (a b c k e) 3 1 2 3) |
k (a b c k e) 3 1 2 3) |
144 |
|
|
145 |
(deftest elt-v-1 |
(deftest elt-v.1 |
146 |
(classify-error |
(classify-error |
147 |
(elt (make-array '(0)) 0)) |
(elt (make-array '(0)) 0)) |
148 |
type-error) |
type-error) |
149 |
|
|
150 |
;; (deftest elt-v-2 (elt (make-array '(1)) 0) nil) ;; actually undefined |
;; (deftest elt-v.2 (elt (make-array '(1)) 0) nil) ;; actually undefined |
151 |
(deftest elt-v-3 |
(deftest elt-v.3 |
152 |
(elt (make-array '(5) :initial-contents '(a b c d e)) 0) |
(elt (make-array '(5) :initial-contents '(a b c d e)) 0) |
153 |
a) |
a) |
154 |
|
|
155 |
(deftest elt-v-4 |
(deftest elt-v.4 |
156 |
(elt (make-array '(5) :initial-contents '(a b c d e)) 2) |
(elt (make-array '(5) :initial-contents '(a b c d e)) 2) |
157 |
c) |
c) |
158 |
|
|
159 |
(deftest elt-v-5 |
(deftest elt-v.5 |
160 |
(elt (make-array '(5) :initial-contents '(a b c d e)) 4) |
(elt (make-array '(5) :initial-contents '(a b c d e)) 4) |
161 |
e) |
e) |
162 |
|
|
163 |
(deftest elt-v-6 |
(deftest elt-v.6 |
164 |
(elt-v-6-body) |
(elt-v-6-body) |
165 |
t) |
t) |
166 |
|
|
167 |
(deftest elt-v-7 |
(deftest elt-v.7 |
168 |
(let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
(let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
169 |
(y (setf (elt x 0) 'e))) |
(y (setf (elt x 0) 'e))) |
170 |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
171 |
(e b c d e)) |
(e b c d e)) |
172 |
|
|
173 |
(deftest elt-v-8 |
(deftest elt-v.8 |
174 |
(let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
(let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
175 |
(y (setf (elt x 1) 'e))) |
(y (setf (elt x 1) 'e))) |
176 |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
177 |
(a e c d e)) |
(a e c d e)) |
178 |
|
|
179 |
(deftest elt-v-9 |
(deftest elt-v.9 |
180 |
(let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
(let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
181 |
(y (setf (elt x 3) 'e))) |
(y (setf (elt x 3) 'e))) |
182 |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
183 |
(a b c e e)) |
(a b c e e)) |
184 |
|
|
185 |
(deftest elt-v-10 |
(deftest elt-v.10 |
186 |
(classify-error |
(classify-error |
187 |
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) |
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) |
188 |
(setf (elt x 4) 'd))) |
(setf (elt x 4) 'd))) |
189 |
type-error) |
type-error) |
190 |
|
|
191 |
(deftest elt-v-11 |
(deftest elt-v.11 |
192 |
(classify-error |
(classify-error |
193 |
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) |
(let ((x (make-array '(3) :initial-contents (list 'a 'b 'c)))) |
194 |
(setf (elt x -100) 'd))) |
(setf (elt x -100) 'd))) |
195 |
type-error) |
type-error) |
196 |
|
|
197 |
(deftest elt-v-12 |
(deftest elt-v.12 |
198 |
(let ((x (make-int-array 100000))) |
(let ((x (make-int-array 100000))) |
199 |
(elt x 90000)) |
(elt x 90000)) |
200 |
90000) |
90000) |
201 |
|
|
202 |
(deftest elt-v-13 |
(deftest elt-v.13 |
203 |
(let ((x (make-int-array 100000))) |
(let ((x (make-int-array 100000))) |
204 |
(setf (elt x 80000) 'foo) |
(setf (elt x 80000) 'foo) |
205 |
(list (elt x 79999) |
(list (elt x 79999) |
209 |
|
|
210 |
;;; Adjustable arrays |
;;; Adjustable arrays |
211 |
|
|
212 |
(deftest elt-adj-array-1 |
(deftest elt-adj-array.1 |
213 |
(classify-error (elt (make-adj-array '(0)) 0)) |
(classify-error (elt (make-adj-array '(0)) 0)) |
214 |
type-error) |
type-error) |
215 |
|
|
216 |
;;; (deftest elt-adj-array-2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined |
;;; (deftest elt-adj-array.2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined |
217 |
|
|
218 |
(deftest elt-adj-array-3 |
(deftest elt-adj-array.3 |
219 |
(elt (make-adj-array '(5) :initial-contents '(a b c d e)) 0) |
(elt (make-adj-array '(5) :initial-contents '(a b c d e)) 0) |
220 |
a) |
a) |
221 |
|
|
222 |
(deftest elt-adj-array-4 |
(deftest elt-adj-array.4 |
223 |
(elt (make-adj-array '(5) :initial-contents '(a b c d e)) 2) |
(elt (make-adj-array '(5) :initial-contents '(a b c d e)) 2) |
224 |
c) |
c) |
225 |
|
|
226 |
(deftest elt-adj-array-5 |
(deftest elt-adj-array.5 |
227 |
(elt (make-adj-array '(5) :initial-contents '(a b c d e)) 4) |
(elt (make-adj-array '(5) :initial-contents '(a b c d e)) 4) |
228 |
e) |
e) |
229 |
|
|
230 |
(deftest elt-adj-array-6 |
(deftest elt-adj-array.6 |
231 |
(elt-adj-array-6-body) |
(elt-adj-array-6-body) |
232 |
t) |
t) |
233 |
|
|
234 |
(deftest elt-adj-array-7 |
(deftest elt-adj-array.7 |
235 |
(let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
(let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
236 |
(y (setf (elt x 0) 'e))) |
(y (setf (elt x 0) 'e))) |
237 |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
238 |
(e b c d e)) |
(e b c d e)) |
239 |
|
|
240 |
(deftest elt-adj-array-8 |
(deftest elt-adj-array.8 |
241 |
(let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
(let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
242 |
(y (setf (elt x 1) 'e))) |
(y (setf (elt x 1) 'e))) |
243 |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
244 |
(a e c d e)) |
(a e c d e)) |
245 |
|
|
246 |
(deftest elt-adj-array-9 |
(deftest elt-adj-array.9 |
247 |
(let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
(let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd))) |
248 |
(y (setf (elt x 3) 'e))) |
(y (setf (elt x 3) 'e))) |
249 |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
(list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y)) |
250 |
(a b c e e)) |
(a b c e e)) |
251 |
|
|
252 |
(deftest elt-adj-array-10 |
(deftest elt-adj-array.10 |
253 |
(classify-error |
(classify-error |
254 |
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) |
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) |
255 |
(setf (elt x 4) 'd))) |
(setf (elt x 4) 'd))) |
256 |
type-error) |
type-error) |
257 |
|
|
258 |
(deftest elt-adj-array-11 |
(deftest elt-adj-array.11 |
259 |
(classify-error |
(classify-error |
260 |
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) |
(let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c)))) |
261 |
(setf (elt x -100) 'd))) |
(setf (elt x -100) 'd))) |
262 |
type-error) |
type-error) |
263 |
|
|
264 |
(deftest elt-adj-array-12 |
(deftest elt-adj-array.12 |
265 |
(let ((x (make-int-array 100000 #'make-adj-array))) |
(let ((x (make-int-array 100000 #'make-adj-array))) |
266 |
(elt x 90000)) |
(elt x 90000)) |
267 |
90000) |
90000) |
268 |
|
|
269 |
(deftest elt-adj-array-13 |
(deftest elt-adj-array.13 |
270 |
(let ((x (make-int-array 100000 #'make-adj-array))) |
(let ((x (make-int-array 100000 #'make-adj-array))) |
271 |
(setf (elt x 80000) 'foo) |
(setf (elt x 80000) 'foo) |
272 |
(list (elt x 79999) |
(list (elt x 79999) |
276 |
|
|
277 |
;; displaced arrays |
;; displaced arrays |
278 |
|
|
279 |
(deftest elt-displaced-array-1 |
(deftest elt-displaced-array.1 |
280 |
(classify-error (elt (make-displaced-array '(0) 100) 0)) |
(classify-error (elt (make-displaced-array '(0) 100) 0)) |
281 |
type-error) |
type-error) |
282 |
|
|
283 |
(deftest elt-displaced-array-2 |
(deftest elt-displaced-array.2 |
284 |
(elt (make-displaced-array '(1) 100) 0) |
(elt (make-displaced-array '(1) 100) 0) |
285 |
100) |
100) |
286 |
|
|
287 |
(deftest elt-displaced-array-3 |
(deftest elt-displaced-array.3 |
288 |
(elt (make-displaced-array '(5) 100) 4) |
(elt (make-displaced-array '(5) 100) 4) |
289 |
104) |
104) |
290 |
|
|
291 |
;;; Arrays with fill points |
;;; Arrays with fill points |
292 |
|
|
293 |
(deftest elt-fill-pointer-1 |
(deftest elt-fill-pointer.1 |
294 |
(let ((a (make-array '(5) :initial-contents '(a b c d e) |
(let ((a (make-array '(5) :initial-contents '(a b c d e) |
295 |
:fill-pointer 3))) |
:fill-pointer 3))) |
296 |
(values (elt a 0) (elt a 1) (elt a 2))) |
(values (elt a 0) (elt a 1) (elt a 2))) |
297 |
a b c) |
a b c) |
298 |
|
|
299 |
(deftest elt-fill-pointer-2 |
(deftest elt-fill-pointer.2 |
300 |
(let ((a (make-array '(5) |
(let ((a (make-array '(5) |
301 |
:initial-contents '(0 0 1 0 0) |
:initial-contents '(0 0 1 0 0) |
302 |
:element-type 'bit |
:element-type 'bit |
304 |
(values (elt a 0) (elt a 1) (elt a 2))) |
(values (elt a 0) (elt a 1) (elt a 2))) |
305 |
0 0 1) |
0 0 1) |
306 |
|
|
307 |
(deftest elt-fill-pointer-3 |
(deftest elt-fill-pointer.3 |
308 |
(classify-error |
(classify-error |
309 |
(let ((a (make-array '(5) |
(let ((a (make-array '(5) |
310 |
:initial-contents '(0 0 1 0 0) |
:initial-contents '(0 0 1 0 0) |
312 |
(elt a 4))) |
(elt a 4))) |
313 |
type-error) |
type-error) |
314 |
|
|
315 |
(deftest elt-fill-pointer-4 |
(deftest elt-fill-pointer.4 |
316 |
(classify-error |
(classify-error |
317 |
(let ((a (make-array '(5) |
(let ((a (make-array '(5) |
318 |
:initial-contents '(0 0 1 0 0) |
:initial-contents '(0 0 1 0 0) |
321 |
(elt a 4))) |
(elt a 4))) |
322 |
type-error) |
type-error) |
323 |
|
|
324 |
(deftest elt-fill-pointer-5 |
(deftest elt-fill-pointer.5 |
325 |
(let ((a (make-array '(5) |
(let ((a (make-array '(5) |
326 |
:initial-contents '(#\a #\b #\c #\d #\e) |
:initial-contents '(#\a #\b #\c #\d #\e) |
327 |
:element-type 'character |
:element-type 'character |
329 |
(values (elt a 0) (elt a 1) (elt a 2))) |
(values (elt a 0) (elt a 1) (elt a 2))) |
330 |
#\a #\b #\c) |
#\a #\b #\c) |
331 |
|
|
332 |
(deftest elt-fill-pointer-6 |
(deftest elt-fill-pointer.6 |
333 |
(classify-error |
(classify-error |
334 |
(let ((a (make-array '(5) |
(let ((a (make-array '(5) |
335 |
:initial-contents '(#\a #\b #\c #\d #\e) |
:initial-contents '(#\a #\b #\c #\d #\e) |
338 |
(elt a 4))) |
(elt a 4))) |
339 |
type-error) |
type-error) |
340 |
|
|
341 |
(deftest elt-fill-pointer-7 |
(deftest elt-fill-pointer.7 |
342 |
(let ((a (make-array '(5) |
(let ((a (make-array '(5) |
343 |
:initial-contents '(#\a #\b #\c #\d #\e) |
:initial-contents '(#\a #\b #\c #\d #\e) |
344 |
:element-type 'base-char |
:element-type 'base-char |
346 |
(values (elt a 0) (elt a 1) (elt a 2))) |
(values (elt a 0) (elt a 1) (elt a 2))) |
347 |
#\a #\b #\c) |
#\a #\b #\c) |
348 |
|
|
349 |
(deftest elt-fill-pointer-8 |
(deftest elt-fill-pointer.8 |
350 |
(classify-error |
(classify-error |
351 |
(let ((a (make-array '(5) |
(let ((a (make-array '(5) |
352 |
:initial-contents '(#\a #\b #\c #\d #\e) |
:initial-contents '(#\a #\b #\c #\d #\e) |