252 |
5 5 6 nil #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0 0.0l0)) |
5 5 6 nil #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0 0.0l0)) |
253 |
|
|
254 |
|
|
255 |
|
;;; Tests on displaced arrays |
256 |
|
|
257 |
|
(deftest vector-push-extend.21 |
258 |
|
(let* ((a1 (make-array 10 :initial-element nil)) |
259 |
|
(a2 (make-array 6 :displaced-to a1 |
260 |
|
:displaced-index-offset 2 |
261 |
|
:fill-pointer 0))) |
262 |
|
(values |
263 |
|
(fill-pointer a2) |
264 |
|
(map 'list #'identity a2) |
265 |
|
(vector-push-extend 'foo a2) |
266 |
|
(fill-pointer a2) |
267 |
|
(map 'list #'identity a2) |
268 |
|
(map 'list #'identity a1))) |
269 |
|
0 |
270 |
|
() |
271 |
|
0 |
272 |
|
1 |
273 |
|
(foo) |
274 |
|
(nil nil foo nil nil nil nil nil nil nil)) |
275 |
|
|
276 |
|
(deftest vector-push-extend.22 |
277 |
|
(let* ((a1 (make-array 6 :initial-element nil)) |
278 |
|
(a2 (make-array 0 :displaced-to a1 |
279 |
|
:displaced-index-offset 2 |
280 |
|
:adjustable t |
281 |
|
:fill-pointer 0))) |
282 |
|
(values |
283 |
|
(fill-pointer a2) |
284 |
|
(map 'list #'identity a2) |
285 |
|
(vector-push-extend 'foo a2) |
286 |
|
(fill-pointer a2) |
287 |
|
(map 'list #'identity a2) |
288 |
|
(map 'list #'identity a1) |
289 |
|
(notnot (adjustable-array-p a2)) |
290 |
|
(multiple-value-list (array-displacement a2)) |
291 |
|
)) |
292 |
|
0 |
293 |
|
() |
294 |
|
0 |
295 |
|
1 |
296 |
|
(foo) |
297 |
|
(nil nil nil nil nil nil) |
298 |
|
t |
299 |
|
(nil 0)) |
300 |
|
|
301 |
|
(deftest vector-push-extend.23 |
302 |
|
(let* ((a1 (make-array 10 :initial-element nil)) |
303 |
|
(a2 (make-array 6 :displaced-to a1 |
304 |
|
:displaced-index-offset 2 |
305 |
|
:adjustable t |
306 |
|
:fill-pointer 1))) |
307 |
|
(values |
308 |
|
(fill-pointer a2) |
309 |
|
(map 'list #'identity a2) |
310 |
|
(vector-push-extend 'foo a2) |
311 |
|
(fill-pointer a2) |
312 |
|
(map 'list #'identity a2) |
313 |
|
(map 'list #'identity a1) |
314 |
|
(notnot (adjustable-array-p a2)) |
315 |
|
(eqt (array-displacement a2) a1) |
316 |
|
(nth-value 1 (array-displacement a2)) |
317 |
|
)) |
318 |
|
1 |
319 |
|
(nil) |
320 |
|
1 |
321 |
|
2 |
322 |
|
(nil foo) |
323 |
|
(nil nil nil foo nil nil nil nil nil nil) |
324 |
|
t |
325 |
|
t |
326 |
|
2) |
327 |
|
|
328 |
|
(deftest vector-push-extend.24 |
329 |
|
(let* ((a1 (make-array 4 :initial-element nil)) |
330 |
|
(a2 (make-array 2 :displaced-to a1 |
331 |
|
:displaced-index-offset 2 |
332 |
|
:adjustable t |
333 |
|
:fill-pointer 2))) |
334 |
|
(values |
335 |
|
(map 'list #'identity a1) |
336 |
|
(map 'list #'identity a2) |
337 |
|
(vector-push-extend 'foo a2 7) |
338 |
|
(fill-pointer a2) |
339 |
|
(map 'list #'identity a1) |
340 |
|
(map 'list #'identity a2) |
341 |
|
(array-dimension a2 0) |
342 |
|
(notnot (adjustable-array-p a2)) |
343 |
|
(multiple-value-list (array-displacement a2)))) |
344 |
|
(nil nil nil nil) |
345 |
|
(nil nil) |
346 |
|
2 |
347 |
|
3 |
348 |
|
(nil nil nil nil) |
349 |
|
(nil nil foo) |
350 |
|
9 |
351 |
|
t |
352 |
|
(nil 0)) |
353 |
|
|
354 |
|
;;; Integer vectors |
355 |
|
|
356 |
|
(deftest vector-push-extend.25 |
357 |
|
(loop for adj in '(nil t) |
358 |
|
nconc |
359 |
|
(loop for bits from 1 to 64 |
360 |
|
for etype = `(unsigned-byte ,bits) |
361 |
|
for a1 = (make-array 10 :initial-element 0 |
362 |
|
:element-type etype) |
363 |
|
for a2 =(make-array 6 |
364 |
|
:element-type etype |
365 |
|
:displaced-to a1 |
366 |
|
:displaced-index-offset 2 |
367 |
|
:adjustable adj |
368 |
|
:fill-pointer 0) |
369 |
|
for result = (list (fill-pointer a2) |
370 |
|
(map 'list #'identity a2) |
371 |
|
(vector-push-extend 1 a2) |
372 |
|
(fill-pointer a2) |
373 |
|
(map 'list #'identity a2) |
374 |
|
(map 'list #'identity a1)) |
375 |
|
unless (equal result '(0 () 0 1 (1) (0 0 1 0 0 0 0 0 0 0))) |
376 |
|
collect (list etype adj result))) |
377 |
|
nil) |
378 |
|
|
379 |
|
(deftest vector-push-extend.26 |
380 |
|
(loop for bits from 1 to 64 |
381 |
|
for etype = `(unsigned-byte ,bits) |
382 |
|
for a1 = (make-array 8 :initial-element 0 |
383 |
|
:element-type etype) |
384 |
|
for a2 = (make-array 6 |
385 |
|
:element-type etype |
386 |
|
:displaced-to a1 |
387 |
|
:displaced-index-offset 2 |
388 |
|
:adjustable t |
389 |
|
:fill-pointer 6) |
390 |
|
for result = (list (fill-pointer a2) |
391 |
|
(map 'list #'identity a2) |
392 |
|
(vector-push-extend 1 a2) |
393 |
|
(fill-pointer a2) |
394 |
|
(map 'list #'identity a2) |
395 |
|
(map 'list #'identity a1) |
396 |
|
(notnot (adjustable-array-p a2)) |
397 |
|
(multiple-value-list (array-displacement a1))) |
398 |
|
unless (equal result '(6 (0 0 0 0 0 0) 6 7 (0 0 0 0 0 0 1) |
399 |
|
(0 0 0 0 0 0 0 0) t (nil 0))) |
400 |
|
collect (list etype result)) |
401 |
|
nil) |
402 |
|
|
403 |
;;; Error tests |
;;; Error tests |
404 |
|
|