1 ;;;; srfi-43.test --- test suite for SRFI-43 Vector library -*- scheme -*-
3 ;;;; Copyright (C) 2014 Free Software Foundation, Inc.
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.
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.
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
20 ;;; Originally written by Shiro Kawai and placed in the public domain
23 ;;; Many tests added, and adapted for Guile's (test-suite lib)
24 ;;; by Mark H Weaver <mhw@netris.org>, Jan 2014.
27 (define-module (test-suite test-srfi-43)
28 #:use-module (srfi srfi-43)
29 #:use-module (test-suite lib))
31 (define-syntax-rule (pass-if-error name body0 body ...)
34 (lambda () body0 body ... #f)
35 (lambda (key . args) #t))))
45 (with-test-prefix "make-vector"
47 (pass-if-equal "simple, no init"
49 (vector-length (make-vector 5)))
51 (pass-if-equal "empty"
55 (pass-if-error "negative length"
58 (pass-if-equal "simple with init"
62 (pass-if-equal "empty with init"
66 (pass-if-error "negative length"
73 (with-test-prefix "vector"
75 (pass-if-equal "no args"
79 (pass-if-equal "simple"
87 (with-test-prefix "vector-unfold"
89 (pass-if-equal "no seeds"
90 '#(0 1 2 3 4 5 6 7 8 9)
91 (vector-unfold values 10))
93 (pass-if-equal "no seeds, zero len"
95 (vector-unfold values 0))
97 (pass-if-error "no seeds, negative len"
98 (vector-unfold values -1))
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)))
105 (pass-if-equal "1 seed, zero len"
107 (vector-unfold values 0 1))
109 (pass-if-error "1 seed, negative len"
110 (vector-unfold values -2 1))
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)))
118 (pass-if-equal "2 seeds, zero len"
120 (vector-unfold values 0 1 2))
122 (pass-if-error "2 seeds, negative len"
123 (vector-unfold values -2 1 2))
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)))
132 (pass-if-equal "3 seeds, zero len"
134 (vector-unfold values 0 1 2 3))
136 (pass-if-error "3 seeds, negative len"
137 (vector-unfold values -2 1 2 3)))
140 ;; vector-unfold-right
143 (with-test-prefix "vector-unfold-right"
145 (pass-if-equal "no seeds, zero len"
147 (vector-unfold-right values 0))
149 (pass-if-error "no seeds, negative len"
150 (vector-unfold-right values -1))
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))
156 (pass-if-equal "1 seed, zero len"
158 (vector-unfold-right values 0 1))
160 (pass-if-error "1 seed, negative len"
161 (vector-unfold-right values -1 1))
163 (pass-if-equal "1 seed, reverse vector"
165 (let ((vector '#(a b c d e)))
167 (lambda (i x) (values (vector-ref vector x) (+ x 1)))
168 (vector-length vector)
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)))
177 (pass-if-equal "2 seeds, zero len"
179 (vector-unfold-right values 0 1 2))
181 (pass-if-error "2 seeds, negative len"
182 (vector-unfold-right values -1 1 2))
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)))
191 (pass-if-equal "3 seeds, zero len"
193 (vector-unfold-right values 0 1 2 3))
195 (pass-if-error "3 seeds, negative len"
196 (vector-unfold-right values -1 1 2 3)))
202 (with-test-prefix "vector-copy"
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)))
208 (pass-if-equal "2 args"
210 (vector-copy '#(a b c d e f g h i) 6))
212 (pass-if-equal "3 args"
214 (vector-copy '#(a b c d e f g h i) 3 6))
216 (pass-if-equal "4 args"
218 (vector-copy '#(a b c d e f g h i) 6 12 'x))
220 (pass-if-equal "3 args, empty range"
222 (vector-copy '#(a b c d e f g h i) 6 6))
224 (pass-if-error "3 args, invalid range"
225 (vector-copy '#(a b c d e f g h i) 4 2)))
228 ;; vector-reverse-copy
231 (with-test-prefix "vector-reverse-copy"
233 (pass-if-equal "1 arg"
235 (vector-reverse-copy '#(a b c d e)))
237 (pass-if-equal "2 args"
239 (vector-reverse-copy '#(a b c d e) 2))
241 (pass-if-equal "3 args"
243 (vector-reverse-copy '#(a b c d e) 1 4))
245 (pass-if-equal "3 args, empty result"
247 (vector-reverse-copy '#(a b c d e) 1 1))
249 (pass-if-error "2 args, invalid range"
250 (vector-reverse-copy '#(a b c d e) 2 1)))
256 (with-test-prefix "vector-append"
258 (pass-if-equal "no args"
262 (pass-if-equal "1 arg"
264 (let* ((v (vector 1 2))
265 (v-copy (vector-append v)))
266 (list v-copy (eq? v v-copy))))
268 (pass-if-equal "2 args"
270 (vector-append '#(x) '#(y)))
272 (pass-if-equal "3 args"
275 (vector-append v v v)))
277 (pass-if-equal "3 args with empty vector"
279 (vector-append '#(x) '#() '#(y)))
281 (pass-if-error "3 args with non-vectors"
282 (vector-append '#() 'b 'c)))
285 ;; vector-concatenate
288 (with-test-prefix "vector-concatenate"
290 (pass-if-equal "2 vectors"
292 (vector-concatenate '(#(a b) #(c d))))
294 (pass-if-equal "no vectors"
296 (vector-concatenate '()))
298 (pass-if-error "non-vector in list"
299 (vector-concatenate '(#(a b) c))))
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))))
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)))
328 (with-test-prefix "vector="
330 (pass-if "2 equal vectors"
331 (vector= eq? '#(a b c d) '#(a b c d)))
333 (pass-if "3 equal vectors"
334 (vector= eq? '#(a b c d) '#(a b c d) '#(a b c d)))
336 (pass-if "2 empty vectors"
337 (vector= eq? '#() '#()))
339 (pass-if "no vectors"
345 (pass-if "2 unequal vectors of equal length"
346 (not (vector= eq? '#(a b c d) '#(a b d c))))
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))))
351 (pass-if "2 vectors of unequal length"
352 (not (vector= eq? '#(a b c) '#(a b c d))))
354 (pass-if "3 vectors of unequal length"
355 (not (vector= eq? '#(a b c d) '#(a b c d) '#(a b c))))
357 (pass-if "2 vectors: empty, non-empty"
358 (not (vector= eq? '#() '#(a b d c))))
360 (pass-if "2 vectors: non-empty, empty"
361 (not (vector= eq? '#(a b d c) '#())))
363 (pass-if "2 equal vectors, elt= is equal?"
364 (vector= equal? '#("a" "b" "c") '#("a" "b" "c")))
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)))
369 (pass-if-error "vector and list"
370 (vector= equal? '#("a" "b" "c") '("a" "b" "c")))
372 (pass-if-error "non-procedure"
373 (vector= 1 '#("a" "b" "c") '("a" "b" "c"))))
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)))
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))))
410 (with-test-prefix "vector-fold"
412 (pass-if-equal "1 vector"
414 (vector-fold (lambda (i seed val) (+ seed val))
418 (pass-if-equal "1 empty vector"
420 (vector-fold (lambda (i seed val) (+ seed val))
424 (pass-if-equal "1 vector, use index"
426 (vector-fold (lambda (i seed val) (+ seed (* i val)))
430 (pass-if-equal "2 vectors, unequal lengths"
432 (vector-fold (lambda (i seed x y) (cons (- x y) seed))
434 '#(6 1 2 3 4) '#(7 0 9 2)))
436 (pass-if-equal "3 vectors, unequal lengths"
438 (vector-fold (lambda (i seed x y z) (cons (- x y z) seed))
440 '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70)))
442 (pass-if-error "5 args, non-vector"
443 (vector-fold (lambda (i seed x y z) (cons (- x y z) seed))
445 '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70)))
447 (pass-if-error "non-procedure"
448 (vector-fold 1 '() '#(6 1 2 3 4) '#(7 0 9 2))))
454 (with-test-prefix "vector-fold-right"
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))
462 (pass-if-equal "2 vectors, unequal lengths"
464 (vector-fold-right (lambda (i seed x y) (cons (- x y) seed))
466 '#(6 1 2 3 7) '#(7 0 9 2)))
468 (pass-if-equal "3 vectors, unequal lengths"
470 (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed))
472 '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70)))
474 (pass-if-error "5 args, non-vector"
475 (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed))
477 '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70)))
479 (pass-if-error "non-procedure"
480 (vector-fold-right 1 '() '#(6 1 2 3 4) '#(7 0 9 2))))
486 (with-test-prefix "vector-map"
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)))
492 (pass-if-equal "1 empty vector"
494 (vector-map cons '#()))
496 (pass-if-equal "2 vectors, unequal lengths"
498 (vector-map + '#(0 1 2 3 4) '#(5 6 7 8)))
500 (pass-if-equal "3 vectors, unequal lengths"
502 (vector-map + '#(0 1 2 3 4) '#(5 6 7 8) '#(10 20 30 40 50 60)))
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)))
507 (pass-if-error "3 args, non-vector"
508 (vector-map + '#(0 1 2 3 4) '(5 6 7 8)))
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))))
517 (with-test-prefix "vector-map!"
519 (pass-if-equal "1 vector"
521 (let ((v (vector 0 1 2 3 4)))
525 (pass-if-equal "1 empty vector"
531 (pass-if-equal "2 vectors, unequal lengths"
533 (let ((v (vector 0 1 2 3 4)))
534 (vector-map! + v '#(5 6 7 8))
537 (pass-if-equal "3 vectors, unequal lengths"
539 (let ((v (vector 0 1 2 3 4)))
540 (vector-map! + v '#(5 6 7 8) '#(10 20 30 40 50 60))
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))
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))
557 (with-test-prefix "vector-for-each"
559 (pass-if-equal "1 vector"
562 (vector-for-each (lambda (i x)
563 (set! lst (cons (* i x) lst)))
567 (pass-if-equal "1 empty vector"
570 (vector-for-each (lambda (i x)
571 (set! lst (cons (* i x) lst)))
575 (pass-if-equal "2 vectors, unequal lengths"
578 (vector-for-each (lambda (i x y)
579 (set! lst (cons (+ (* i x) y) lst)))
584 (pass-if-equal "3 vectors, unequal lengths"
587 (vector-for-each (lambda (i x y z)
588 (set! lst (cons (+ (* i x) (- y z)) lst)))
591 '#(11 13 17 19 23 29))
594 (pass-if-error "non-vector"
596 (vector-for-each (lambda (i x y z)
597 (set! lst (cons (+ (* i x) (- y z)) lst)))
600 '#(11 13 17 19 23 29))
603 (pass-if-error "non-procedure"
605 (vector-for-each '#(not a procedure)
608 '#(11 13 17 19 23 29))
615 (with-test-prefix "vector-count"
617 (pass-if-equal "1 vector"
619 (vector-count (lambda (i x) (even? (+ i x))) '#(2 3 5 7 11)))
621 (pass-if-equal "1 empty vector"
623 (vector-count values '#()))
625 (pass-if-equal "2 vectors, unequal lengths"
627 (vector-count (lambda (i x y) (< x (* i y)))
631 (pass-if-equal "3 vectors, unequal lengths"
633 (vector-count (lambda (i x y z) (<= x (- y i) z))
638 (pass-if-error "non-vector"
639 (vector-count (lambda (i x y z) (<= x (- y i) z))
644 (pass-if-error "non-procedure"
658 (with-test-prefix "vector-index"
660 (pass-if-equal "1 vector"
662 (vector-index even? '#(3 1 4 1 6 9)))
664 (pass-if-equal "2 vectors, unequal lengths, success"
666 (vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
668 (pass-if-equal "2 vectors, unequal lengths, failure"
670 (vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
672 (pass-if-error "non-procedure"
673 (vector-index 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
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)))
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)))
681 (pass-if-equal "3 vectors, unequal lengths, success"
684 '#(3 1 4 1 5 9 2 5 6)
688 (pass-if-equal "3 vectors, unequal lengths, failure"
691 '#(3 1 4 1 5 9 2 5 6)
695 (pass-if-equal "empty vector"
697 (vector-index < '#() '#(2 7 1 8 2))))
700 ;; vector-index-right
703 (with-test-prefix "vector-index-right"
705 (pass-if-equal "1 vector"
707 (vector-index-right even? '#(3 1 4 1 6 9)))
709 (pass-if-equal "2 vectors, unequal lengths, success"
711 (vector-index-right < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
713 (pass-if-equal "2 vectors, unequal lengths, failure"
715 (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
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)))
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)))
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)))
726 (pass-if-equal "3 vectors, unequal lengths, success"
728 (vector-index-right <
729 '#(3 1 4 1 5 9 2 5 6)
733 (pass-if-equal "3 vectors, unequal lengths, failure"
735 (vector-index-right <
736 '#(3 1 4 1 5 9 2 5 6)
740 (pass-if-equal "empty vector"
742 (vector-index-right < '#() '#(2 7 1 8 2))))
748 (with-test-prefix "vector-skip"
750 (pass-if-equal "1 vector"
752 (vector-skip odd? '#(3 1 4 1 6 9)))
754 (pass-if-equal "2 vectors, unequal lengths, success"
756 (vector-skip >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
758 (pass-if-equal "2 vectors, unequal lengths, failure"
760 (vector-skip (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
762 (pass-if-error "non-procedure"
763 (vector-skip 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
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)))
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)))
771 (pass-if-equal "3 vectors, unequal lengths, success"
773 (vector-skip (negate <)
774 '#(3 1 4 1 5 9 2 5 6)
778 (pass-if-equal "3 vectors, unequal lengths, failure"
780 (vector-skip (negate <)
781 '#(3 1 4 1 5 9 2 5 6)
785 (pass-if-equal "empty vector"
787 (vector-skip (negate <) '#() '#(2 7 1 8 2))))
793 (with-test-prefix "vector-skip-right"
795 (pass-if-equal "1 vector"
797 (vector-skip-right odd? '#(3 1 4 1 6 9)))
799 (pass-if-equal "2 vectors, unequal lengths, success"
801 (vector-skip-right >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
803 (pass-if-equal "2 vectors, unequal lengths, failure"
805 (vector-skip-right (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2)))
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)))
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)))
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)))
816 (pass-if-equal "3 vectors, unequal lengths, success"
818 (vector-skip-right (negate <)
819 '#(3 1 4 1 5 9 2 5 6)
823 (pass-if-equal "3 vectors, unequal lengths, failure"
825 (vector-skip-right (negate <)
826 '#(3 1 4 1 5 9 2 5 6)
830 (pass-if-equal "empty vector"
832 (vector-skip-right (negate <) '#() '#(2 7 1 8 2))))
835 ;; vector-binary-search
838 (with-test-prefix "vector-binary-search"
840 (define (char-cmp c1 c2)
841 (cond ((char<? c1 c2) -1)
845 (pass-if-equal "success"
847 (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h)
851 (pass-if-equal "failure"
853 (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g)
857 (pass-if-equal "singleton vector, success"
859 (vector-binary-search '#(#\a)
863 (pass-if-equal "empty vector"
865 (vector-binary-search '#()
869 (pass-if-error "first element"
870 (vector-binary-search '(#\a #\b #\c)
874 (pass-if-equal "specify range, success"
876 (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h)
881 (pass-if-equal "specify range, failure"
883 (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h)
892 (with-test-prefix "vector-any"
894 (pass-if-equal "1 vector, success"
896 (vector-any even? '#(3 1 4 1 5 9 2)))
898 (pass-if-equal "1 vector, failure"
900 (vector-any even? '#(3 1 5 1 5 9 1)))
902 (pass-if-equal "1 vector, left-to-right"
904 (vector-any even? '#(3 1 4 1 5 #f 2)))
906 (pass-if-equal "1 vector, left-to-right"
908 (vector-any (lambda (x) (and (even? x) x))
911 (pass-if-equal "1 empty vector"
913 (vector-any even? '#()))
915 (pass-if-equal "2 vectors, unequal lengths, success"
917 (vector-any (lambda (x y) (and (< x y) (list x y)))
921 (pass-if-equal "2 vectors, unequal lengths, failure"
923 (vector-any < '#(3 1 4 1 5 #f) '#(1 0 1 0 3)))
925 (pass-if-equal "3 vectors, unequal lengths, success"
927 (vector-any (lambda (x y z) (and (< x y z) (list x y z)))
932 (pass-if-equal "3 vectors, unequal lengths, failure"
943 (with-test-prefix "vector-every"
945 (pass-if-equal "1 vector, failure"
947 (vector-every odd? '#(3 1 4 1 5 9 2)))
949 (pass-if-equal "1 vector, success"
951 (vector-every (lambda (x) (and (odd? x) x))
954 (pass-if-equal "1 vector, left-to-right, failure"
956 (vector-every odd? '#(3 1 4 1 5 #f 2)))
958 (pass-if-equal "1 empty vector"
960 (vector-every even? '#()))
962 (pass-if-equal "2 vectors, unequal lengths, left-to-right, failure"
964 (vector-every >= '#(3 1 4 1 5) '#(1 0 1 2 3 #f)))
966 (pass-if-equal "2 vectors, unequal lengths, left-to-right, success"
968 (vector-every (lambda (x y) (and (>= x y) (list x y)))
972 (pass-if-equal "3 vectors, unequal lengths, left-to-right, failure"
979 (pass-if-equal "3 vectors, unequal lengths, left-to-right, success"
981 (vector-every (lambda (x y z) (and (>= x y z) (list x y z)))
994 (with-test-prefix "vector-set!"
996 (pass-if-equal "simple"
998 (let ((v (vector 0 1 2)))
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)))
1010 (with-test-prefix "vector-swap!"
1012 (pass-if-equal "simple"
1014 (let ((v (vector 'a 'b 'c)))
1015 (vector-swap! v 0 1)
1018 (pass-if-equal "same index"
1020 (let ((v (vector 'a 'b 'c)))
1021 (vector-swap! v 1 1)
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)))
1032 (with-test-prefix "vector-fill!"
1034 (pass-if-equal "2 args"
1036 (let ((v (vector 'a 'b 'c 'd 'e)))
1040 (pass-if-equal "3 args"
1042 (let ((v (vector 'a 'b 'c 'd 'e)))
1043 (vector-fill! v 'z 2)
1046 (pass-if-equal "4 args"
1048 (let ((v (vector 'a 'b 'c 'd 'e)))
1049 (vector-fill! v 'z 1 3)
1052 (pass-if-equal "4 args, entire vector"
1054 (let ((v (vector 'a 'b 'c 'd 'e)))
1055 (vector-fill! v 'z 0 5)
1058 (pass-if-equal "4 args, empty range"
1060 (let ((v (vector 'a 'b 'c 'd 'e)))
1061 (vector-fill! v 'z 2 2)
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))
1068 ;; This is intentionally allowed in Guile, as an extension:
1069 ;;(pass-if-error "vector-fill! e3" (vector-fill! (vector) 'z 0 0))
1076 (with-test-prefix "vector-reverse!"
1078 (pass-if-equal "1 arg"
1080 (let ((v (vector 'a 'b 'c 'd 'e)))
1084 (pass-if-equal "2 args"
1086 (let ((v (vector 'a 'b 'c 'd 'e 'f)))
1087 (vector-reverse! v 2)
1090 (pass-if-equal "3 args"
1092 (let ((v (vector 'a 'b 'c 'd 'e 'f)))
1093 (vector-reverse! v 1 4)
1096 (pass-if-equal "3 args, empty range"
1098 (let ((v (vector 'a 'b 'c 'd 'e 'f)))
1099 (vector-reverse! v 3 3)
1102 (pass-if-equal "3 args, singleton range"
1104 (let ((v (vector 'a 'b 'c 'd 'e 'f)))
1105 (vector-reverse! v 3 4)
1108 (pass-if-equal "empty vector"
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))
1118 ;; This is intentionally allowed in Guile, as an extension:
1119 ;;(pass-if-error "vector-reverse! e3" (vector-reverse! (vector) 0 0))
1126 (with-test-prefix "vector-copy!"
1128 (pass-if-equal "3 args, 0 tstart"
1130 (let ((v (vector 'a 'b 'c 'd 'e)))
1131 (vector-copy! v 0 '#(1 2 3))
1134 (pass-if-equal "3 args, 2 tstart"
1136 (let ((v (vector 'a 'b 'c 'd 'e)))
1137 (vector-copy! v 2 '#(1 2 3))
1140 (pass-if-equal "4 args"
1142 (let ((v (vector 'a 'b 'c 'd 'e)))
1143 (vector-copy! v 2 '#(1 2 3) 1)
1146 (pass-if-equal "5 args"
1148 (let ((v (vector 'a 'b 'c 'd 'e)))
1149 (vector-copy! v 2 '#(1 2 3 4 5) 2 5)
1152 (pass-if-equal "5 args, empty range"
1154 (let ((v (vector 'a 'b 'c 'd 'e)))
1155 (vector-copy! v 2 '#(1 2 3) 1 1)
1158 (pass-if-equal "overlapping source/target, moving right"
1160 (let ((v (vector 'a 'b 'c 'd 'e)))
1161 (vector-copy! v 0 v 1 3)
1164 (pass-if-equal "overlapping source/target, moving left"
1166 (let ((v (vector 'a 'b 'c 'd 'e)))
1167 (vector-copy! v 2 v 1 4)
1170 (pass-if-equal "overlapping source/target, not moving"
1172 (let ((v (vector 'a 'b 'c 'd 'e)))
1173 (vector-copy! v 0 v 0)
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)))
1184 ;; vector-reverse-copy!
1187 (with-test-prefix "vector-reverse-copy!"
1189 (pass-if-equal "3 args, 0 tstart"
1191 (let ((v (vector 'a 'b 'c 'd 'e)))
1192 (vector-reverse-copy! v 0 '#(1 2 3))
1195 (pass-if-equal "3 args, 2 tstart"
1197 (let ((v (vector 'a 'b 'c 'd 'e)))
1198 (vector-reverse-copy! v 2 '#(1 2 3))
1201 (pass-if-equal "4 args"
1203 (let ((v (vector 'a 'b 'c 'd 'e)))
1204 (vector-reverse-copy! v 2 '#(1 2 3) 1)
1207 (pass-if-equal "5 args"
1209 (let ((v (vector 'a 'b 'c 'd 'e)))
1210 (vector-reverse-copy! v 2 '#(1 2 3 4 5) 1 4)
1213 (pass-if-equal "5 args, empty range"
1215 (let ((v (vector 'a 'b 'c 'd 'e)))
1216 (vector-reverse-copy! v 2 '#(1 2 3 4 5) 2 2)
1219 (pass-if-equal "3 args, overlapping source/target"
1221 (let ((v (vector 'a 'b 'c 'd 'e)))
1222 (vector-reverse-copy! v 0 v)
1225 (pass-if-equal "5 args, overlapping source/target"
1227 (let ((v (vector 'a 'b 'c 'd 'e)))
1228 (vector-reverse-copy! v 0 v 0 2)
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)))
1252 (with-test-prefix "vector->list"
1254 (pass-if-equal "1 arg"
1256 (vector->list '#(a b c)))
1258 (pass-if-equal "2 args"
1260 (vector->list '#(a b c) 1))
1262 (pass-if-equal "3 args"
1264 (vector->list '#(a b c d e) 1 4))
1266 (pass-if-equal "3 args, empty range"
1268 (vector->list '#(a b c d e) 1 1))
1270 (pass-if-equal "1 arg, empty vector"
1272 (vector->list '#()))
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)))
1279 ;; reverse-vector->list
1282 (with-test-prefix "reverse-vector->list"
1284 (pass-if-equal "1 arg"
1286 (reverse-vector->list '#(a b c)))
1288 (pass-if-equal "2 args"
1290 (reverse-vector->list '#(a b c) 1))
1292 (pass-if-equal "3 args"
1294 (reverse-vector->list '#(a b c d e) 1 4))
1296 (pass-if-equal "3 args, empty range"
1298 (reverse-vector->list '#(a b c d e) 1 1))
1300 (pass-if-equal "1 arg, empty vector"
1302 (reverse-vector->list '#()))
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)))
1312 (with-test-prefix "list->vector"
1314 (pass-if-equal "1 arg"
1316 (list->vector '(a b c)))
1318 (pass-if-equal "1 empty list"
1322 (pass-if-equal "2 args"
1324 (list->vector '(0 1 2 3) 2))
1326 (pass-if-equal "3 args"
1328 (list->vector '(0 1 2 3) 0 2))
1330 (pass-if-equal "3 args, empty range"
1332 (list->vector '(0 1 2 3) 2 2))
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)))
1339 ;; reverse-list->vector
1342 (with-test-prefix "reverse-list->vector"
1344 (pass-if-equal "1 arg"
1346 (reverse-list->vector '(a b c)))
1348 (pass-if-equal "1 empty list"
1350 (reverse-list->vector '()))
1352 (pass-if-equal "2 args"
1354 (reverse-list->vector '(0 1 2 3) 2))
1356 (pass-if-equal "3 args"
1358 (reverse-list->vector '(0 1 2 3) 0 2))
1360 (pass-if-equal "3 args, empty range"
1362 (reverse-list->vector '(0 1 2 3) 2 2))
1364 (pass-if-error "index beyond end"
1365 (reverse-list->vector '(0 1 2 3) 0 5))
1367 (pass-if-error "negative index"
1368 (reverse-list->vector '(0 1 2 3) -1 1))
1370 (pass-if-error "invalid range"
1371 (reverse-list->vector '(0 1 2 3) 2 1)))
1373 ;;; Local Variables:
1374 ;;; eval: (put 'pass-if-error 'scheme-indent-function 1)