bytevectors.k (6650B)
1 ;; check.k & test-helpers.k should be loaded 2 ;; 3 ;; Tests of bytevector features. 4 ;; 5 6 ;; helper functions 7 ;; 8 ;; (u8 X_0 X_1 ... X_{N-1}) returns a bytevector B of length N, 9 ;; such that B[k] = X_k 10 ;; 11 ;; (u16 X_0 X_1 ... X_{N-1}) returns a bytevector B of length 2N, 12 ;; such that the bytes B[2k], B[2k+1], combined into 16-bit 13 ;; unsigned integer, represent the number X_k 14 ;; 15 ;; (u32 X_0 X_1 ... X_{N-1}) returns a bytevector of length 4N 16 ;; such that the bytes B[4k] ... B[4k+3], combined into 32-bit 17 ;; unsigned integer, represent the number X_k 18 ;; 19 20 ($define! u8 bytevector) 21 22 ;; TODO: endianess 23 ($define! u16 24 ($let 25 ((decompose ($lambda (w) (list (mod w 256) (div w 256))))) 26 ($lambda words 27 (list->bytevector (apply append (map decompose words)))))) 28 29 ;; TODO: endianess 30 ($define! u32 31 ($let 32 ((decompose 33 ($lambda (w) 34 (list (mod w 256) (mod (div w 256) 256) 35 (mod (div w 65536) 256) (div w 16777216))))) 36 ($lambda words 37 (list->bytevector (apply append (map decompose words)))))) 38 39 40 ;; XXX bytevector? 41 42 ($check-predicate (bytevector?)) 43 ($check-predicate (bytevector? (make-bytevector 0))) 44 ($check-predicate (bytevector? (make-bytevector 1))) 45 46 ($check-not-predicate (bytevector? 0)) 47 ($check-not-predicate (bytevector? "")) 48 ($check-not-predicate (bytevector? ())) 49 50 ;; XXX immutable-bytevector? mutable-bytevector? 51 52 ($check-predicate (immutable-bytevector?)) 53 ($check-predicate (immutable-bytevector? (make-bytevector 0))) 54 55 ($check-predicate (mutable-bytevector?)) 56 ($check-predicate (mutable-bytevector? (make-bytevector 1))) 57 58 ;; XXX bytevector 59 ($check-predicate (bytevector? (bytevector 1 2 3))) 60 ($check-predicate (mutable-bytevector? (bytevector 1 2 3))) 61 ($check equal? (bytevector 1 2 3) (list->bytevector (list 1 2 3))) 62 63 ;; XXX list->bytevector 64 ($check equal? (make-bytevector 0) (list->bytevector ())) 65 ($check equal? (make-bytevector 3 1) (list->bytevector (list 1 1 1))) 66 ($check equal? (list->bytevector (list 1 2 3 4)) (u8 1 2 3 4)) 67 ($check-predicate (mutable-bytevector? (list->bytevector (list 1 2 3)))) 68 ($check-predicate (mutable-bytevector? (list->bytevector 69 (copy-es-immutable (list 1 2 3))))) 70 71 ;; XXX bytevector->list 72 ($check-predicate (null? (bytevector->list (u8)))) 73 ($check equal? (bytevector->list (u8 1 2 3 4)) (list 1 2 3 4)) 74 ($check-predicate (mutable-pair? (bytevector->list (u8 1 2)))) 75 ($check-predicate (mutable-pair? (bytevector->list 76 (bytevector->immutable-bytevector 77 (u8 1 2))))) 78 79 ;; (R7RS 3rd draft, section 6.3.7) make-bytevector bytevector-length 80 81 ($check equal? (bytevector-length (make-bytevector 0)) 0) 82 ($check equal? (bytevector-length (make-bytevector 0 0)) 0) 83 ($check equal? (bytevector-length (make-bytevector 1)) 1) 84 ($check equal? (bytevector-length (make-bytevector 1 2)) 1) 85 ($check equal? (bytevector-length (make-bytevector 8192)) 8192) 86 87 ;; (R7RS 3rd draft, section 6.3.7) bytevector-u8-ref 88 89 ($check equal? (bytevector-u8-ref (make-bytevector 10 0) 1) 0) 90 ($check equal? (bytevector-u8-ref (make-bytevector 10 123) 5) 123) 91 ($check equal? (bytevector-u8-ref (make-bytevector 10 255) 9) 255) 92 93 ;; (R7RS 3rd draft, section 6.3.7) bytevector-u8-set! 94 ;; additional property: returns #inert 95 ;; additional property: destination must be mutable 96 ;; 97 ($let* 98 ((v (make-bytevector 10)) 99 (w (bytevector->immutable-bytevector v))) 100 ($check equal? (bytevector-u8-set! v 0 1) #inert) 101 ($check equal? (bytevector-u8-ref v 0) 1) 102 ($check equal? (bytevector-u8-set! v 0 32) #inert) 103 ($check equal? (bytevector-u8-ref v 0) 32) 104 ($check equal? (bytevector-u8-set! v 6 42) #inert) 105 ($check equal? (bytevector-u8-ref v 0) 32) 106 ($check equal? (bytevector-u8-ref v 6) 42) 107 ($check-error (bytevector-u8-ref v -1)) 108 ($check-error (bytevector-u8-ref v 10)) 109 ($check-error (bytevector-u8-ref v 12345)) 110 ($check-error (bytevector-u8-set! v -1 0)) 111 ($check-error (bytevector-u8-set! v 10 255)) 112 ($check-error (bytevector-u8-set! v 5 -1)) 113 ($check-error (bytevector-u8-set! v 9 256)) 114 ($check-error (bytevector-u8-set! v 9 #\x)) 115 ($check-error (bytevector-u8-set! v 9 #f)) 116 ($check-error (bytevector-u8-set! w 0 0))) 117 118 ;; (R7RS 3rd draft, section 6.3.7) bytevector-copy 119 ;; 120 ($check equal? (bytevector-copy (u8 1 2 3)) (u8 1 2 3)) 121 ($check-predicate (mutable-bytevector? (bytevector-copy (u8 1 2 3)))) 122 123 ($check-predicate 124 (mutable-bytevector? 125 (bytevector-copy (bytevector->immutable-bytevector (u8 1 2 3))))) 126 127 ;; XXX bytevector-copy! 128 ;; additional property: returns #inert 129 ;; additional property: destination must be mutable 130 ;; 131 ($let ((v (make-bytevector 5 0))) 132 ($check equal? (bytevector-copy! (u8 1 2 3 4 5) v) #inert) 133 ($check equal? v (u8 1 2 3 4 5)) 134 ($check-no-error (bytevector-copy! (bytevector->immutable-bytevector (u8 9 9)) v)) 135 ($check equal? v (u8 9 9 3 4 5)) 136 ($check-error (bytevector-copy! (u8 1 2 3 4 5 6) v)) 137 ($check-error 138 (bytevector-copy! 139 (u8 1) 140 (bytevector->immutable-bytevector (u8 1))))) 141 142 ;; (R7RS 3rd draft, section 6.3.7) bytevector-copy-partial 143 144 ($check equal? (bytevector-copy-partial (u8 1 2 3) 0 0) (u8)) 145 ($check equal? (bytevector-copy-partial (u8 1 2 3) 0 2) (u8 1 2)) 146 ($check equal? (bytevector-copy-partial (u8 1 2 3) 2 3) (u8 3)) 147 ($check equal? (bytevector-copy-partial (u8 1 2 3) 3 3) (u8)) 148 ($check-error (bytevector-copy-partial (u8 1 2 3) 2 4)) 149 ($check-error (bytevector-copy-partial (u8 1 2 3) -1 0)) 150 151 ;; R7RS 3rd draft, section 6.3.7) bytevector-copy-partial! 152 ;; additional property: returns #inert 153 ;; additional property: destination must be mutable 154 ;; 155 ($let* 156 ((v (make-bytevector 5 9)) 157 (w (bytevector->immutable-bytevector v))) 158 ($check equal? (bytevector-copy-partial! (u8 1 2) 0 2 v 0) #inert) 159 ($check equal? v (u8 1 2 9 9 9)) 160 ($check equal? (bytevector-copy-partial! (u8 5 6) 1 2 v 4) #inert) 161 ($check equal? v (u8 1 2 9 9 6)) 162 ($check-error (bytevector-copy-partial! (u8 1 2) 0 2 v -1)) 163 ($check-error (bytevector-copy-partial! (u8 1 2) 0 2 v 4)) 164 ($check-error (bytevector-copy-partial! (u8 1 2) 2 3 v 0)) 165 ($check-error (bytevector-copy-partial! (u8 1 2) -1 0 v 0)) 166 ($check-error (bytevector-copy-partial! (u8 1 2) 0 2 w 0))) 167 168 ;; XXX bytevector-u8-fill! 169 ($check-predicate (inert? (bytevector-u8-fill! (u8 1 2) 0))) 170 ($check equal? ($let ((b (u8 1 2 3))) 171 (bytevector-u8-fill! b 0) 172 b) 173 (u8 0 0 0)) 174 175 ;; XXX bytevector->immutable-bytevector 176 177 ($check-predicate 178 (immutable-bytevector? (bytevector->immutable-bytevector (u8 1 2)))) 179 ($check-not-predicate 180 (mutable-bytevector? (bytevector->immutable-bytevector (u8 1 2))))