1;;;; vectors.test --- test suite for Guile's vector functions -*- scheme -*- 2;;;; 3;;;; Copyright (C) 2003, 2006, 2010, 2011 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(define-module (test-suite vectors) 20 :use-module (test-suite lib)) 21 22;; FIXME: As soon as guile supports immutable vectors, this has to be 23;; replaced with the appropriate error type and message. 24(define exception:immutable-vector 25 (cons 'some-error-type "^trying to modify an immutable vector")) 26 27 28(with-test-prefix "vector-set!" 29 30 (expect-fail-exception "vector constant" 31 exception:immutable-vector 32 (vector-set! '#(1 2 3) 0 4))) 33 34(with-test-prefix "vector->list" 35 36 (pass-if "simple vector" 37 (equal? '(1 2 3) (vector->list #(1 2 3)))) 38 39 (pass-if "string vector 1" 40 (equal? '("abc" "def" "ghi") (vector->list #("abc" "def" "ghi")))) 41 42 (pass-if "string-vector 2" 43 (equal? '("abc\u0100" "def\u0101" "ghi\u0102") 44 (vector->list #("abc\u0100" "def\u0101" "ghi\u0102")))) 45 46 (pass-if "shared array" 47 (let ((b (make-shared-array #(1) (lambda (x) '(0)) 2))) 48 (equal? b (list->vector (vector->list b)))))) 49 50(with-test-prefix "make-vector" 51 52 (pass-if "null" 53 (equal? #() (make-vector 0))) 54 55 (pass-if "fill with num" 56 (equal? #(1 1 1) (make-vector 3 1))) 57 58 (pass-if "fill with string" 59 (equal? #("abc" "abc" "abc") (make-vector 3 "abc"))) 60 61 (pass-if "fill with string 2" 62 (equal? #("ab\u0100" "ab\u0100" "ab\u0100") 63 (make-vector 3 "ab\u0100")))) 64 65(with-test-prefix "vector-move-left!" 66 67 (pass-if-exception "before start" exception:out-of-range 68 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 69 (b (vector 10 20 30 40 50 60 70 80 90))) 70 (vector-move-left! a 3 5 b -1))) 71 72 (pass-if "beginning" 73 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 74 (b (vector 10 20 30 40 50 60 70 80 90))) 75 (vector-move-left! a 3 5 b 0) 76 (equal? b #(4 5 30 40 50 60 70 80 90)))) 77 78 (pass-if "middle" 79 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 80 (b (vector 10 20 30 40 50 60 70 80 90))) 81 (vector-move-left! a 3 5 b 2) 82 (equal? b #(10 20 4 5 50 60 70 80 90)))) 83 84 (pass-if "overlap -" 85 (let ((a (vector 1 2 3 4 5 6 7 8 9))) 86 (vector-move-left! a 3 5 a 2) 87 (equal? a #(1 2 4 5 5 6 7 8 9)))) 88 89 (pass-if "overlap +" 90 (let ((a (vector 1 2 3 4 5 6 7 8 9))) 91 (vector-move-left! a 3 5 a 4) 92 (equal? a #(1 2 3 4 4 4 7 8 9)))) 93 94 (pass-if "end" 95 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 96 (b (vector 10 20 30 40 50 60 70 80 90))) 97 (vector-move-left! a 3 5 b 7) 98 (equal? b #(10 20 30 40 50 60 70 4 5)))) 99 100 (pass-if "whole thing" 101 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 102 (b (vector 10 20 30 40 50 60 70 80 90))) 103 (vector-move-left! a 0 9 b 0) 104 (equal? b #(1 2 3 4 5 6 7 8 9)))) 105 106 (pass-if-exception "past end" exception:out-of-range 107 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 108 (b (vector 10 20 30 40 50 60 70 80 90))) 109 (vector-move-left! a 3 5 b 8)))) 110 111(with-test-prefix "vector-move-right!" 112 113 (pass-if-exception "before start" exception:out-of-range 114 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 115 (b (vector 10 20 30 40 50 60 70 80 90))) 116 (vector-move-right! a 3 5 b -1))) 117 118 (pass-if "beginning" 119 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 120 (b (vector 10 20 30 40 50 60 70 80 90))) 121 (vector-move-right! a 3 5 b 0) 122 (equal? b #(4 5 30 40 50 60 70 80 90)))) 123 124 (pass-if "middle" 125 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 126 (b (vector 10 20 30 40 50 60 70 80 90))) 127 (vector-move-right! a 3 5 b 2) 128 (equal? b #(10 20 4 5 50 60 70 80 90)))) 129 130 (pass-if "overlap -" 131 (let ((a (vector 1 2 3 4 5 6 7 8 9))) 132 (vector-move-right! a 3 5 a 2) 133 (equal? a #(1 2 5 5 5 6 7 8 9)))) 134 135 (pass-if "overlap +" 136 (let ((a (vector 1 2 3 4 5 6 7 8 9))) 137 (vector-move-right! a 3 5 a 4) 138 (equal? a #(1 2 3 4 4 5 7 8 9)))) 139 140 (pass-if "end" 141 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 142 (b (vector 10 20 30 40 50 60 70 80 90))) 143 (vector-move-right! a 3 5 b 7) 144 (equal? b #(10 20 30 40 50 60 70 4 5)))) 145 146 (pass-if "whole thing" 147 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 148 (b (vector 10 20 30 40 50 60 70 80 90))) 149 (vector-move-right! a 0 9 b 0) 150 (equal? b #(1 2 3 4 5 6 7 8 9)))) 151 152 (pass-if-exception "past end" exception:out-of-range 153 (let ((a (vector 1 2 3 4 5 6 7 8 9)) 154 (b (vector 10 20 30 40 50 60 70 80 90))) 155 (vector-move-right! a 3 5 b 8)))) 156