vectors.k (6509B)
1 ;; check.k & test-helpers.k should be loaded 2 ;; 3 ;; Tests of vector (heterogenous array) features. 4 ;; 5 6 ;; (R7RS 3rd draft 6.3.6) vector? 7 8 ($check-predicate (applicative? vector?)) 9 ($check-predicate (vector?)) 10 ($check-predicate (vector? (make-vector 0))) 11 ($check-predicate (vector? (make-vector 1))) 12 13 ($check-not-predicate (vector? 0)) 14 ($check-not-predicate (vector? "")) 15 ($check-not-predicate (vector? ())) 16 ($check-not-predicate (vector? (make-bytevector 0))) 17 ($check-not-predicate (vector? (make-bytevector 1))) 18 19 ;; XXX immutable-vector? mutable-vector? 20 21 ($check-predicate (applicative? immutable-vector? mutable-vector?)) 22 23 ($check-predicate (immutable-vector?)) 24 ($check-predicate (immutable-vector? (make-vector 0))) 25 ($check-not-predicate (immutable-vector? (make-vector 1))) 26 ($check-not-predicate (immutable-vector? (make-bytevector 0))) 27 28 ($check-predicate (mutable-vector?)) 29 ($check-predicate (mutable-vector? (make-vector 1))) 30 ($check-not-predicate (mutable-vector? (make-vector 0))) 31 ($check-not-predicate (mutable-vector? (make-bytevector 1))) 32 33 ;; (R7RS 3rd draft, section 6.3.6) make-vector vector-length 34 35 ($check-predicate (applicative? make-vector vector-length)) 36 ($check equal? (vector-length (make-vector 0)) 0) 37 ($check equal? (vector-length (make-vector 0 "value")) 0) 38 ($check equal? (vector-length (make-vector 1)) 1) 39 ($check equal? (vector-length (make-vector 1 (list 1 2 3))) 1) 40 ($check equal? (vector-length (make-vector 8192)) 8192) 41 42 ;; (R7RS 3rd draft, section 6.3.6) vector 43 44 ($check-predicate (applicative? vector?)) 45 ($check-predicate (vector? (vector))) 46 ($check-predicate (immutable-vector? (vector))) 47 ($check equal? (vector-length (vector)) 0) 48 ($check-predicate (mutable-vector? (vector "x" "y"))) 49 ($check equal? (vector-length (vector "x" "y")) 2) 50 51 ;; (R7RS 3rd draft, section 6.3.6) vector-ref 52 53 ($check-predicate (applicative? vector-ref)) 54 ($check equal? (vector-ref (make-vector 10 #t) 1) #t) 55 ($check equal? (vector-ref (make-vector 10 "abc") 5) "abc") 56 ($check equal? (vector-ref (make-vector 10 1/2) 9) 1/2) 57 ($check equal? (vector-ref (vector 1/2 1/3 1/4) 2) 1/4) 58 59 ;; (R7RS 3rd draft, section 6.3.6) vector-set! 60 ;; additional property: returns #inert 61 ;; additional property: destination must be mutable 62 63 ($check-predicate (applicative? vector-set!)) 64 65 ($let* 66 ((v (make-vector 10)) 67 (w (vector->immutable-vector v))) 68 ($check equal? (vector-set! v 0 1) #inert) 69 ($check equal? (vector-ref v 0) 1) 70 ($check equal? (vector-set! v 0 "abc") #inert) 71 ($check equal? (vector-ref v 0) "abc") 72 ($check equal? (vector-set! v 6 v) #inert) 73 ($check equal? (vector-ref v 0) "abc") 74 ($check eq? (vector-ref v 6) v) 75 ($check-error (vector-ref v -1)) 76 ($check-error (vector-ref v 10)) 77 ($check-error (vector-ref v 12345)) 78 ($check-error (vector-set! v -1 0)) 79 ($check-error (vector-set! v 10 1/2)) 80 ($check-error (vector-set! w 0 #t))) 81 82 ;; (R7RS 3rd draft, section 6.3.6) list->vector, vector->list 83 84 ($check-predicate (applicative? list->vector)) 85 ($check-predicate (immutable-vector? (list->vector ()))) 86 ($check-predicate (mutable-vector? (list->vector (list "a" "b")))) 87 88 ;; (R7RS 3rd draft, section 6.3.6) vector-copy 89 ($check equal? (vector-copy (vector 1 2 3)) (vector 1 2 3)) 90 ($check equal? (vector-copy (vector (vector 1 2 3) (vector 4 5 6))) 91 (vector (vector 1 2 3) (vector 4 5 6))) 92 ($check-predicate (mutable-vector? (vector-copy (vector 1 2 3)))) 93 94 ($check-predicate 95 (mutable-vector? 96 (vector-copy (vector->immutable-vector (vector 1 2 3))))) 97 98 ;; XXX bytevector->vector 99 100 ($check equal? (bytevector->vector (u8)) (vector)) 101 ($check equal? (bytevector->vector (u8 0 1 2)) (vector 0 1 2)) 102 103 ($check-not-predicate 104 ($let* 105 ((bb (u8 0 1 2)) 106 (x (bytevector->vector bb)) 107 (y (bytevector->vector bb))) 108 (eq? x y))) 109 110 ($check-predicate (mutable-vector? (bytevector->vector (u8 0 1 2)))) 111 112 ;; XXX vector->bytevector 113 114 ($check equal? (vector->bytevector (vector)) (u8)) 115 ($check equal? (vector->bytevector (vector 0 1 2)) (u8 0 1 2)) 116 117 ($check-not-predicate 118 ($let* 119 ((cs (vector 0 1 2)) 120 (x (vector->bytevector cs)) 121 (y (vector->bytevector cs))) 122 (eq? x y))) 123 124 ($check-predicate (mutable-bytevector? (vector->bytevector (vector 0 1)))) 125 126 127 ;; errors 128 ($check-error (vector->bytevector (vector -1))) 129 ($check-error (vector->bytevector (vector 256))) 130 ($check-error (vector->bytevector (vector (integer->char 41)))) 131 132 ;; XXX vector-copy! 133 ;; additional property: returns #inert 134 ;; additional property: destination must be mutable 135 ;; 136 ($let ((v (make-vector 5 0))) 137 ($check equal? (vector-copy! (vector 1 2 3 4 5) v) #inert) 138 ($check equal? v (vector 1 2 3 4 5)) 139 ($check-no-error (vector-copy! (vector->immutable-vector (vector 9 9)) v)) 140 ($check equal? v (vector 9 9 3 4 5)) 141 ($check-error (vector-copy! (vector 1 2 3 4 5 6) v)) 142 ($check-error 143 (vector-copy! 144 (vector 1) 145 (vector->immutable-vector (vector 1))))) 146 147 ;; (R7RS 3rd draft, ) vector-copy-partial 148 149 ($check equal? (vector-copy-partial (vector 1 2 3) 0 0) (vector)) 150 ($check equal? (vector-copy-partial (vector 1 2 3) 0 2) (vector 1 2)) 151 ($check equal? (vector-copy-partial (vector 1 2 3) 2 3) (vector 3)) 152 ($check equal? (vector-copy-partial (vector 1 2 3) 3 3) (vector)) 153 ($check-error (vector-copy-partial (vector 1 2 3) 2 4)) 154 ($check-error (vector-copy-partial (vector 1 2 3) -1 0)) 155 156 ;; R7RS 3rd draft, vector-copy-partial! 157 ;; additional property: returns #inert 158 ;; additional property: destination must be mutable 159 ;; 160 ($let* 161 ((v (make-vector 5 9)) 162 (w (vector->immutable-vector v))) 163 ($check equal? (vector-copy-partial! (vector 1 2) 0 2 v 0) #inert) 164 ($check equal? v (vector 1 2 9 9 9)) 165 ($check equal? (vector-copy-partial! (vector 5 6) 1 2 v 4) #inert) 166 ($check equal? v (vector 1 2 9 9 6)) 167 ($check-error (vector-copy-partial! (vector 1 2) 0 2 v -1)) 168 ($check-error (vector-copy-partial! (vector 1 2) 0 2 v 4)) 169 ($check-error (vector-copy-partial! (vector 1 2) 2 3 v 0)) 170 ($check-error (vector-copy-partial! (vector 1 2) -1 0 v 0)) 171 ($check-error (vector-copy-partial! (vector 1 2) 0 2 w 0))) 172 173 174 ;; XXX vector-fill! 175 ($check-predicate (inert? (vector-fill! (vector 1 2) 0))) 176 ($check equal? ($let ((v (vector 1 2 3))) 177 (vector-fill! v "str") 178 v) 179 (vector "str" "str" "str")) 180 181 ;; XXX vector->immutable-vector 182 183 ($check-predicate (applicative? vector->immutable-vector)) 184 185 ($check-predicate 186 (immutable-vector? (vector->immutable-vector (vector 1 2)))) 187 ($check-not-predicate 188 (mutable-vector? (vector->immutable-vector (vector 1 2))))