Commit | Line | Data |
---|---|---|
9060dc29 MW |
1 | ;;;; srfi-43.test --- test suite for SRFI-43 Vector library -*- scheme -*- |
2 | ;;;; | |
3 | ;;;; Copyright (C) 2014 Free Software Foundation, Inc. | |
4 | ;;;; | |
5 | ;;;; This library is free software; you can redistribute it and/or | |
6 | ;;;; modify it under the terms of the GNU Lesser General Public | |
7 | ;;;; License as published by the Free Software Foundation; either | |
8 | ;;;; version 3 of the License, or (at your option) any later version. | |
9 | ;;;; | |
10 | ;;;; This library is distributed in the hope that it will be useful, | |
11 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
12 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
13 | ;;;; Lesser General Public License for more details. | |
14 | ;;;; | |
15 | ;;;; You should have received a copy of the GNU Lesser General Public | |
16 | ;;;; License along with this library; if not, write to the Free Software | |
17 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
18 | ||
19 | ;;; | |
20 | ;;; Originally written by Shiro Kawai and placed in the public domain | |
21 | ;;; 10/5/2005. | |
22 | ;;; | |
23 | ;;; Many tests added, and adapted for Guile's (test-suite lib) | |
24 | ;;; by Mark H Weaver <mhw@netris.org>, Jan 2014. | |
25 | ;;; | |
26 | ||
27 | (define-module (test-suite test-srfi-43) | |
28 | #:use-module (srfi srfi-43) | |
29 | #:use-module (test-suite lib)) | |
30 | ||
31 | (define-syntax-rule (pass-if-error name body0 body ...) | |
32 | (pass-if name | |
33 | (catch #t | |
34 | (lambda () body0 body ... #f) | |
35 | (lambda (key . args) #t)))) | |
36 | ||
37 | ;;; | |
38 | ;;; Constructors | |
39 | ;;; | |
40 | ||
41 | ;; | |
42 | ;; make-vector | |
43 | ;; | |
44 | ||
45 | (with-test-prefix "make-vector" | |
46 | ||
47 | (pass-if-equal "simple, no init" | |
48 | 5 | |
49 | (vector-length (make-vector 5))) | |
50 | ||
51 | (pass-if-equal "empty" | |
52 | '#() | |
53 | (make-vector 0)) | |
54 | ||
55 | (pass-if-error "negative length" | |
56 | (make-vector -4)) | |
57 | ||
58 | (pass-if-equal "simple with init" | |
59 | '#(3 3 3 3 3) | |
60 | (make-vector 5 3)) | |
61 | ||
62 | (pass-if-equal "empty with init" | |
63 | '#() | |
64 | (make-vector 0 3)) | |
65 | ||
66 | (pass-if-error "negative length" | |
67 | (make-vector -1 3))) | |
68 | ||
69 | ;; | |
70 | ;; vector | |
71 | ;; | |
72 | ||
73 | (with-test-prefix "vector" | |
74 | ||
75 | (pass-if-equal "no args" | |
76 | '#() | |
77 | (vector)) | |
78 | ||
79 | (pass-if-equal "simple" | |
80 | '#(1 2 3 4 5) | |
81 | (vector 1 2 3 4 5))) | |
82 | ||
83 | ;; | |
84 | ;; vector-unfold | |
85 | ;; | |
86 | ||
87 | (with-test-prefix "vector-unfold" | |
88 | ||
89 | (pass-if-equal "no seeds" | |
90 | '#(0 1 2 3 4 5 6 7 8 9) | |
91 | (vector-unfold values 10)) | |
92 | ||
93 | (pass-if-equal "no seeds, zero len" | |
94 | '#() | |
95 | (vector-unfold values 0)) | |
96 | ||
97 | (pass-if-error "no seeds, negative len" | |
98 | (vector-unfold values -1)) | |
99 | ||
100 | (pass-if-equal "1 seed" | |
101 | '#(0 -1 -2 -3 -4 -5 -6 -7 -8 -9) | |
102 | (vector-unfold (lambda (i x) (values x (- x 1))) | |
103 | 10 0)) | |
104 | ||
105 | (pass-if-equal "1 seed, zero len" | |
106 | '#() | |
107 | (vector-unfold values 0 1)) | |
108 | ||
109 | (pass-if-error "1 seed, negative len" | |
110 | (vector-unfold values -2 1)) | |
111 | ||
112 | (pass-if-equal "2 seeds" | |
113 | '#((0 20) (-1 21) (-2 22) (-3 23) (-4 24) | |
114 | (-5 25) (-6 26) (-7 27) (-8 28) (-9 29)) | |
115 | (vector-unfold (lambda (i x y) (values (list x y) (- x 1) (+ y 1))) | |
116 | 10 0 20)) | |
117 | ||
118 | (pass-if-equal "2 seeds, zero len" | |
119 | '#() | |
120 | (vector-unfold values 0 1 2)) | |
121 | ||
122 | (pass-if-error "2 seeds, negative len" | |
123 | (vector-unfold values -2 1 2)) | |
124 | ||
125 | (pass-if-equal "3 seeds" | |
126 | '#((0 20 30) (-1 21 32) (-2 22 34) (-3 23 36) (-4 24 38) | |
127 | (-5 25 40) (-6 26 42) (-7 27 44) (-8 28 46) (-9 29 48)) | |
128 | (vector-unfold (lambda (i x y z) | |
129 | (values (list x y z) (- x 1) (+ y 1) (+ z 2))) | |
130 | 10 0 20 30)) | |
131 | ||
132 | (pass-if-equal "3 seeds, zero len" | |
133 | '#() | |
134 | (vector-unfold values 0 1 2 3)) | |
135 | ||
136 | (pass-if-error "3 seeds, negative len" | |
137 | (vector-unfold values -2 1 2 3))) | |
138 | ||
139 | ;; | |
140 | ;; vector-unfold-right | |
141 | ;; | |
142 | ||
143 | (with-test-prefix "vector-unfold-right" | |
144 | ||
145 | (pass-if-equal "no seeds, zero len" | |
146 | '#() | |
147 | (vector-unfold-right values 0)) | |
148 | ||
149 | (pass-if-error "no seeds, negative len" | |
150 | (vector-unfold-right values -1)) | |
151 | ||
152 | (pass-if-equal "1 seed" | |
153 | '#(9 8 7 6 5 4 3 2 1 0) | |
154 | (vector-unfold-right (lambda (i x) (values x (+ x 1))) 10 0)) | |
155 | ||
156 | (pass-if-equal "1 seed, zero len" | |
157 | '#() | |
158 | (vector-unfold-right values 0 1)) | |
159 | ||
160 | (pass-if-error "1 seed, negative len" | |
161 | (vector-unfold-right values -1 1)) | |
162 | ||
163 | (pass-if-equal "1 seed, reverse vector" | |
164 | '#(e d c b a) | |
165 | (let ((vector '#(a b c d e))) | |
166 | (vector-unfold-right | |
167 | (lambda (i x) (values (vector-ref vector x) (+ x 1))) | |
168 | (vector-length vector) | |
169 | 0))) | |
170 | ||
171 | (pass-if-equal "2 seeds" | |
172 | '#((0 20) (-1 21) (-2 22) (-3 23) (-4 24) | |
173 | (-5 25) (-6 26) (-7 27) (-8 28) (-9 29)) | |
174 | (vector-unfold-right (lambda (i x y) (values (list x y) (+ x 1) (- y 1))) | |
175 | 10 -9 29)) | |
176 | ||
177 | (pass-if-equal "2 seeds, zero len" | |
178 | '#() | |
179 | (vector-unfold-right values 0 1 2)) | |
180 | ||
181 | (pass-if-error "2 seeds, negative len" | |
182 | (vector-unfold-right values -1 1 2)) | |
183 | ||
184 | (pass-if-equal "3 seeds" | |
185 | '#((0 20 30) (-1 21 32) (-2 22 34) (-3 23 36) (-4 24 38) | |
186 | (-5 25 40) (-6 26 42) (-7 27 44) (-8 28 46) (-9 29 48)) | |
187 | (vector-unfold-right (lambda (i x y z) | |
188 | (values (list x y z) (+ x 1) (- y 1) (- z 2))) | |
189 | 10 -9 29 48)) | |
190 | ||
191 | (pass-if-equal "3 seeds, zero len" | |
192 | '#() | |
193 | (vector-unfold-right values 0 1 2 3)) | |
194 | ||
195 | (pass-if-error "3 seeds, negative len" | |
196 | (vector-unfold-right values -1 1 2 3))) | |
197 | ||
198 | ;; | |
199 | ;; vector-copy | |
200 | ;; | |
201 | ||
202 | (with-test-prefix "vector-copy" | |
203 | ||
204 | (pass-if-equal "1 arg" | |
205 | '#(a b c d e f g h i) | |
206 | (vector-copy '#(a b c d e f g h i))) | |
207 | ||
208 | (pass-if-equal "2 args" | |
209 | '#(g h i) | |
210 | (vector-copy '#(a b c d e f g h i) 6)) | |
211 | ||
212 | (pass-if-equal "3 args" | |
213 | '#(d e f) | |
214 | (vector-copy '#(a b c d e f g h i) 3 6)) | |
215 | ||
216 | (pass-if-equal "4 args" | |
217 | '#(g h i x x x) | |
218 | (vector-copy '#(a b c d e f g h i) 6 12 'x)) | |
219 | ||
220 | (pass-if-equal "3 args, empty range" | |
221 | '#() | |
222 | (vector-copy '#(a b c d e f g h i) 6 6)) | |
223 | ||
224 | (pass-if-error "3 args, invalid range" | |
225 | (vector-copy '#(a b c d e f g h i) 4 2))) | |
226 | ||
227 | ;; | |
228 | ;; vector-reverse-copy | |
229 | ;; | |
230 | ||
231 | (with-test-prefix "vector-reverse-copy" | |
232 | ||
233 | (pass-if-equal "1 arg" | |
234 | '#(e d c b a) | |
235 | (vector-reverse-copy '#(a b c d e))) | |
236 | ||
237 | (pass-if-equal "2 args" | |
238 | '#(e d c) | |
239 | (vector-reverse-copy '#(a b c d e) 2)) | |
240 | ||
241 | (pass-if-equal "3 args" | |
242 | '#(d c b) | |
243 | (vector-reverse-copy '#(a b c d e) 1 4)) | |
244 | ||
245 | (pass-if-equal "3 args, empty result" | |
246 | '#() | |
247 | (vector-reverse-copy '#(a b c d e) 1 1)) | |
248 | ||
249 | (pass-if-error "2 args, invalid range" | |
250 | (vector-reverse-copy '#(a b c d e) 2 1))) | |
251 | ||
252 | ;; | |
253 | ;; vector-append | |
254 | ;; | |
255 | ||
256 | (with-test-prefix "vector-append" | |
257 | ||
258 | (pass-if-equal "no args" | |
259 | '#() | |
260 | (vector-append)) | |
261 | ||
262 | (pass-if-equal "1 arg" | |
263 | '(#(1 2) #f) | |
264 | (let* ((v (vector 1 2)) | |
265 | (v-copy (vector-append v))) | |
266 | (list v-copy (eq? v v-copy)))) | |
267 | ||
268 | (pass-if-equal "2 args" | |
269 | '#(x y) | |
270 | (vector-append '#(x) '#(y))) | |
271 | ||
272 | (pass-if-equal "3 args" | |
273 | '#(x y x y x y) | |
274 | (let ((v '#(x y))) | |
275 | (vector-append v v v))) | |
276 | ||
277 | (pass-if-equal "3 args with empty vector" | |
278 | '#(x y) | |
279 | (vector-append '#(x) '#() '#(y))) | |
280 | ||
281 | (pass-if-error "3 args with non-vectors" | |
282 | (vector-append '#() 'b 'c))) | |
283 | ||
284 | ;; | |
285 | ;; vector-concatenate | |
286 | ;; | |
287 | ||
288 | (with-test-prefix "vector-concatenate" | |
289 | ||
290 | (pass-if-equal "2 vectors" | |
291 | '#(a b c d) | |
292 | (vector-concatenate '(#(a b) #(c d)))) | |
293 | ||
294 | (pass-if-equal "no vectors" | |
295 | '#() | |
296 | (vector-concatenate '())) | |
297 | ||
298 | (pass-if-error "non-vector in list" | |
299 | (vector-concatenate '(#(a b) c)))) | |
300 | ||
301 | ;;; | |
302 | ;;; Predicates | |
303 | ;;; | |
304 | ||
305 | ;; | |
306 | ;; vector? | |
307 | ;; | |
308 | ||
309 | (with-test-prefix "vector?" | |
310 | (pass-if "empty vector" (vector? '#())) | |
311 | (pass-if "simple" (vector? '#(a b))) | |
312 | (pass-if "list" (not (vector? '(a b)))) | |
313 | (pass-if "symbol" (not (vector? 'a)))) | |
314 | ||
315 | ;; | |
316 | ;; vector-empty? | |
317 | ;; | |
318 | ||
319 | (with-test-prefix "vector-empty?" | |
320 | (pass-if "empty vector" (vector-empty? '#())) | |
321 | (pass-if "singleton vector" (not (vector-empty? '#(a)))) | |
322 | (pass-if-error "non-vector" (vector-empty 'a))) | |
323 | ||
324 | ;; | |
325 | ;; vector= | |
326 | ;; | |
327 | ||
328 | (with-test-prefix "vector=" | |
329 | ||
330 | (pass-if "2 equal vectors" | |
331 | (vector= eq? '#(a b c d) '#(a b c d))) | |
332 | ||
333 | (pass-if "3 equal vectors" | |
334 | (vector= eq? '#(a b c d) '#(a b c d) '#(a b c d))) | |
335 | ||
336 | (pass-if "2 empty vectors" | |
337 | (vector= eq? '#() '#())) | |
338 | ||
339 | (pass-if "no vectors" | |
340 | (vector= eq?)) | |
341 | ||
342 | (pass-if "1 vector" | |
343 | (vector= eq? '#(a))) | |
344 | ||
345 | (pass-if "2 unequal vectors of equal length" | |
346 | (not (vector= eq? '#(a b c d) '#(a b d c)))) | |
347 | ||
348 | (pass-if "3 unequal vectors of equal length" | |
349 | (not (vector= eq? '#(a b c d) '#(a b c d) '#(a b d c)))) | |
350 | ||
351 | (pass-if "2 vectors of unequal length" | |
352 | (not (vector= eq? '#(a b c) '#(a b c d)))) | |
353 | ||
354 | (pass-if "3 vectors of unequal length" | |
355 | (not (vector= eq? '#(a b c d) '#(a b c d) '#(a b c)))) | |
356 | ||
357 | (pass-if "2 vectors: empty, non-empty" | |
358 | (not (vector= eq? '#() '#(a b d c)))) | |
359 | ||
360 | (pass-if "2 vectors: non-empty, empty" | |
361 | (not (vector= eq? '#(a b d c) '#()))) | |
362 | ||
363 | (pass-if "2 equal vectors, elt= is equal?" | |
364 | (vector= equal? '#("a" "b" "c") '#("a" "b" "c"))) | |
365 | ||
366 | (pass-if "2 equal vectors, elt= is =" | |
367 | (vector= = '#(1/2 1/3 1/4 1/5) '#(1/2 1/3 1/4 1/5))) | |
368 | ||
369 | (pass-if-error "vector and list" | |
370 | (vector= equal? '#("a" "b" "c") '("a" "b" "c"))) | |
371 | ||
372 | (pass-if-error "non-procedure" | |
373 | (vector= 1 '#("a" "b" "c") '("a" "b" "c")))) | |
374 | ||
375 | ;;; | |
376 | ;;; Selectors | |
377 | ;;; | |
378 | ||
379 | ;; | |
380 | ;; vector-ref | |
381 | ;; | |
382 | ||
383 | (with-test-prefix "vector-ref" | |
384 | (pass-if-equal "simple 0" 'a (vector-ref '#(a b c) 0)) | |
385 | (pass-if-equal "simple 1" 'b (vector-ref '#(a b c) 1)) | |
386 | (pass-if-equal "simple 2" 'c (vector-ref '#(a b c) 2)) | |
387 | (pass-if-error "negative index" (vector-ref '#(a b c) -1)) | |
388 | (pass-if-error "index beyond end" (vector-ref '#(a b c) 3)) | |
389 | (pass-if-error "empty vector" (vector-ref '#() 0)) | |
390 | (pass-if-error "non-vector" (vector-ref '(a b c) 0)) | |
391 | (pass-if-error "inexact index" (vector-ref '#(a b c) 1.0))) | |
392 | ||
393 | ;; | |
394 | ;; vector-length | |
395 | ;; | |
396 | ||
397 | (with-test-prefix "vector-length" | |
398 | (pass-if-equal "empty vector" 0 (vector-length '#())) | |
399 | (pass-if-equal "simple" 3 (vector-length '#(a b c))) | |
400 | (pass-if-error "non-vector" (vector-length '(a b c)))) | |
401 | ||
402 | ;;; | |
403 | ;;; Iteration | |
404 | ;;; | |
405 | ||
406 | ;; | |
407 | ;; vector-fold | |
408 | ;; | |
409 | ||
410 | (with-test-prefix "vector-fold" | |
411 | ||
412 | (pass-if-equal "1 vector" | |
413 | 10 | |
414 | (vector-fold (lambda (i seed val) (+ seed val)) | |
415 | 0 | |
416 | '#(0 1 2 3 4))) | |
417 | ||
418 | (pass-if-equal "1 empty vector" | |
419 | 'a | |
420 | (vector-fold (lambda (i seed val) (+ seed val)) | |
421 | 'a | |
422 | '#())) | |
423 | ||
424 | (pass-if-equal "1 vector, use index" | |
425 | 30 | |
426 | (vector-fold (lambda (i seed val) (+ seed (* i val))) | |
427 | 0 | |
428 | '#(0 1 2 3 4))) | |
429 | ||
430 | (pass-if-equal "2 vectors, unequal lengths" | |
431 | '(1 -7 1 -1) | |
432 | (vector-fold (lambda (i seed x y) (cons (- x y) seed)) | |
433 | '() | |
434 | '#(6 1 2 3 4) '#(7 0 9 2))) | |
435 | ||
436 | (pass-if-equal "3 vectors, unequal lengths" | |
437 | '(51 33 31 19) | |
438 | (vector-fold (lambda (i seed x y z) (cons (- x y z) seed)) | |
439 | '() | |
440 | '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70))) | |
441 | ||
442 | (pass-if-error "5 args, non-vector" | |
443 | (vector-fold (lambda (i seed x y z) (cons (- x y z) seed)) | |
444 | '() | |
445 | '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70))) | |
446 | ||
447 | (pass-if-error "non-procedure" | |
448 | (vector-fold 1 '() '#(6 1 2 3 4) '#(7 0 9 2)))) | |
449 | ||
450 | ;; | |
451 | ;; vector-fold-right | |
452 | ;; | |
453 | ||
454 | (with-test-prefix "vector-fold-right" | |
455 | ||
456 | (pass-if-equal "1 vector" | |
457 | '((0 . a) (1 . b) (2 . c) (3 . d) (4 . e)) | |
458 | (vector-fold-right (lambda (i seed val) (cons (cons i val) seed)) | |
459 | '() | |
460 | '#(a b c d e))) | |
461 | ||
462 | (pass-if-equal "2 vectors, unequal lengths" | |
463 | '(-1 1 -7 1) | |
464 | (vector-fold-right (lambda (i seed x y) (cons (- x y) seed)) | |
465 | '() | |
466 | '#(6 1 2 3 7) '#(7 0 9 2))) | |
467 | ||
468 | (pass-if-equal "3 vectors, unequal lengths" | |
469 | '(19 31 33 51) | |
470 | (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed)) | |
471 | '() | |
472 | '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70))) | |
473 | ||
474 | (pass-if-error "5 args, non-vector" | |
475 | (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed)) | |
476 | '() | |
477 | '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70))) | |
478 | ||
479 | (pass-if-error "non-procedure" | |
480 | (vector-fold-right 1 '() '#(6 1 2 3 4) '#(7 0 9 2)))) | |
481 | ||
482 | ;; | |
483 | ;; vector-map | |
484 | ;; | |
485 | ||
486 | (with-test-prefix "vector-map" | |
487 | ||
488 | (pass-if-equal "1 vector" | |
489 | '#((0 . a) (1 . b) (2 . c) (3 . d) (4 . e)) | |
490 | (vector-map cons '#(a b c d e))) | |
491 | ||
492 | (pass-if-equal "1 empty vector" | |
493 | '#() | |
494 | (vector-map cons '#())) | |
495 | ||
496 | (pass-if-equal "2 vectors, unequal lengths" | |
497 | '#(5 8 11 14) | |
498 | (vector-map + '#(0 1 2 3 4) '#(5 6 7 8))) | |
499 | ||
500 | (pass-if-equal "3 vectors, unequal lengths" | |
501 | '#(15 28 41 54) | |
502 | (vector-map + '#(0 1 2 3 4) '#(5 6 7 8) '#(10 20 30 40 50 60))) | |
503 | ||
504 | (pass-if-error "4 args, non-vector" | |
505 | (vector-map + '#(0 1 2 3 4) '(5 6 7 8) '#(10 20 30 40 50 60))) | |
506 | ||
507 | (pass-if-error "3 args, non-vector" | |
508 | (vector-map + '#(0 1 2 3 4) '(5 6 7 8))) | |
509 | ||
510 | (pass-if-error "non-procedure" | |
511 | (vector-map #f '#(0 1 2 3 4) '#(5 6 7 8) '#(10 20 30 40 50 60)))) | |
512 | ||
513 | ;; | |
514 | ;; vector-map! | |
515 | ;; | |
516 | ||
517 | (with-test-prefix "vector-map!" | |
518 | ||
519 | (pass-if-equal "1 vector" | |
520 | '#(0 1 4 9 16) | |
521 | (let ((v (vector 0 1 2 3 4))) | |
522 | (vector-map! * v) | |
523 | v)) | |
524 | ||
525 | (pass-if-equal "1 empty vector" | |
526 | '#() | |
527 | (let ((v (vector))) | |
528 | (vector-map! * v) | |
529 | v)) | |
530 | ||
531 | (pass-if-equal "2 vectors, unequal lengths" | |
532 | '#(5 8 11 14 4) | |
533 | (let ((v (vector 0 1 2 3 4))) | |
534 | (vector-map! + v '#(5 6 7 8)) | |
535 | v)) | |
536 | ||
537 | (pass-if-equal "3 vectors, unequal lengths" | |
538 | '#(15 28 41 54 4) | |
539 | (let ((v (vector 0 1 2 3 4))) | |
540 | (vector-map! + v '#(5 6 7 8) '#(10 20 30 40 50 60)) | |
541 | v)) | |
542 | ||
543 | (pass-if-error "non-vector" | |
544 | (let ((v (vector 0 1 2 3 4))) | |
545 | (vector-map! + v '#(5 6 7 8) '(10 20 30 40 50 60)) | |
546 | v)) | |
547 | ||
548 | (pass-if-error "non-procedure" | |
549 | (let ((v (vector 0 1 2 3 4))) | |
550 | (vector-map! '(1 . 2) v '#(5 6 7 8) '#(10 20 30 40 50 60)) | |
551 | v))) | |
552 | ||
553 | ;; | |
554 | ;; vector-for-each | |
555 | ;; | |
556 | ||
557 | (with-test-prefix "vector-for-each" | |
558 | ||
559 | (pass-if-equal "1 vector" | |
560 | '(4 6 6 4 0) | |
561 | (let ((lst '())) | |
562 | (vector-for-each (lambda (i x) | |
563 | (set! lst (cons (* i x) lst))) | |
564 | '#(5 4 3 2 1)) | |
565 | lst)) | |
566 | ||
567 | (pass-if-equal "1 empty vector" | |
568 | '() | |
569 | (let ((lst '())) | |
570 | (vector-for-each (lambda (i x) | |
571 | (set! lst (cons (* i x) lst))) | |
572 | '#()) | |
573 | lst)) | |
574 | ||
575 | (pass-if-equal "2 vectors, unequal lengths" | |
576 | '(13 11 7 2) | |
577 | (let ((lst '())) | |
578 | (vector-for-each (lambda (i x y) | |
579 | (set! lst (cons (+ (* i x) y) lst))) | |
580 | '#(5 4 3 2 1) | |
581 | '#(2 3 5 7)) | |
582 | lst)) | |
583 | ||
584 | (pass-if-equal "3 vectors, unequal lengths" | |
585 | '(-6 -6 -6 -9) | |
586 | (let ((lst '())) | |
587 | (vector-for-each (lambda (i x y z) | |
588 | (set! lst (cons (+ (* i x) (- y z)) lst))) | |
589 | '#(5 4 3 2 1) | |
590 | '#(2 3 5 7) | |
591 | '#(11 13 17 19 23 29)) | |
592 | lst)) | |
593 | ||
594 | (pass-if-error "non-vector" | |
595 | (let ((lst '())) | |
596 | (vector-for-each (lambda (i x y z) | |
597 | (set! lst (cons (+ (* i x) (- y z)) lst))) | |
598 | '#(5 4 3 2 1) | |
599 | '(2 3 5 7) | |
600 | '#(11 13 17 19 23 29)) | |
601 | lst)) | |
602 | ||
603 | (pass-if-error "non-procedure" | |
604 | (let ((lst '())) | |
605 | (vector-for-each '#(not a procedure) | |
606 | '#(5 4 3 2 1) | |
607 | '#(2 3 5 7) | |
608 | '#(11 13 17 19 23 29)) | |
609 | lst))) | |
610 | ||
611 | ;; | |
612 | ;; vector-count | |
613 | ;; | |
614 | ||
615 | (with-test-prefix "vector-count" | |
616 | ||
617 | (pass-if-equal "1 vector" | |
618 | 3 | |
619 | (vector-count (lambda (i x) (even? (+ i x))) '#(2 3 5 7 11))) | |
620 | ||
621 | (pass-if-equal "1 empty vector" | |
622 | 0 | |
623 | (vector-count values '#())) | |
624 | ||
625 | (pass-if-equal "2 vectors, unequal lengths" | |
626 | 3 | |
627 | (vector-count (lambda (i x y) (< x (* i y))) | |
628 | '#(8 2 7 8 9 1 0) | |
629 | '#(7 6 4 3 1))) | |
630 | ||
631 | (pass-if-equal "3 vectors, unequal lengths" | |
632 | 2 | |
633 | (vector-count (lambda (i x y z) (<= x (- y i) z)) | |
634 | '#(3 6 3 0 2 4 1) | |
635 | '#(8 7 4 4 9) | |
636 | '#(7 6 8 3 1 7 9))) | |
637 | ||
638 | (pass-if-error "non-vector" | |
639 | (vector-count (lambda (i x y z) (<= x (- y i) z)) | |
640 | '#(3 6 3 0 2 4 1) | |
641 | '#(8 7 4 4 9) | |
642 | '(7 6 8 3 1 7 9))) | |
643 | ||
644 | (pass-if-error "non-procedure" | |
645 | (vector-count '(1 2) | |
646 | '#(3 6 3 0 2 4 1) | |
647 | '#(8 7 4 4 9) | |
648 | '#(7 6 8 3 1 7 9)))) | |
649 | ||
650 | ;;; | |
651 | ;;; Searching | |
652 | ;;; | |
653 | ||
654 | ;; | |
655 | ;; vector-index | |
656 | ;; | |
657 | ||
658 | (with-test-prefix "vector-index" | |
659 | ||
660 | (pass-if-equal "1 vector" | |
661 | 2 | |
662 | (vector-index even? '#(3 1 4 1 6 9))) | |
663 | ||
664 | (pass-if-equal "2 vectors, unequal lengths, success" | |
665 | 1 | |
666 | (vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
667 | ||
668 | (pass-if-equal "2 vectors, unequal lengths, failure" | |
669 | #f | |
670 | (vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
671 | ||
672 | (pass-if-error "non-procedure" | |
673 | (vector-index 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
674 | ||
675 | (pass-if-error "3 args, non-vector" | |
676 | (vector-index = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) | |
677 | ||
678 | (pass-if-error "4 args, non-vector" | |
679 | (vector-index = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) | |
680 | ||
681 | (pass-if-equal "3 vectors, unequal lengths, success" | |
682 | 1 | |
683 | (vector-index < | |
684 | '#(3 1 4 1 5 9 2 5 6) | |
685 | '#(2 6 1 7 2) | |
686 | '#(2 7 1 8))) | |
687 | ||
688 | (pass-if-equal "3 vectors, unequal lengths, failure" | |
689 | #f | |
690 | (vector-index < | |
691 | '#(3 1 4 1 5 9 2 5 6) | |
692 | '#(2 7 1 7 2) | |
693 | '#(2 7 1 7))) | |
694 | ||
695 | (pass-if-equal "empty vector" | |
696 | #f | |
697 | (vector-index < '#() '#(2 7 1 8 2)))) | |
698 | ||
699 | ;; | |
700 | ;; vector-index-right | |
701 | ;; | |
702 | ||
703 | (with-test-prefix "vector-index-right" | |
704 | ||
705 | (pass-if-equal "1 vector" | |
706 | 4 | |
707 | (vector-index-right even? '#(3 1 4 1 6 9))) | |
708 | ||
709 | (pass-if-equal "2 vectors, unequal lengths, success" | |
710 | 3 | |
711 | (vector-index-right < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
712 | ||
713 | (pass-if-equal "2 vectors, unequal lengths, failure" | |
714 | #f | |
715 | (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
716 | ||
717 | (pass-if-error "non-procedure" | |
718 | (vector-index-right 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
719 | ||
720 | (pass-if-error "3 args, non-vector" | |
721 | (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) | |
722 | ||
723 | (pass-if-error "4 args, non-vector" | |
724 | (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) | |
725 | ||
726 | (pass-if-equal "3 vectors, unequal lengths, success" | |
727 | 3 | |
728 | (vector-index-right < | |
729 | '#(3 1 4 1 5 9 2 5 6) | |
730 | '#(2 6 1 7 2) | |
731 | '#(2 7 1 8))) | |
732 | ||
733 | (pass-if-equal "3 vectors, unequal lengths, failure" | |
734 | #f | |
735 | (vector-index-right < | |
736 | '#(3 1 4 1 5 9 2 5 6) | |
737 | '#(2 7 1 7 2) | |
738 | '#(2 7 1 7))) | |
739 | ||
740 | (pass-if-equal "empty vector" | |
741 | #f | |
742 | (vector-index-right < '#() '#(2 7 1 8 2)))) | |
743 | ||
744 | ;; | |
745 | ;; vector-skip | |
746 | ;; | |
747 | ||
748 | (with-test-prefix "vector-skip" | |
749 | ||
750 | (pass-if-equal "1 vector" | |
751 | 2 | |
752 | (vector-skip odd? '#(3 1 4 1 6 9))) | |
753 | ||
754 | (pass-if-equal "2 vectors, unequal lengths, success" | |
755 | 1 | |
756 | (vector-skip >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
757 | ||
758 | (pass-if-equal "2 vectors, unequal lengths, failure" | |
759 | #f | |
760 | (vector-skip (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
761 | ||
762 | (pass-if-error "non-procedure" | |
763 | (vector-skip 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
764 | ||
765 | (pass-if-error "3 args, non-vector" | |
766 | (vector-skip = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) | |
767 | ||
768 | (pass-if-error "4 args, non-vector" | |
769 | (vector-skip = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) | |
770 | ||
771 | (pass-if-equal "3 vectors, unequal lengths, success" | |
772 | 1 | |
773 | (vector-skip (negate <) | |
774 | '#(3 1 4 1 5 9 2 5 6) | |
775 | '#(2 6 1 7 2) | |
776 | '#(2 7 1 8))) | |
777 | ||
778 | (pass-if-equal "3 vectors, unequal lengths, failure" | |
779 | #f | |
780 | (vector-skip (negate <) | |
781 | '#(3 1 4 1 5 9 2 5 6) | |
782 | '#(2 7 1 7 2) | |
783 | '#(2 7 1 7))) | |
784 | ||
785 | (pass-if-equal "empty vector" | |
786 | #f | |
787 | (vector-skip (negate <) '#() '#(2 7 1 8 2)))) | |
788 | ||
789 | ;; | |
790 | ;; vector-skip-right | |
791 | ;; | |
792 | ||
793 | (with-test-prefix "vector-skip-right" | |
794 | ||
795 | (pass-if-equal "1 vector" | |
796 | 4 | |
797 | (vector-skip-right odd? '#(3 1 4 1 6 9))) | |
798 | ||
799 | (pass-if-equal "2 vectors, unequal lengths, success" | |
800 | 3 | |
801 | (vector-skip-right >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
802 | ||
803 | (pass-if-equal "2 vectors, unequal lengths, failure" | |
804 | #f | |
805 | (vector-skip-right (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
806 | ||
807 | (pass-if-error "non-procedure" | |
808 | (vector-skip-right 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) | |
809 | ||
810 | (pass-if-error "3 args, non-vector" | |
811 | (vector-skip-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) | |
812 | ||
813 | (pass-if-error "4 args, non-vector" | |
814 | (vector-skip-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) | |
815 | ||
816 | (pass-if-equal "3 vectors, unequal lengths, success" | |
817 | 3 | |
818 | (vector-skip-right (negate <) | |
819 | '#(3 1 4 1 5 9 2 5 6) | |
820 | '#(2 6 1 7 2) | |
821 | '#(2 7 1 8))) | |
822 | ||
823 | (pass-if-equal "3 vectors, unequal lengths, failure" | |
824 | #f | |
825 | (vector-skip-right (negate <) | |
826 | '#(3 1 4 1 5 9 2 5 6) | |
827 | '#(2 7 1 7 2) | |
828 | '#(2 7 1 7))) | |
829 | ||
830 | (pass-if-equal "empty vector" | |
831 | #f | |
832 | (vector-skip-right (negate <) '#() '#(2 7 1 8 2)))) | |
833 | ||
834 | ;; | |
835 | ;; vector-binary-search | |
836 | ;; | |
837 | ||
838 | (with-test-prefix "vector-binary-search" | |
839 | ||
840 | (define (char-cmp c1 c2) | |
841 | (cond ((char<? c1 c2) -1) | |
842 | ((char=? c1 c2) 0) | |
843 | (else 1))) | |
844 | ||
845 | (pass-if-equal "success" | |
846 | 6 | |
847 | (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h) | |
848 | #\g | |
849 | char-cmp)) | |
850 | ||
851 | (pass-if-equal "failure" | |
852 | #f | |
853 | (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g) | |
854 | #\q | |
855 | char-cmp)) | |
856 | ||
857 | (pass-if-equal "singleton vector, success" | |
858 | 0 | |
859 | (vector-binary-search '#(#\a) | |
860 | #\a | |
861 | char-cmp)) | |
862 | ||
863 | (pass-if-equal "empty vector" | |
864 | #f | |
865 | (vector-binary-search '#() | |
866 | #\a | |
867 | char-cmp)) | |
868 | ||
869 | (pass-if-error "first element" | |
870 | (vector-binary-search '(#\a #\b #\c) | |
871 | #\a | |
872 | char-cmp)) | |
873 | ||
874 | (pass-if-equal "specify range, success" | |
875 | 3 | |
876 | (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h) | |
877 | #\d | |
878 | char-cmp | |
879 | 2 6)) | |
880 | ||
881 | (pass-if-equal "specify range, failure" | |
882 | #f | |
883 | (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h) | |
884 | #\g | |
885 | char-cmp | |
886 | 2 6))) | |
887 | ||
888 | ;; | |
889 | ;; vector-any | |
890 | ;; | |
891 | ||
892 | (with-test-prefix "vector-any" | |
893 | ||
894 | (pass-if-equal "1 vector, success" | |
895 | #t | |
896 | (vector-any even? '#(3 1 4 1 5 9 2))) | |
897 | ||
898 | (pass-if-equal "1 vector, failure" | |
899 | #f | |
900 | (vector-any even? '#(3 1 5 1 5 9 1))) | |
901 | ||
902 | (pass-if-equal "1 vector, left-to-right" | |
903 | #t | |
904 | (vector-any even? '#(3 1 4 1 5 #f 2))) | |
905 | ||
906 | (pass-if-equal "1 vector, left-to-right" | |
907 | 4 | |
908 | (vector-any (lambda (x) (and (even? x) x)) | |
909 | '#(3 1 4 1 5 #f 2))) | |
910 | ||
911 | (pass-if-equal "1 empty vector" | |
912 | #f | |
913 | (vector-any even? '#())) | |
914 | ||
915 | (pass-if-equal "2 vectors, unequal lengths, success" | |
916 | '(1 2) | |
917 | (vector-any (lambda (x y) (and (< x y) (list x y))) | |
918 | '#(3 1 4 1 5 #f) | |
919 | '#(1 0 1 2 3))) | |
920 | ||
921 | (pass-if-equal "2 vectors, unequal lengths, failure" | |
922 | #f | |
923 | (vector-any < '#(3 1 4 1 5 #f) '#(1 0 1 0 3))) | |
924 | ||
925 | (pass-if-equal "3 vectors, unequal lengths, success" | |
926 | '(1 2 3) | |
927 | (vector-any (lambda (x y z) (and (< x y z) (list x y z))) | |
928 | '#(3 1 4 1 3 #f) | |
929 | '#(1 0 1 2 4) | |
930 | '#(2 1 6 3 5))) | |
931 | ||
932 | (pass-if-equal "3 vectors, unequal lengths, failure" | |
933 | #f | |
934 | (vector-any < | |
935 | '#(3 1 4 1 5 #f) | |
936 | '#(1 0 3 2) | |
937 | '#(2 1 6 2 3)))) | |
938 | ||
939 | ;; | |
940 | ;; vector-every | |
941 | ;; | |
942 | ||
943 | (with-test-prefix "vector-every" | |
944 | ||
945 | (pass-if-equal "1 vector, failure" | |
946 | #f | |
947 | (vector-every odd? '#(3 1 4 1 5 9 2))) | |
948 | ||
949 | (pass-if-equal "1 vector, success" | |
950 | 11 | |
951 | (vector-every (lambda (x) (and (odd? x) x)) | |
952 | '#(3 5 7 1 5 9 11))) | |
953 | ||
954 | (pass-if-equal "1 vector, left-to-right, failure" | |
955 | #f | |
956 | (vector-every odd? '#(3 1 4 1 5 #f 2))) | |
957 | ||
958 | (pass-if-equal "1 empty vector" | |
959 | #t | |
960 | (vector-every even? '#())) | |
961 | ||
962 | (pass-if-equal "2 vectors, unequal lengths, left-to-right, failure" | |
963 | #f | |
964 | (vector-every >= '#(3 1 4 1 5) '#(1 0 1 2 3 #f))) | |
965 | ||
966 | (pass-if-equal "2 vectors, unequal lengths, left-to-right, success" | |
967 | '(5 3) | |
968 | (vector-every (lambda (x y) (and (>= x y) (list x y))) | |
969 | '#(3 1 4 1 5) | |
970 | '#(1 0 1 0 3 #f))) | |
971 | ||
972 | (pass-if-equal "3 vectors, unequal lengths, left-to-right, failure" | |
973 | #f | |
974 | (vector-every >= | |
975 | '#(3 1 4 1 5) | |
976 | '#(1 0 1 2 3 #f) | |
977 | '#(0 0 1 2))) | |
978 | ||
979 | (pass-if-equal "3 vectors, unequal lengths, left-to-right, success" | |
980 | '(8 5 4) | |
981 | (vector-every (lambda (x y z) (and (>= x y z) (list x y z))) | |
982 | '#(3 5 4 8 5) | |
983 | '#(2 3 4 5 3 #f) | |
984 | '#(1 2 3 4)))) | |
985 | ||
986 | ;;; | |
987 | ;;; Mutators | |
988 | ;;; | |
989 | ||
990 | ;; | |
991 | ;; vector-set! | |
992 | ;; | |
993 | ||
994 | (with-test-prefix "vector-set!" | |
995 | ||
996 | (pass-if-equal "simple" | |
997 | '#(0 a 2) | |
998 | (let ((v (vector 0 1 2))) | |
999 | (vector-set! v 1 'a) | |
1000 | v)) | |
1001 | ||
1002 | (pass-if-error "index beyond end" (vector-set! (vector 0 1 2) 3 'a)) | |
1003 | (pass-if-error "negative index" (vector-set! (vector 0 1 2) -1 'a)) | |
1004 | (pass-if-error "empty vector" (vector-set! (vector) 0 'a))) | |
1005 | ||
1006 | ;; | |
1007 | ;; vector-swap! | |
1008 | ;; | |
1009 | ||
1010 | (with-test-prefix "vector-swap!" | |
1011 | ||
1012 | (pass-if-equal "simple" | |
1013 | '#(b a c) | |
1014 | (let ((v (vector 'a 'b 'c))) | |
1015 | (vector-swap! v 0 1) | |
1016 | v)) | |
1017 | ||
1018 | (pass-if-equal "same index" | |
1019 | '#(a b c) | |
1020 | (let ((v (vector 'a 'b 'c))) | |
1021 | (vector-swap! v 1 1) | |
1022 | v)) | |
1023 | ||
1024 | (pass-if-error "index beyond end" (vector-swap! (vector 'a 'b 'c) 0 3)) | |
1025 | (pass-if-error "negative index" (vector-swap! (vector 'a 'b 'c) -1 1)) | |
1026 | (pass-if-error "empty vector" (vector-swap! (vector) 0 0))) | |
1027 | ||
1028 | ;; | |
1029 | ;; vector-fill! | |
1030 | ;; | |
1031 | ||
1032 | (with-test-prefix "vector-fill!" | |
1033 | ||
1034 | (pass-if-equal "2 args" | |
1035 | '#(z z z z z) | |
1036 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1037 | (vector-fill! v 'z) | |
1038 | v)) | |
1039 | ||
1040 | (pass-if-equal "3 args" | |
1041 | '#(a b z z z) | |
1042 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1043 | (vector-fill! v 'z 2) | |
1044 | v)) | |
1045 | ||
1046 | (pass-if-equal "4 args" | |
1047 | '#(a z z d e) | |
1048 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1049 | (vector-fill! v 'z 1 3) | |
1050 | v)) | |
1051 | ||
1052 | (pass-if-equal "4 args, entire vector" | |
1053 | '#(z z z z z) | |
1054 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1055 | (vector-fill! v 'z 0 5) | |
1056 | v)) | |
1057 | ||
1058 | (pass-if-equal "4 args, empty range" | |
1059 | '#(a b c d e) | |
1060 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1061 | (vector-fill! v 'z 2 2) | |
1062 | v)) | |
1063 | ||
1064 | (pass-if-error "index beyond end" (vector-fill! (vector 'a 'b 'c) 'z 0 4)) | |
1065 | (pass-if-error "invalid range" (vector-fill! (vector 'a 'b 'c) 'z 2 1)) | |
1066 | (pass-if-error "negative index" (vector-fill! (vector 'a 'b 'c) 'z -1 1)) | |
1067 | ||
1068 | ;; This is intentionally allowed in Guile, as an extension: | |
1069 | ;;(pass-if-error "vector-fill! e3" (vector-fill! (vector) 'z 0 0)) | |
1070 | ) | |
1071 | ||
1072 | ;; | |
1073 | ;; vector-reverse! | |
1074 | ;; | |
1075 | ||
1076 | (with-test-prefix "vector-reverse!" | |
1077 | ||
1078 | (pass-if-equal "1 arg" | |
1079 | '#(e d c b a) | |
1080 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1081 | (vector-reverse! v) | |
1082 | v)) | |
1083 | ||
1084 | (pass-if-equal "2 args" | |
1085 | '#(a b f e d c) | |
1086 | (let ((v (vector 'a 'b 'c 'd 'e 'f))) | |
1087 | (vector-reverse! v 2) | |
1088 | v)) | |
1089 | ||
1090 | (pass-if-equal "3 args" | |
1091 | '#(a d c b e f) | |
1092 | (let ((v (vector 'a 'b 'c 'd 'e 'f))) | |
1093 | (vector-reverse! v 1 4) | |
1094 | v)) | |
1095 | ||
1096 | (pass-if-equal "3 args, empty range" | |
1097 | '#(a b c d e f) | |
1098 | (let ((v (vector 'a 'b 'c 'd 'e 'f))) | |
1099 | (vector-reverse! v 3 3) | |
1100 | v)) | |
1101 | ||
1102 | (pass-if-equal "3 args, singleton range" | |
1103 | '#(a b c d e f) | |
1104 | (let ((v (vector 'a 'b 'c 'd 'e 'f))) | |
1105 | (vector-reverse! v 3 4) | |
1106 | v)) | |
1107 | ||
1108 | (pass-if-equal "empty vector" | |
1109 | '#() | |
1110 | (let ((v (vector))) | |
1111 | (vector-reverse! v) | |
1112 | v)) | |
1113 | ||
1114 | (pass-if-error "index beyond end" (vector-reverse! (vector 'a 'b) 0 3)) | |
1115 | (pass-if-error "invalid range" (vector-reverse! (vector 'a 'b) 2 1)) | |
1116 | (pass-if-error "negative index" (vector-reverse! (vector 'a 'b) -1 1)) | |
1117 | ||
1118 | ;; This is intentionally allowed in Guile, as an extension: | |
1119 | ;;(pass-if-error "vector-reverse! e3" (vector-reverse! (vector) 0 0)) | |
1120 | ) | |
1121 | ||
1122 | ;; | |
1123 | ;; vector-copy! | |
1124 | ;; | |
1125 | ||
1126 | (with-test-prefix "vector-copy!" | |
1127 | ||
1128 | (pass-if-equal "3 args, 0 tstart" | |
1129 | '#(1 2 3 d e) | |
1130 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1131 | (vector-copy! v 0 '#(1 2 3)) | |
1132 | v)) | |
1133 | ||
1134 | (pass-if-equal "3 args, 2 tstart" | |
1135 | '#(a b 1 2 3) | |
1136 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1137 | (vector-copy! v 2 '#(1 2 3)) | |
1138 | v)) | |
1139 | ||
1140 | (pass-if-equal "4 args" | |
1141 | '#(a b 2 3 e) | |
1142 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1143 | (vector-copy! v 2 '#(1 2 3) 1) | |
1144 | v)) | |
1145 | ||
1146 | (pass-if-equal "5 args" | |
1147 | '#(a b 3 4 5) | |
1148 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1149 | (vector-copy! v 2 '#(1 2 3 4 5) 2 5) | |
1150 | v)) | |
1151 | ||
1152 | (pass-if-equal "5 args, empty range" | |
1153 | '#(a b c d e) | |
1154 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1155 | (vector-copy! v 2 '#(1 2 3) 1 1) | |
1156 | v)) | |
1157 | ||
1158 | (pass-if-equal "overlapping source/target, moving right" | |
1159 | '#(b c c d e) | |
1160 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1161 | (vector-copy! v 0 v 1 3) | |
1162 | v)) | |
1163 | ||
1164 | (pass-if-equal "overlapping source/target, moving left" | |
1165 | '#(a b b c d) | |
1166 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1167 | (vector-copy! v 2 v 1 4) | |
1168 | v)) | |
1169 | ||
1170 | (pass-if-equal "overlapping source/target, not moving" | |
1171 | '#(a b c d e) | |
1172 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1173 | (vector-copy! v 0 v 0) | |
1174 | v)) | |
1175 | ||
1176 | (pass-if-error "tstart beyond end" | |
1177 | (vector-copy! (vector 1 2) 3 '#(1 2 3))) | |
1178 | (pass-if-error "would overwrite target end" | |
1179 | (vector-copy! (vector 1 2) 0 '#(1 2 3))) | |
1180 | (pass-if-error "would overwrite target end" | |
1181 | (vector-copy! (vector 1 2) 1 '#(1 2 3) 1))) | |
1182 | ||
1183 | ;; | |
1184 | ;; vector-reverse-copy! | |
1185 | ;; | |
1186 | ||
1187 | (with-test-prefix "vector-reverse-copy!" | |
1188 | ||
1189 | (pass-if-equal "3 args, 0 tstart" | |
1190 | '#(3 2 1 d e) | |
1191 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1192 | (vector-reverse-copy! v 0 '#(1 2 3)) | |
1193 | v)) | |
1194 | ||
1195 | (pass-if-equal "3 args, 2 tstart" | |
1196 | '#(a b 3 2 1) | |
1197 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1198 | (vector-reverse-copy! v 2 '#(1 2 3)) | |
1199 | v)) | |
1200 | ||
1201 | (pass-if-equal "4 args" | |
1202 | '#(a b 3 2 e) | |
1203 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1204 | (vector-reverse-copy! v 2 '#(1 2 3) 1) | |
1205 | v)) | |
1206 | ||
1207 | (pass-if-equal "5 args" | |
1208 | '#(a b 4 3 2) | |
1209 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1210 | (vector-reverse-copy! v 2 '#(1 2 3 4 5) 1 4) | |
1211 | v)) | |
1212 | ||
1213 | (pass-if-equal "5 args, empty range" | |
1214 | '#(a b c d e) | |
1215 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1216 | (vector-reverse-copy! v 2 '#(1 2 3 4 5) 2 2) | |
1217 | v)) | |
1218 | ||
1219 | (pass-if-equal "3 args, overlapping source/target" | |
1220 | '#(e d c b a) | |
1221 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1222 | (vector-reverse-copy! v 0 v) | |
1223 | v)) | |
1224 | ||
1225 | (pass-if-equal "5 args, overlapping source/target" | |
1226 | '#(b a c d e) | |
1227 | (let ((v (vector 'a 'b 'c 'd 'e))) | |
1228 | (vector-reverse-copy! v 0 v 0 2) | |
1229 | v)) | |
1230 | ||
1231 | (pass-if-error "3 args, would overwrite target end" | |
1232 | (vector-reverse-copy! (vector 'a 'b) 2 '#(a b))) | |
1233 | (pass-if-error "3 args, negative tstart" | |
1234 | (vector-reverse-copy! (vector 'a 'b) -1 '#(a b))) | |
1235 | (pass-if-error "3 args, would overwrite target end" | |
1236 | (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c))) | |
1237 | (pass-if-error "5 args, send beyond end" | |
1238 | (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 1 4)) | |
1239 | (pass-if-error "5 args, negative sstart" | |
1240 | (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) -1 2)) | |
1241 | (pass-if-error "5 args, invalid source range" | |
1242 | (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 2 1))) | |
1243 | ||
1244 | ;;; | |
1245 | ;;; Conversion | |
1246 | ;;; | |
1247 | ||
1248 | ;; | |
1249 | ;; vector->list | |
1250 | ;; | |
1251 | ||
1252 | (with-test-prefix "vector->list" | |
1253 | ||
1254 | (pass-if-equal "1 arg" | |
1255 | '(a b c) | |
1256 | (vector->list '#(a b c))) | |
1257 | ||
1258 | (pass-if-equal "2 args" | |
1259 | '(b c) | |
1260 | (vector->list '#(a b c) 1)) | |
1261 | ||
1262 | (pass-if-equal "3 args" | |
1263 | '(b c d) | |
1264 | (vector->list '#(a b c d e) 1 4)) | |
1265 | ||
1266 | (pass-if-equal "3 args, empty range" | |
1267 | '() | |
1268 | (vector->list '#(a b c d e) 1 1)) | |
1269 | ||
1270 | (pass-if-equal "1 arg, empty vector" | |
1271 | '() | |
1272 | (vector->list '#())) | |
1273 | ||
1274 | (pass-if-error "index beyond end" (vector->list '#(a b c) 1 6)) | |
1275 | (pass-if-error "negative index" (vector->list '#(a b c) -1 1)) | |
1276 | (pass-if-error "invalid range" (vector->list '#(a b c) 2 1))) | |
1277 | ||
1278 | ;; | |
1279 | ;; reverse-vector->list | |
1280 | ;; | |
1281 | ||
1282 | (with-test-prefix "reverse-vector->list" | |
1283 | ||
1284 | (pass-if-equal "1 arg" | |
1285 | '(c b a) | |
1286 | (reverse-vector->list '#(a b c))) | |
1287 | ||
1288 | (pass-if-equal "2 args" | |
1289 | '(c b) | |
1290 | (reverse-vector->list '#(a b c) 1)) | |
1291 | ||
1292 | (pass-if-equal "3 args" | |
1293 | '(d c b) | |
1294 | (reverse-vector->list '#(a b c d e) 1 4)) | |
1295 | ||
1296 | (pass-if-equal "3 args, empty range" | |
1297 | '() | |
1298 | (reverse-vector->list '#(a b c d e) 1 1)) | |
1299 | ||
1300 | (pass-if-equal "1 arg, empty vector" | |
1301 | '() | |
1302 | (reverse-vector->list '#())) | |
1303 | ||
1304 | (pass-if-error "index beyond end" (reverse-vector->list '#(a b c) 1 6)) | |
1305 | (pass-if-error "negative index" (reverse-vector->list '#(a b c) -1 1)) | |
1306 | (pass-if-error "invalid range" (reverse-vector->list '#(a b c) 2 1))) | |
1307 | ||
1308 | ;; | |
1309 | ;; list->vector | |
1310 | ;; | |
1311 | ||
1312 | (with-test-prefix "list->vector" | |
1313 | ||
1314 | (pass-if-equal "1 arg" | |
1315 | '#(a b c) | |
1316 | (list->vector '(a b c))) | |
1317 | ||
1318 | (pass-if-equal "1 empty list" | |
1319 | '#() | |
1320 | (list->vector '())) | |
1321 | ||
1322 | (pass-if-equal "2 args" | |
1323 | '#(2 3) | |
1324 | (list->vector '(0 1 2 3) 2)) | |
1325 | ||
1326 | (pass-if-equal "3 args" | |
1327 | '#(0 1) | |
1328 | (list->vector '(0 1 2 3) 0 2)) | |
1329 | ||
1330 | (pass-if-equal "3 args, empty range" | |
1331 | '#() | |
1332 | (list->vector '(0 1 2 3) 2 2)) | |
1333 | ||
1334 | (pass-if-error "index beyond end" (list->vector '(0 1 2 3) 0 5)) | |
1335 | (pass-if-error "negative index" (list->vector '(0 1 2 3) -1 1)) | |
1336 | (pass-if-error "invalid range" (list->vector '(0 1 2 3) 2 1))) | |
1337 | ||
1338 | ;; | |
1339 | ;; reverse-list->vector | |
1340 | ;; | |
1341 | ||
1342 | (with-test-prefix "reverse-list->vector" | |
1343 | ||
1344 | (pass-if-equal "1 arg" | |
1345 | '#(c b a) | |
1346 | (reverse-list->vector '(a b c))) | |
1347 | ||
1348 | (pass-if-equal "1 empty list" | |
1349 | '#() | |
1350 | (reverse-list->vector '())) | |
1351 | ||
1352 | (pass-if-equal "2 args" | |
1353 | '#(3 2) | |
1354 | (reverse-list->vector '(0 1 2 3) 2)) | |
1355 | ||
1356 | (pass-if-equal "3 args" | |
1357 | '#(1 0) | |
1358 | (reverse-list->vector '(0 1 2 3) 0 2)) | |
1359 | ||
1360 | (pass-if-equal "3 args, empty range" | |
1361 | '#() | |
1362 | (reverse-list->vector '(0 1 2 3) 2 2)) | |
1363 | ||
1364 | (pass-if-error "index beyond end" | |
1365 | (reverse-list->vector '(0 1 2 3) 0 5)) | |
1366 | ||
1367 | (pass-if-error "negative index" | |
1368 | (reverse-list->vector '(0 1 2 3) -1 1)) | |
1369 | ||
1370 | (pass-if-error "invalid range" | |
1371 | (reverse-list->vector '(0 1 2 3) 2 1))) | |
1372 | ||
1373 | ;;; Local Variables: | |
1374 | ;;; eval: (put 'pass-if-error 'scheme-indent-function 1) | |
1375 | ;;; End: |