diff options
Diffstat (limited to 'test-suite/tests/srfi-43.test')
-rw-r--r-- | test-suite/tests/srfi-43.test | 1375 |
1 files changed, 1375 insertions, 0 deletions
diff --git a/test-suite/tests/srfi-43.test b/test-suite/tests/srfi-43.test new file mode 100644 index 000000000..554843e75 --- /dev/null +++ b/test-suite/tests/srfi-43.test @@ -0,0 +1,1375 @@ +;;;; srfi-43.test --- test suite for SRFI-43 Vector library -*- scheme -*- +;;;; +;;;; Copyright (C) 2014 Free Software Foundation, Inc. +;;;; +;;;; This library is free software; you can redistribute it and/or +;;;; modify it under the terms of the GNU Lesser General Public +;;;; License as published by the Free Software Foundation; either +;;;; version 3 of the License, or (at your option) any later version. +;;;; +;;;; This library is distributed in the hope that it will be useful, +;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;;; Lesser General Public License for more details. +;;;; +;;;; You should have received a copy of the GNU Lesser General Public +;;;; License along with this library; if not, write to the Free Software +;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA + +;;; +;;; Originally written by Shiro Kawai and placed in the public domain +;;; 10/5/2005. +;;; +;;; Many tests added, and adapted for Guile's (test-suite lib) +;;; by Mark H Weaver <mhw@netris.org>, Jan 2014. +;;; + +(define-module (test-suite test-srfi-43) + #:use-module (srfi srfi-43) + #:use-module (test-suite lib)) + +(define-syntax-rule (pass-if-error name body0 body ...) + (pass-if name + (catch #t + (lambda () body0 body ... #f) + (lambda (key . args) #t)))) + +;;; +;;; Constructors +;;; + +;; +;; make-vector +;; + +(with-test-prefix "make-vector" + + (pass-if-equal "simple, no init" + 5 + (vector-length (make-vector 5))) + + (pass-if-equal "empty" + '#() + (make-vector 0)) + + (pass-if-error "negative length" + (make-vector -4)) + + (pass-if-equal "simple with init" + '#(3 3 3 3 3) + (make-vector 5 3)) + + (pass-if-equal "empty with init" + '#() + (make-vector 0 3)) + + (pass-if-error "negative length" + (make-vector -1 3))) + +;; +;; vector +;; + +(with-test-prefix "vector" + + (pass-if-equal "no args" + '#() + (vector)) + + (pass-if-equal "simple" + '#(1 2 3 4 5) + (vector 1 2 3 4 5))) + +;; +;; vector-unfold +;; + +(with-test-prefix "vector-unfold" + + (pass-if-equal "no seeds" + '#(0 1 2 3 4 5 6 7 8 9) + (vector-unfold values 10)) + + (pass-if-equal "no seeds, zero len" + '#() + (vector-unfold values 0)) + + (pass-if-error "no seeds, negative len" + (vector-unfold values -1)) + + (pass-if-equal "1 seed" + '#(0 -1 -2 -3 -4 -5 -6 -7 -8 -9) + (vector-unfold (lambda (i x) (values x (- x 1))) + 10 0)) + + (pass-if-equal "1 seed, zero len" + '#() + (vector-unfold values 0 1)) + + (pass-if-error "1 seed, negative len" + (vector-unfold values -2 1)) + + (pass-if-equal "2 seeds" + '#((0 20) (-1 21) (-2 22) (-3 23) (-4 24) + (-5 25) (-6 26) (-7 27) (-8 28) (-9 29)) + (vector-unfold (lambda (i x y) (values (list x y) (- x 1) (+ y 1))) + 10 0 20)) + + (pass-if-equal "2 seeds, zero len" + '#() + (vector-unfold values 0 1 2)) + + (pass-if-error "2 seeds, negative len" + (vector-unfold values -2 1 2)) + + (pass-if-equal "3 seeds" + '#((0 20 30) (-1 21 32) (-2 22 34) (-3 23 36) (-4 24 38) + (-5 25 40) (-6 26 42) (-7 27 44) (-8 28 46) (-9 29 48)) + (vector-unfold (lambda (i x y z) + (values (list x y z) (- x 1) (+ y 1) (+ z 2))) + 10 0 20 30)) + + (pass-if-equal "3 seeds, zero len" + '#() + (vector-unfold values 0 1 2 3)) + + (pass-if-error "3 seeds, negative len" + (vector-unfold values -2 1 2 3))) + +;; +;; vector-unfold-right +;; + +(with-test-prefix "vector-unfold-right" + + (pass-if-equal "no seeds, zero len" + '#() + (vector-unfold-right values 0)) + + (pass-if-error "no seeds, negative len" + (vector-unfold-right values -1)) + + (pass-if-equal "1 seed" + '#(9 8 7 6 5 4 3 2 1 0) + (vector-unfold-right (lambda (i x) (values x (+ x 1))) 10 0)) + + (pass-if-equal "1 seed, zero len" + '#() + (vector-unfold-right values 0 1)) + + (pass-if-error "1 seed, negative len" + (vector-unfold-right values -1 1)) + + (pass-if-equal "1 seed, reverse vector" + '#(e d c b a) + (let ((vector '#(a b c d e))) + (vector-unfold-right + (lambda (i x) (values (vector-ref vector x) (+ x 1))) + (vector-length vector) + 0))) + + (pass-if-equal "2 seeds" + '#((0 20) (-1 21) (-2 22) (-3 23) (-4 24) + (-5 25) (-6 26) (-7 27) (-8 28) (-9 29)) + (vector-unfold-right (lambda (i x y) (values (list x y) (+ x 1) (- y 1))) + 10 -9 29)) + + (pass-if-equal "2 seeds, zero len" + '#() + (vector-unfold-right values 0 1 2)) + + (pass-if-error "2 seeds, negative len" + (vector-unfold-right values -1 1 2)) + + (pass-if-equal "3 seeds" + '#((0 20 30) (-1 21 32) (-2 22 34) (-3 23 36) (-4 24 38) + (-5 25 40) (-6 26 42) (-7 27 44) (-8 28 46) (-9 29 48)) + (vector-unfold-right (lambda (i x y z) + (values (list x y z) (+ x 1) (- y 1) (- z 2))) + 10 -9 29 48)) + + (pass-if-equal "3 seeds, zero len" + '#() + (vector-unfold-right values 0 1 2 3)) + + (pass-if-error "3 seeds, negative len" + (vector-unfold-right values -1 1 2 3))) + +;; +;; vector-copy +;; + +(with-test-prefix "vector-copy" + + (pass-if-equal "1 arg" + '#(a b c d e f g h i) + (vector-copy '#(a b c d e f g h i))) + + (pass-if-equal "2 args" + '#(g h i) + (vector-copy '#(a b c d e f g h i) 6)) + + (pass-if-equal "3 args" + '#(d e f) + (vector-copy '#(a b c d e f g h i) 3 6)) + + (pass-if-equal "4 args" + '#(g h i x x x) + (vector-copy '#(a b c d e f g h i) 6 12 'x)) + + (pass-if-equal "3 args, empty range" + '#() + (vector-copy '#(a b c d e f g h i) 6 6)) + + (pass-if-error "3 args, invalid range" + (vector-copy '#(a b c d e f g h i) 4 2))) + +;; +;; vector-reverse-copy +;; + +(with-test-prefix "vector-reverse-copy" + + (pass-if-equal "1 arg" + '#(e d c b a) + (vector-reverse-copy '#(a b c d e))) + + (pass-if-equal "2 args" + '#(e d c) + (vector-reverse-copy '#(a b c d e) 2)) + + (pass-if-equal "3 args" + '#(d c b) + (vector-reverse-copy '#(a b c d e) 1 4)) + + (pass-if-equal "3 args, empty result" + '#() + (vector-reverse-copy '#(a b c d e) 1 1)) + + (pass-if-error "2 args, invalid range" + (vector-reverse-copy '#(a b c d e) 2 1))) + +;; +;; vector-append +;; + +(with-test-prefix "vector-append" + + (pass-if-equal "no args" + '#() + (vector-append)) + + (pass-if-equal "1 arg" + '(#(1 2) #f) + (let* ((v (vector 1 2)) + (v-copy (vector-append v))) + (list v-copy (eq? v v-copy)))) + + (pass-if-equal "2 args" + '#(x y) + (vector-append '#(x) '#(y))) + + (pass-if-equal "3 args" + '#(x y x y x y) + (let ((v '#(x y))) + (vector-append v v v))) + + (pass-if-equal "3 args with empty vector" + '#(x y) + (vector-append '#(x) '#() '#(y))) + + (pass-if-error "3 args with non-vectors" + (vector-append '#() 'b 'c))) + +;; +;; vector-concatenate +;; + +(with-test-prefix "vector-concatenate" + + (pass-if-equal "2 vectors" + '#(a b c d) + (vector-concatenate '(#(a b) #(c d)))) + + (pass-if-equal "no vectors" + '#() + (vector-concatenate '())) + + (pass-if-error "non-vector in list" + (vector-concatenate '(#(a b) c)))) + +;;; +;;; Predicates +;;; + +;; +;; vector? +;; + +(with-test-prefix "vector?" + (pass-if "empty vector" (vector? '#())) + (pass-if "simple" (vector? '#(a b))) + (pass-if "list" (not (vector? '(a b)))) + (pass-if "symbol" (not (vector? 'a)))) + +;; +;; vector-empty? +;; + +(with-test-prefix "vector-empty?" + (pass-if "empty vector" (vector-empty? '#())) + (pass-if "singleton vector" (not (vector-empty? '#(a)))) + (pass-if-error "non-vector" (vector-empty 'a))) + +;; +;; vector= +;; + +(with-test-prefix "vector=" + + (pass-if "2 equal vectors" + (vector= eq? '#(a b c d) '#(a b c d))) + + (pass-if "3 equal vectors" + (vector= eq? '#(a b c d) '#(a b c d) '#(a b c d))) + + (pass-if "2 empty vectors" + (vector= eq? '#() '#())) + + (pass-if "no vectors" + (vector= eq?)) + + (pass-if "1 vector" + (vector= eq? '#(a))) + + (pass-if "2 unequal vectors of equal length" + (not (vector= eq? '#(a b c d) '#(a b d c)))) + + (pass-if "3 unequal vectors of equal length" + (not (vector= eq? '#(a b c d) '#(a b c d) '#(a b d c)))) + + (pass-if "2 vectors of unequal length" + (not (vector= eq? '#(a b c) '#(a b c d)))) + + (pass-if "3 vectors of unequal length" + (not (vector= eq? '#(a b c d) '#(a b c d) '#(a b c)))) + + (pass-if "2 vectors: empty, non-empty" + (not (vector= eq? '#() '#(a b d c)))) + + (pass-if "2 vectors: non-empty, empty" + (not (vector= eq? '#(a b d c) '#()))) + + (pass-if "2 equal vectors, elt= is equal?" + (vector= equal? '#("a" "b" "c") '#("a" "b" "c"))) + + (pass-if "2 equal vectors, elt= is =" + (vector= = '#(1/2 1/3 1/4 1/5) '#(1/2 1/3 1/4 1/5))) + + (pass-if-error "vector and list" + (vector= equal? '#("a" "b" "c") '("a" "b" "c"))) + + (pass-if-error "non-procedure" + (vector= 1 '#("a" "b" "c") '("a" "b" "c")))) + +;;; +;;; Selectors +;;; + +;; +;; vector-ref +;; + +(with-test-prefix "vector-ref" + (pass-if-equal "simple 0" 'a (vector-ref '#(a b c) 0)) + (pass-if-equal "simple 1" 'b (vector-ref '#(a b c) 1)) + (pass-if-equal "simple 2" 'c (vector-ref '#(a b c) 2)) + (pass-if-error "negative index" (vector-ref '#(a b c) -1)) + (pass-if-error "index beyond end" (vector-ref '#(a b c) 3)) + (pass-if-error "empty vector" (vector-ref '#() 0)) + (pass-if-error "non-vector" (vector-ref '(a b c) 0)) + (pass-if-error "inexact index" (vector-ref '#(a b c) 1.0))) + +;; +;; vector-length +;; + +(with-test-prefix "vector-length" + (pass-if-equal "empty vector" 0 (vector-length '#())) + (pass-if-equal "simple" 3 (vector-length '#(a b c))) + (pass-if-error "non-vector" (vector-length '(a b c)))) + +;;; +;;; Iteration +;;; + +;; +;; vector-fold +;; + +(with-test-prefix "vector-fold" + + (pass-if-equal "1 vector" + 10 + (vector-fold (lambda (i seed val) (+ seed val)) + 0 + '#(0 1 2 3 4))) + + (pass-if-equal "1 empty vector" + 'a + (vector-fold (lambda (i seed val) (+ seed val)) + 'a + '#())) + + (pass-if-equal "1 vector, use index" + 30 + (vector-fold (lambda (i seed val) (+ seed (* i val))) + 0 + '#(0 1 2 3 4))) + + (pass-if-equal "2 vectors, unequal lengths" + '(1 -7 1 -1) + (vector-fold (lambda (i seed x y) (cons (- x y) seed)) + '() + '#(6 1 2 3 4) '#(7 0 9 2))) + + (pass-if-equal "3 vectors, unequal lengths" + '(51 33 31 19) + (vector-fold (lambda (i seed x y z) (cons (- x y z) seed)) + '() + '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70))) + + (pass-if-error "5 args, non-vector" + (vector-fold (lambda (i seed x y z) (cons (- x y z) seed)) + '() + '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70))) + + (pass-if-error "non-procedure" + (vector-fold 1 '() '#(6 1 2 3 4) '#(7 0 9 2)))) + +;; +;; vector-fold-right +;; + +(with-test-prefix "vector-fold-right" + + (pass-if-equal "1 vector" + '((0 . a) (1 . b) (2 . c) (3 . d) (4 . e)) + (vector-fold-right (lambda (i seed val) (cons (cons i val) seed)) + '() + '#(a b c d e))) + + (pass-if-equal "2 vectors, unequal lengths" + '(-1 1 -7 1) + (vector-fold-right (lambda (i seed x y) (cons (- x y) seed)) + '() + '#(6 1 2 3 7) '#(7 0 9 2))) + + (pass-if-equal "3 vectors, unequal lengths" + '(19 31 33 51) + (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed)) + '() + '#(6 1 2 3 4) '#(7 0 9 2) '#(-20 -30 -40 -50 -60 -70))) + + (pass-if-error "5 args, non-vector" + (vector-fold-right (lambda (i seed x y z) (cons (- x y z) seed)) + '() + '#(6 1 2 3 4) '#(7 0 9 2) '(-20 -30 -40 -50 -60 -70))) + + (pass-if-error "non-procedure" + (vector-fold-right 1 '() '#(6 1 2 3 4) '#(7 0 9 2)))) + +;; +;; vector-map +;; + +(with-test-prefix "vector-map" + + (pass-if-equal "1 vector" + '#((0 . a) (1 . b) (2 . c) (3 . d) (4 . e)) + (vector-map cons '#(a b c d e))) + + (pass-if-equal "1 empty vector" + '#() + (vector-map cons '#())) + + (pass-if-equal "2 vectors, unequal lengths" + '#(5 8 11 14) + (vector-map + '#(0 1 2 3 4) '#(5 6 7 8))) + + (pass-if-equal "3 vectors, unequal lengths" + '#(15 28 41 54) + (vector-map + '#(0 1 2 3 4) '#(5 6 7 8) '#(10 20 30 40 50 60))) + + (pass-if-error "4 args, non-vector" + (vector-map + '#(0 1 2 3 4) '(5 6 7 8) '#(10 20 30 40 50 60))) + + (pass-if-error "3 args, non-vector" + (vector-map + '#(0 1 2 3 4) '(5 6 7 8))) + + (pass-if-error "non-procedure" + (vector-map #f '#(0 1 2 3 4) '#(5 6 7 8) '#(10 20 30 40 50 60)))) + +;; +;; vector-map! +;; + +(with-test-prefix "vector-map!" + + (pass-if-equal "1 vector" + '#(0 1 4 9 16) + (let ((v (vector 0 1 2 3 4))) + (vector-map! * v) + v)) + + (pass-if-equal "1 empty vector" + '#() + (let ((v (vector))) + (vector-map! * v) + v)) + + (pass-if-equal "2 vectors, unequal lengths" + '#(5 8 11 14 4) + (let ((v (vector 0 1 2 3 4))) + (vector-map! + v '#(5 6 7 8)) + v)) + + (pass-if-equal "3 vectors, unequal lengths" + '#(15 28 41 54 4) + (let ((v (vector 0 1 2 3 4))) + (vector-map! + v '#(5 6 7 8) '#(10 20 30 40 50 60)) + v)) + + (pass-if-error "non-vector" + (let ((v (vector 0 1 2 3 4))) + (vector-map! + v '#(5 6 7 8) '(10 20 30 40 50 60)) + v)) + + (pass-if-error "non-procedure" + (let ((v (vector 0 1 2 3 4))) + (vector-map! '(1 . 2) v '#(5 6 7 8) '#(10 20 30 40 50 60)) + v))) + +;; +;; vector-for-each +;; + +(with-test-prefix "vector-for-each" + + (pass-if-equal "1 vector" + '(4 6 6 4 0) + (let ((lst '())) + (vector-for-each (lambda (i x) + (set! lst (cons (* i x) lst))) + '#(5 4 3 2 1)) + lst)) + + (pass-if-equal "1 empty vector" + '() + (let ((lst '())) + (vector-for-each (lambda (i x) + (set! lst (cons (* i x) lst))) + '#()) + lst)) + + (pass-if-equal "2 vectors, unequal lengths" + '(13 11 7 2) + (let ((lst '())) + (vector-for-each (lambda (i x y) + (set! lst (cons (+ (* i x) y) lst))) + '#(5 4 3 2 1) + '#(2 3 5 7)) + lst)) + + (pass-if-equal "3 vectors, unequal lengths" + '(-6 -6 -6 -9) + (let ((lst '())) + (vector-for-each (lambda (i x y z) + (set! lst (cons (+ (* i x) (- y z)) lst))) + '#(5 4 3 2 1) + '#(2 3 5 7) + '#(11 13 17 19 23 29)) + lst)) + + (pass-if-error "non-vector" + (let ((lst '())) + (vector-for-each (lambda (i x y z) + (set! lst (cons (+ (* i x) (- y z)) lst))) + '#(5 4 3 2 1) + '(2 3 5 7) + '#(11 13 17 19 23 29)) + lst)) + + (pass-if-error "non-procedure" + (let ((lst '())) + (vector-for-each '#(not a procedure) + '#(5 4 3 2 1) + '#(2 3 5 7) + '#(11 13 17 19 23 29)) + lst))) + +;; +;; vector-count +;; + +(with-test-prefix "vector-count" + + (pass-if-equal "1 vector" + 3 + (vector-count (lambda (i x) (even? (+ i x))) '#(2 3 5 7 11))) + + (pass-if-equal "1 empty vector" + 0 + (vector-count values '#())) + + (pass-if-equal "2 vectors, unequal lengths" + 3 + (vector-count (lambda (i x y) (< x (* i y))) + '#(8 2 7 8 9 1 0) + '#(7 6 4 3 1))) + + (pass-if-equal "3 vectors, unequal lengths" + 2 + (vector-count (lambda (i x y z) (<= x (- y i) z)) + '#(3 6 3 0 2 4 1) + '#(8 7 4 4 9) + '#(7 6 8 3 1 7 9))) + + (pass-if-error "non-vector" + (vector-count (lambda (i x y z) (<= x (- y i) z)) + '#(3 6 3 0 2 4 1) + '#(8 7 4 4 9) + '(7 6 8 3 1 7 9))) + + (pass-if-error "non-procedure" + (vector-count '(1 2) + '#(3 6 3 0 2 4 1) + '#(8 7 4 4 9) + '#(7 6 8 3 1 7 9)))) + +;;; +;;; Searching +;;; + +;; +;; vector-index +;; + +(with-test-prefix "vector-index" + + (pass-if-equal "1 vector" + 2 + (vector-index even? '#(3 1 4 1 6 9))) + + (pass-if-equal "2 vectors, unequal lengths, success" + 1 + (vector-index < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-equal "2 vectors, unequal lengths, failure" + #f + (vector-index = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-error "non-procedure" + (vector-index 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-error "3 args, non-vector" + (vector-index = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) + + (pass-if-error "4 args, non-vector" + (vector-index = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) + + (pass-if-equal "3 vectors, unequal lengths, success" + 1 + (vector-index < + '#(3 1 4 1 5 9 2 5 6) + '#(2 6 1 7 2) + '#(2 7 1 8))) + + (pass-if-equal "3 vectors, unequal lengths, failure" + #f + (vector-index < + '#(3 1 4 1 5 9 2 5 6) + '#(2 7 1 7 2) + '#(2 7 1 7))) + + (pass-if-equal "empty vector" + #f + (vector-index < '#() '#(2 7 1 8 2)))) + +;; +;; vector-index-right +;; + +(with-test-prefix "vector-index-right" + + (pass-if-equal "1 vector" + 4 + (vector-index-right even? '#(3 1 4 1 6 9))) + + (pass-if-equal "2 vectors, unequal lengths, success" + 3 + (vector-index-right < '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-equal "2 vectors, unequal lengths, failure" + #f + (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-error "non-procedure" + (vector-index-right 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-error "3 args, non-vector" + (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) + + (pass-if-error "4 args, non-vector" + (vector-index-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) + + (pass-if-equal "3 vectors, unequal lengths, success" + 3 + (vector-index-right < + '#(3 1 4 1 5 9 2 5 6) + '#(2 6 1 7 2) + '#(2 7 1 8))) + + (pass-if-equal "3 vectors, unequal lengths, failure" + #f + (vector-index-right < + '#(3 1 4 1 5 9 2 5 6) + '#(2 7 1 7 2) + '#(2 7 1 7))) + + (pass-if-equal "empty vector" + #f + (vector-index-right < '#() '#(2 7 1 8 2)))) + +;; +;; vector-skip +;; + +(with-test-prefix "vector-skip" + + (pass-if-equal "1 vector" + 2 + (vector-skip odd? '#(3 1 4 1 6 9))) + + (pass-if-equal "2 vectors, unequal lengths, success" + 1 + (vector-skip >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-equal "2 vectors, unequal lengths, failure" + #f + (vector-skip (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-error "non-procedure" + (vector-skip 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-error "3 args, non-vector" + (vector-skip = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) + + (pass-if-error "4 args, non-vector" + (vector-skip = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) + + (pass-if-equal "3 vectors, unequal lengths, success" + 1 + (vector-skip (negate <) + '#(3 1 4 1 5 9 2 5 6) + '#(2 6 1 7 2) + '#(2 7 1 8))) + + (pass-if-equal "3 vectors, unequal lengths, failure" + #f + (vector-skip (negate <) + '#(3 1 4 1 5 9 2 5 6) + '#(2 7 1 7 2) + '#(2 7 1 7))) + + (pass-if-equal "empty vector" + #f + (vector-skip (negate <) '#() '#(2 7 1 8 2)))) + +;; +;; vector-skip-right +;; + +(with-test-prefix "vector-skip-right" + + (pass-if-equal "1 vector" + 4 + (vector-skip-right odd? '#(3 1 4 1 6 9))) + + (pass-if-equal "2 vectors, unequal lengths, success" + 3 + (vector-skip-right >= '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-equal "2 vectors, unequal lengths, failure" + #f + (vector-skip-right (negate =) '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-error "non-procedure" + (vector-skip-right 1 '#(3 1 4 1 5 9 2 5 6) '#(2 7 1 8 2))) + + (pass-if-error "3 args, non-vector" + (vector-skip-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2))) + + (pass-if-error "4 args, non-vector" + (vector-skip-right = '#(3 1 4 1 5 9 2 5 6) '(2 7 1 8 2) '#(1 2 3))) + + (pass-if-equal "3 vectors, unequal lengths, success" + 3 + (vector-skip-right (negate <) + '#(3 1 4 1 5 9 2 5 6) + '#(2 6 1 7 2) + '#(2 7 1 8))) + + (pass-if-equal "3 vectors, unequal lengths, failure" + #f + (vector-skip-right (negate <) + '#(3 1 4 1 5 9 2 5 6) + '#(2 7 1 7 2) + '#(2 7 1 7))) + + (pass-if-equal "empty vector" + #f + (vector-skip-right (negate <) '#() '#(2 7 1 8 2)))) + +;; +;; vector-binary-search +;; + +(with-test-prefix "vector-binary-search" + + (define (char-cmp c1 c2) + (cond ((char<? c1 c2) -1) + ((char=? c1 c2) 0) + (else 1))) + + (pass-if-equal "success" + 6 + (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h) + #\g + char-cmp)) + + (pass-if-equal "failure" + #f + (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g) + #\q + char-cmp)) + + (pass-if-equal "singleton vector, success" + 0 + (vector-binary-search '#(#\a) + #\a + char-cmp)) + + (pass-if-equal "empty vector" + #f + (vector-binary-search '#() + #\a + char-cmp)) + + (pass-if-error "first element" + (vector-binary-search '(#\a #\b #\c) + #\a + char-cmp)) + + (pass-if-equal "specify range, success" + 3 + (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h) + #\d + char-cmp + 2 6)) + + (pass-if-equal "specify range, failure" + #f + (vector-binary-search '#(#\a #\b #\c #\d #\e #\f #\g #\h) + #\g + char-cmp + 2 6))) + +;; +;; vector-any +;; + +(with-test-prefix "vector-any" + + (pass-if-equal "1 vector, success" + #t + (vector-any even? '#(3 1 4 1 5 9 2))) + + (pass-if-equal "1 vector, failure" + #f + (vector-any even? '#(3 1 5 1 5 9 1))) + + (pass-if-equal "1 vector, left-to-right" + #t + (vector-any even? '#(3 1 4 1 5 #f 2))) + + (pass-if-equal "1 vector, left-to-right" + 4 + (vector-any (lambda (x) (and (even? x) x)) + '#(3 1 4 1 5 #f 2))) + + (pass-if-equal "1 empty vector" + #f + (vector-any even? '#())) + + (pass-if-equal "2 vectors, unequal lengths, success" + '(1 2) + (vector-any (lambda (x y) (and (< x y) (list x y))) + '#(3 1 4 1 5 #f) + '#(1 0 1 2 3))) + + (pass-if-equal "2 vectors, unequal lengths, failure" + #f + (vector-any < '#(3 1 4 1 5 #f) '#(1 0 1 0 3))) + + (pass-if-equal "3 vectors, unequal lengths, success" + '(1 2 3) + (vector-any (lambda (x y z) (and (< x y z) (list x y z))) + '#(3 1 4 1 3 #f) + '#(1 0 1 2 4) + '#(2 1 6 3 5))) + + (pass-if-equal "3 vectors, unequal lengths, failure" + #f + (vector-any < + '#(3 1 4 1 5 #f) + '#(1 0 3 2) + '#(2 1 6 2 3)))) + +;; +;; vector-every +;; + +(with-test-prefix "vector-every" + + (pass-if-equal "1 vector, failure" + #f + (vector-every odd? '#(3 1 4 1 5 9 2))) + + (pass-if-equal "1 vector, success" + 11 + (vector-every (lambda (x) (and (odd? x) x)) + '#(3 5 7 1 5 9 11))) + + (pass-if-equal "1 vector, left-to-right, failure" + #f + (vector-every odd? '#(3 1 4 1 5 #f 2))) + + (pass-if-equal "1 empty vector" + #t + (vector-every even? '#())) + + (pass-if-equal "2 vectors, unequal lengths, left-to-right, failure" + #f + (vector-every >= '#(3 1 4 1 5) '#(1 0 1 2 3 #f))) + + (pass-if-equal "2 vectors, unequal lengths, left-to-right, success" + '(5 3) + (vector-every (lambda (x y) (and (>= x y) (list x y))) + '#(3 1 4 1 5) + '#(1 0 1 0 3 #f))) + + (pass-if-equal "3 vectors, unequal lengths, left-to-right, failure" + #f + (vector-every >= + '#(3 1 4 1 5) + '#(1 0 1 2 3 #f) + '#(0 0 1 2))) + + (pass-if-equal "3 vectors, unequal lengths, left-to-right, success" + '(8 5 4) + (vector-every (lambda (x y z) (and (>= x y z) (list x y z))) + '#(3 5 4 8 5) + '#(2 3 4 5 3 #f) + '#(1 2 3 4)))) + +;;; +;;; Mutators +;;; + +;; +;; vector-set! +;; + +(with-test-prefix "vector-set!" + + (pass-if-equal "simple" + '#(0 a 2) + (let ((v (vector 0 1 2))) + (vector-set! v 1 'a) + v)) + + (pass-if-error "index beyond end" (vector-set! (vector 0 1 2) 3 'a)) + (pass-if-error "negative index" (vector-set! (vector 0 1 2) -1 'a)) + (pass-if-error "empty vector" (vector-set! (vector) 0 'a))) + +;; +;; vector-swap! +;; + +(with-test-prefix "vector-swap!" + + (pass-if-equal "simple" + '#(b a c) + (let ((v (vector 'a 'b 'c))) + (vector-swap! v 0 1) + v)) + + (pass-if-equal "same index" + '#(a b c) + (let ((v (vector 'a 'b 'c))) + (vector-swap! v 1 1) + v)) + + (pass-if-error "index beyond end" (vector-swap! (vector 'a 'b 'c) 0 3)) + (pass-if-error "negative index" (vector-swap! (vector 'a 'b 'c) -1 1)) + (pass-if-error "empty vector" (vector-swap! (vector) 0 0))) + +;; +;; vector-fill! +;; + +(with-test-prefix "vector-fill!" + + (pass-if-equal "2 args" + '#(z z z z z) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-fill! v 'z) + v)) + + (pass-if-equal "3 args" + '#(a b z z z) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-fill! v 'z 2) + v)) + + (pass-if-equal "4 args" + '#(a z z d e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-fill! v 'z 1 3) + v)) + + (pass-if-equal "4 args, entire vector" + '#(z z z z z) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-fill! v 'z 0 5) + v)) + + (pass-if-equal "4 args, empty range" + '#(a b c d e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-fill! v 'z 2 2) + v)) + + (pass-if-error "index beyond end" (vector-fill! (vector 'a 'b 'c) 'z 0 4)) + (pass-if-error "invalid range" (vector-fill! (vector 'a 'b 'c) 'z 2 1)) + (pass-if-error "negative index" (vector-fill! (vector 'a 'b 'c) 'z -1 1)) + + ;; This is intentionally allowed in Guile, as an extension: + ;;(pass-if-error "vector-fill! e3" (vector-fill! (vector) 'z 0 0)) + ) + +;; +;; vector-reverse! +;; + +(with-test-prefix "vector-reverse!" + + (pass-if-equal "1 arg" + '#(e d c b a) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-reverse! v) + v)) + + (pass-if-equal "2 args" + '#(a b f e d c) + (let ((v (vector 'a 'b 'c 'd 'e 'f))) + (vector-reverse! v 2) + v)) + + (pass-if-equal "3 args" + '#(a d c b e f) + (let ((v (vector 'a 'b 'c 'd 'e 'f))) + (vector-reverse! v 1 4) + v)) + + (pass-if-equal "3 args, empty range" + '#(a b c d e f) + (let ((v (vector 'a 'b 'c 'd 'e 'f))) + (vector-reverse! v 3 3) + v)) + + (pass-if-equal "3 args, singleton range" + '#(a b c d e f) + (let ((v (vector 'a 'b 'c 'd 'e 'f))) + (vector-reverse! v 3 4) + v)) + + (pass-if-equal "empty vector" + '#() + (let ((v (vector))) + (vector-reverse! v) + v)) + + (pass-if-error "index beyond end" (vector-reverse! (vector 'a 'b) 0 3)) + (pass-if-error "invalid range" (vector-reverse! (vector 'a 'b) 2 1)) + (pass-if-error "negative index" (vector-reverse! (vector 'a 'b) -1 1)) + + ;; This is intentionally allowed in Guile, as an extension: + ;;(pass-if-error "vector-reverse! e3" (vector-reverse! (vector) 0 0)) + ) + +;; +;; vector-copy! +;; + +(with-test-prefix "vector-copy!" + + (pass-if-equal "3 args, 0 tstart" + '#(1 2 3 d e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-copy! v 0 '#(1 2 3)) + v)) + + (pass-if-equal "3 args, 2 tstart" + '#(a b 1 2 3) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-copy! v 2 '#(1 2 3)) + v)) + + (pass-if-equal "4 args" + '#(a b 2 3 e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-copy! v 2 '#(1 2 3) 1) + v)) + + (pass-if-equal "5 args" + '#(a b 3 4 5) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-copy! v 2 '#(1 2 3 4 5) 2 5) + v)) + + (pass-if-equal "5 args, empty range" + '#(a b c d e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-copy! v 2 '#(1 2 3) 1 1) + v)) + + (pass-if-equal "overlapping source/target, moving right" + '#(b c c d e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-copy! v 0 v 1 3) + v)) + + (pass-if-equal "overlapping source/target, moving left" + '#(a b b c d) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-copy! v 2 v 1 4) + v)) + + (pass-if-equal "overlapping source/target, not moving" + '#(a b c d e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-copy! v 0 v 0) + v)) + + (pass-if-error "tstart beyond end" + (vector-copy! (vector 1 2) 3 '#(1 2 3))) + (pass-if-error "would overwrite target end" + (vector-copy! (vector 1 2) 0 '#(1 2 3))) + (pass-if-error "would overwrite target end" + (vector-copy! (vector 1 2) 1 '#(1 2 3) 1))) + +;; +;; vector-reverse-copy! +;; + +(with-test-prefix "vector-reverse-copy!" + + (pass-if-equal "3 args, 0 tstart" + '#(3 2 1 d e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-reverse-copy! v 0 '#(1 2 3)) + v)) + + (pass-if-equal "3 args, 2 tstart" + '#(a b 3 2 1) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-reverse-copy! v 2 '#(1 2 3)) + v)) + + (pass-if-equal "4 args" + '#(a b 3 2 e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-reverse-copy! v 2 '#(1 2 3) 1) + v)) + + (pass-if-equal "5 args" + '#(a b 4 3 2) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-reverse-copy! v 2 '#(1 2 3 4 5) 1 4) + v)) + + (pass-if-equal "5 args, empty range" + '#(a b c d e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-reverse-copy! v 2 '#(1 2 3 4 5) 2 2) + v)) + + (pass-if-equal "3 args, overlapping source/target" + '#(e d c b a) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-reverse-copy! v 0 v) + v)) + + (pass-if-equal "5 args, overlapping source/target" + '#(b a c d e) + (let ((v (vector 'a 'b 'c 'd 'e))) + (vector-reverse-copy! v 0 v 0 2) + v)) + + (pass-if-error "3 args, would overwrite target end" + (vector-reverse-copy! (vector 'a 'b) 2 '#(a b))) + (pass-if-error "3 args, negative tstart" + (vector-reverse-copy! (vector 'a 'b) -1 '#(a b))) + (pass-if-error "3 args, would overwrite target end" + (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c))) + (pass-if-error "5 args, send beyond end" + (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 1 4)) + (pass-if-error "5 args, negative sstart" + (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) -1 2)) + (pass-if-error "5 args, invalid source range" + (vector-reverse-copy! (vector 'a 'b) 0 '#(a b c) 2 1))) + +;;; +;;; Conversion +;;; + +;; +;; vector->list +;; + +(with-test-prefix "vector->list" + + (pass-if-equal "1 arg" + '(a b c) + (vector->list '#(a b c))) + + (pass-if-equal "2 args" + '(b c) + (vector->list '#(a b c) 1)) + + (pass-if-equal "3 args" + '(b c d) + (vector->list '#(a b c d e) 1 4)) + + (pass-if-equal "3 args, empty range" + '() + (vector->list '#(a b c d e) 1 1)) + + (pass-if-equal "1 arg, empty vector" + '() + (vector->list '#())) + + (pass-if-error "index beyond end" (vector->list '#(a b c) 1 6)) + (pass-if-error "negative index" (vector->list '#(a b c) -1 1)) + (pass-if-error "invalid range" (vector->list '#(a b c) 2 1))) + +;; +;; reverse-vector->list +;; + +(with-test-prefix "reverse-vector->list" + + (pass-if-equal "1 arg" + '(c b a) + (reverse-vector->list '#(a b c))) + + (pass-if-equal "2 args" + '(c b) + (reverse-vector->list '#(a b c) 1)) + + (pass-if-equal "3 args" + '(d c b) + (reverse-vector->list '#(a b c d e) 1 4)) + + (pass-if-equal "3 args, empty range" + '() + (reverse-vector->list '#(a b c d e) 1 1)) + + (pass-if-equal "1 arg, empty vector" + '() + (reverse-vector->list '#())) + + (pass-if-error "index beyond end" (reverse-vector->list '#(a b c) 1 6)) + (pass-if-error "negative index" (reverse-vector->list '#(a b c) -1 1)) + (pass-if-error "invalid range" (reverse-vector->list '#(a b c) 2 1))) + +;; +;; list->vector +;; + +(with-test-prefix "list->vector" + + (pass-if-equal "1 arg" + '#(a b c) + (list->vector '(a b c))) + + (pass-if-equal "1 empty list" + '#() + (list->vector '())) + + (pass-if-equal "2 args" + '#(2 3) + (list->vector '(0 1 2 3) 2)) + + (pass-if-equal "3 args" + '#(0 1) + (list->vector '(0 1 2 3) 0 2)) + + (pass-if-equal "3 args, empty range" + '#() + (list->vector '(0 1 2 3) 2 2)) + + (pass-if-error "index beyond end" (list->vector '(0 1 2 3) 0 5)) + (pass-if-error "negative index" (list->vector '(0 1 2 3) -1 1)) + (pass-if-error "invalid range" (list->vector '(0 1 2 3) 2 1))) + +;; +;; reverse-list->vector +;; + +(with-test-prefix "reverse-list->vector" + + (pass-if-equal "1 arg" + '#(c b a) + (reverse-list->vector '(a b c))) + + (pass-if-equal "1 empty list" + '#() + (reverse-list->vector '())) + + (pass-if-equal "2 args" + '#(3 2) + (reverse-list->vector '(0 1 2 3) 2)) + + (pass-if-equal "3 args" + '#(1 0) + (reverse-list->vector '(0 1 2 3) 0 2)) + + (pass-if-equal "3 args, empty range" + '#() + (reverse-list->vector '(0 1 2 3) 2 2)) + + (pass-if-error "index beyond end" + (reverse-list->vector '(0 1 2 3) 0 5)) + + (pass-if-error "negative index" + (reverse-list->vector '(0 1 2 3) -1 1)) + + (pass-if-error "invalid range" + (reverse-list->vector '(0 1 2 3) 2 1))) + +;;; Local Variables: +;;; eval: (put 'pass-if-error 'scheme-indent-function 1) +;;; End: |