Commit | Line | Data |
---|---|---|
d3b5628c | 1 | ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*- |
1ee2c72e | 2 | ;;;; |
80719649 | 3 | ;;;; Copyright (C) 2009, 2010, 2011 Free Software Foundation, Inc. |
d3b5628c | 4 | ;;;; Ludovic Courtès |
1ee2c72e LC |
5 | ;;;; |
6 | ;;;; This library is free software; you can redistribute it and/or | |
7 | ;;;; modify it under the terms of the GNU Lesser General Public | |
8 | ;;;; License as published by the Free Software Foundation; either | |
53befeb7 NJ |
9 | ;;;; version 3 of the License, or (at your option) any later version. |
10 | ;;;; | |
1ee2c72e LC |
11 | ;;;; This library is distributed in the hope that it will be useful, |
12 | ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 | ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
14 | ;;;; Lesser General Public License for more details. | |
53befeb7 | 15 | ;;;; |
1ee2c72e LC |
16 | ;;;; You should have received a copy of the GNU Lesser General Public |
17 | ;;;; License along with this library; if not, write to the Free Software | |
18 | ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
19 | ||
20 | (define-module (test-bytevector) | |
21 | :use-module (test-suite lib) | |
a98f422e | 22 | :use-module (system base compile) |
07d22c02 | 23 | :use-module (rnrs bytevectors)) |
1ee2c72e LC |
24 | |
25 | ;;; Some of the tests in here are examples taken from the R6RS Standard | |
26 | ;;; Libraries document. | |
27 | ||
28 | \f | |
a98f422e | 29 | (with-test-prefix/c&e "2.2 General Operations" |
1ee2c72e LC |
30 | |
31 | (pass-if "native-endianness" | |
32 | (not (not (memq (native-endianness) '(big little))))) | |
33 | ||
34 | (pass-if "make-bytevector" | |
35 | (and (bytevector? (make-bytevector 20)) | |
36 | (bytevector? (make-bytevector 20 3)))) | |
37 | ||
38 | (pass-if "bytevector-length" | |
39 | (= (bytevector-length (make-bytevector 20)) 20)) | |
40 | ||
41 | (pass-if "bytevector=?" | |
42 | (and (bytevector=? (make-bytevector 20 7) | |
43 | (make-bytevector 20 7)) | |
44 | (not (bytevector=? (make-bytevector 20 7) | |
80719649 LC |
45 | (make-bytevector 20 0))))) |
46 | ||
47 | (pass-if "bytevector-copy! overlapping" | |
48 | ;; See <http://debbugs.gnu.org/10070>. | |
49 | (let ((b (u8-list->bytevector '(1 2 3 4 5 6 7 8)))) | |
50 | (bytevector-copy! b 0 b 3 4) | |
51 | (bytevector->u8-list b) | |
52 | (bytevector=? b #vu8(1 2 3 1 2 3 4 8))))) | |
1ee2c72e LC |
53 | |
54 | \f | |
a98f422e | 55 | (with-test-prefix/c&e "2.3 Operations on Bytes and Octets" |
1ee2c72e LC |
56 | |
57 | (pass-if "bytevector-{u8,s8}-ref" | |
58 | (equal? '(-127 129 -1 255) | |
59 | (let ((b1 (make-bytevector 16 -127)) | |
60 | (b2 (make-bytevector 16 255))) | |
61 | (list (bytevector-s8-ref b1 0) | |
62 | (bytevector-u8-ref b1 0) | |
63 | (bytevector-s8-ref b2 0) | |
64 | (bytevector-u8-ref b2 0))))) | |
65 | ||
66 | (pass-if "bytevector-{u8,s8}-set!" | |
67 | (equal? '(-126 130 -10 246) | |
68 | (let ((b (make-bytevector 16 -127))) | |
69 | ||
70 | (bytevector-s8-set! b 0 -126) | |
71 | (bytevector-u8-set! b 1 246) | |
72 | ||
73 | (list (bytevector-s8-ref b 0) | |
74 | (bytevector-u8-ref b 0) | |
75 | (bytevector-s8-ref b 1) | |
76 | (bytevector-u8-ref b 1))))) | |
77 | ||
78 | (pass-if "bytevector->u8-list" | |
79 | (let ((lst '(1 2 3 128 150 255))) | |
80 | (equal? lst | |
81 | (bytevector->u8-list | |
82 | (let ((b (make-bytevector 6))) | |
83 | (for-each (lambda (i v) | |
84 | (bytevector-u8-set! b i v)) | |
85 | (iota 6) | |
86 | lst) | |
87 | b))))) | |
88 | ||
89 | (pass-if "u8-list->bytevector" | |
90 | (let ((lst '(1 2 3 128 150 255))) | |
91 | (equal? lst | |
92 | (bytevector->u8-list (u8-list->bytevector lst))))) | |
93 | ||
94 | (pass-if "bytevector-uint-{ref,set!} [small]" | |
95 | (let ((b (make-bytevector 15))) | |
96 | (bytevector-uint-set! b 0 #x1234 | |
97 | (endianness little) 2) | |
98 | (equal? (bytevector-uint-ref b 0 (endianness big) 2) | |
99 | #x3412))) | |
100 | ||
101 | (pass-if "bytevector-uint-set! [large]" | |
102 | (let ((b (make-bytevector 16))) | |
103 | (bytevector-uint-set! b 0 (- (expt 2 128) 3) | |
104 | (endianness little) 16) | |
105 | (equal? (bytevector->u8-list b) | |
106 | '(253 255 255 255 255 255 255 255 | |
107 | 255 255 255 255 255 255 255 255)))) | |
108 | ||
109 | (pass-if "bytevector-uint-{ref,set!} [large]" | |
110 | (let ((b (make-bytevector 120))) | |
111 | (bytevector-uint-set! b 0 (- (expt 2 128) 3) | |
112 | (endianness little) 16) | |
113 | (equal? (bytevector-uint-ref b 0 (endianness little) 16) | |
114 | #xfffffffffffffffffffffffffffffffd))) | |
115 | ||
116 | (pass-if "bytevector-sint-ref [small]" | |
117 | (let ((b (u8-list->bytevector '(#xff #xf0 #xff)))) | |
118 | (equal? (bytevector-sint-ref b 0 (endianness big) 2) | |
119 | (bytevector-sint-ref b 1 (endianness little) 2) | |
120 | -16))) | |
121 | ||
122 | (pass-if "bytevector-sint-ref [large]" | |
123 | (let ((b (make-bytevector 50))) | |
124 | (bytevector-uint-set! b 0 (- (expt 2 128) 3) | |
125 | (endianness little) 16) | |
126 | (equal? (bytevector-sint-ref b 0 (endianness little) 16) | |
127 | -3))) | |
128 | ||
129 | (pass-if "bytevector-sint-set! [small]" | |
130 | (let ((b (make-bytevector 3))) | |
131 | (bytevector-sint-set! b 0 -16 (endianness big) 2) | |
132 | (bytevector-sint-set! b 1 -16 (endianness little) 2) | |
133 | (equal? (bytevector->u8-list b) | |
55bf8cb7 LC |
134 | '(#xff #xf0 #xff)))) |
135 | ||
136 | (pass-if "equal?" | |
137 | (let ((bv1 (u8-list->bytevector (iota 123))) | |
138 | (bv2 (u8-list->bytevector (iota 123)))) | |
139 | (equal? bv1 bv2)))) | |
1ee2c72e LC |
140 | |
141 | \f | |
a98f422e | 142 | (with-test-prefix/c&e "2.4 Operations on Integers of Arbitrary Size" |
1ee2c72e LC |
143 | |
144 | (pass-if "bytevector->sint-list" | |
145 | (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2)))) | |
146 | (equal? (bytevector->sint-list b (endianness little) 2) | |
147 | '(513 -253 513 513)))) | |
148 | ||
149 | (pass-if "bytevector->uint-list" | |
150 | (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1)))) | |
151 | (equal? (bytevector->uint-list b (endianness big) 2) | |
152 | '(513 65283 513 513)))) | |
153 | ||
154 | (pass-if "bytevector->uint-list [empty]" | |
155 | (let ((b (make-bytevector 0))) | |
156 | (null? (bytevector->uint-list b (endianness big) 2)))) | |
157 | ||
158 | (pass-if-exception "bytevector->sint-list [out-of-range]" | |
159 | exception:out-of-range | |
160 | (bytevector->sint-list (make-bytevector 6) (endianness little) 8)) | |
161 | ||
162 | (pass-if "bytevector->sint-list [off-by-one]" | |
163 | (equal? (bytevector->sint-list (make-bytevector 31 #xff) | |
164 | (endianness little) 8) | |
165 | '(-1 -1 -1))) | |
166 | ||
167 | (pass-if "{sint,uint}-list->bytevector" | |
168 | (let ((b1 (sint-list->bytevector '(513 -253 513 513) | |
169 | (endianness little) 2)) | |
170 | (b2 (uint-list->bytevector '(513 65283 513 513) | |
171 | (endianness little) 2)) | |
172 | (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2)))) | |
173 | (and (bytevector=? b1 b2) | |
174 | (bytevector=? b2 b3)))) | |
175 | ||
176 | (pass-if "sint-list->bytevector [limits]" | |
177 | (bytevector=? (sint-list->bytevector '(-32768 32767) | |
178 | (endianness big) 2) | |
179 | (let ((bv (make-bytevector 4))) | |
180 | (bytevector-u8-set! bv 0 #x80) | |
181 | (bytevector-u8-set! bv 1 #x00) | |
182 | (bytevector-u8-set! bv 2 #x7f) | |
183 | (bytevector-u8-set! bv 3 #xff) | |
184 | bv))) | |
185 | ||
186 | (pass-if-exception "sint-list->bytevector [out-of-range]" | |
187 | exception:out-of-range | |
188 | (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big) | |
189 | 2)) | |
190 | ||
191 | (pass-if-exception "uint-list->bytevector [out-of-range]" | |
192 | exception:out-of-range | |
193 | (uint-list->bytevector '(0 -1) (endianness big) 2))) | |
194 | ||
195 | \f | |
a98f422e | 196 | (with-test-prefix/c&e "2.5 Operations on 16-Bit Integers" |
1ee2c72e LC |
197 | |
198 | (pass-if "bytevector-u16-ref" | |
199 | (let ((b (u8-list->bytevector | |
200 | '(255 255 255 255 255 255 255 255 | |
201 | 255 255 255 255 255 255 255 253)))) | |
202 | (and (equal? (bytevector-u16-ref b 14 (endianness little)) | |
203 | #xfdff) | |
204 | (equal? (bytevector-u16-ref b 14 (endianness big)) | |
205 | #xfffd)))) | |
206 | ||
207 | (pass-if "bytevector-s16-ref" | |
208 | (let ((b (u8-list->bytevector | |
209 | '(255 255 255 255 255 255 255 255 | |
210 | 255 255 255 255 255 255 255 253)))) | |
211 | (and (equal? (bytevector-s16-ref b 14 (endianness little)) | |
212 | -513) | |
213 | (equal? (bytevector-s16-ref b 14 (endianness big)) | |
214 | -3)))) | |
215 | ||
216 | (pass-if "bytevector-s16-ref [unaligned]" | |
217 | (let ((b (u8-list->bytevector '(#xff #xf0 #xff)))) | |
218 | (equal? (bytevector-s16-ref b 1 (endianness little)) | |
219 | -16))) | |
220 | ||
221 | (pass-if "bytevector-{u16,s16}-ref" | |
222 | (let ((b (make-bytevector 2))) | |
223 | (bytevector-u16-set! b 0 44444 (endianness little)) | |
224 | (and (equal? (bytevector-u16-ref b 0 (endianness little)) | |
225 | 44444) | |
226 | (equal? (bytevector-s16-ref b 0 (endianness little)) | |
227 | (- 44444 65536))))) | |
228 | ||
229 | (pass-if "bytevector-native-{u16,s16}-{ref,set!}" | |
230 | (let ((b (make-bytevector 2))) | |
231 | (bytevector-u16-native-set! b 0 44444) | |
232 | (and (equal? (bytevector-u16-native-ref b 0) | |
233 | 44444) | |
234 | (equal? (bytevector-s16-native-ref b 0) | |
235 | (- 44444 65536))))) | |
236 | ||
237 | (pass-if "bytevector-s16-{ref,set!} [unaligned]" | |
238 | (let ((b (make-bytevector 3))) | |
239 | (bytevector-s16-set! b 1 -77 (endianness little)) | |
240 | (equal? (bytevector-s16-ref b 1 (endianness little)) | |
241 | -77)))) | |
242 | ||
243 | \f | |
a98f422e | 244 | (with-test-prefix/c&e "2.6 Operations on 32-bit Integers" |
1ee2c72e LC |
245 | |
246 | (pass-if "bytevector-u32-ref" | |
247 | (let ((b (u8-list->bytevector | |
248 | '(255 255 255 255 255 255 255 255 | |
249 | 255 255 255 255 255 255 255 253)))) | |
250 | (and (equal? (bytevector-u32-ref b 12 (endianness little)) | |
251 | #xfdffffff) | |
252 | (equal? (bytevector-u32-ref b 12 (endianness big)) | |
253 | #xfffffffd)))) | |
254 | ||
255 | (pass-if "bytevector-s32-ref" | |
256 | (let ((b (u8-list->bytevector | |
257 | '(255 255 255 255 255 255 255 255 | |
258 | 255 255 255 255 255 255 255 253)))) | |
259 | (and (equal? (bytevector-s32-ref b 12 (endianness little)) | |
260 | -33554433) | |
261 | (equal? (bytevector-s32-ref b 12 (endianness big)) | |
262 | -3)))) | |
263 | ||
264 | (pass-if "bytevector-{u32,s32}-ref" | |
265 | (let ((b (make-bytevector 4))) | |
266 | (bytevector-u32-set! b 0 2222222222 (endianness little)) | |
267 | (and (equal? (bytevector-u32-ref b 0 (endianness little)) | |
268 | 2222222222) | |
269 | (equal? (bytevector-s32-ref b 0 (endianness little)) | |
270 | (- 2222222222 (expt 2 32)))))) | |
271 | ||
272 | (pass-if "bytevector-{u32,s32}-native-{ref,set!}" | |
273 | (let ((b (make-bytevector 4))) | |
274 | (bytevector-u32-native-set! b 0 2222222222) | |
275 | (and (equal? (bytevector-u32-native-ref b 0) | |
276 | 2222222222) | |
277 | (equal? (bytevector-s32-native-ref b 0) | |
278 | (- 2222222222 (expt 2 32))))))) | |
279 | ||
280 | \f | |
a98f422e | 281 | (with-test-prefix/c&e "2.7 Operations on 64-bit Integers" |
1ee2c72e LC |
282 | |
283 | (pass-if "bytevector-u64-ref" | |
284 | (let ((b (u8-list->bytevector | |
285 | '(255 255 255 255 255 255 255 255 | |
286 | 255 255 255 255 255 255 255 253)))) | |
287 | (and (equal? (bytevector-u64-ref b 8 (endianness little)) | |
288 | #xfdffffffffffffff) | |
289 | (equal? (bytevector-u64-ref b 8 (endianness big)) | |
290 | #xfffffffffffffffd)))) | |
291 | ||
292 | (pass-if "bytevector-s64-ref" | |
293 | (let ((b (u8-list->bytevector | |
294 | '(255 255 255 255 255 255 255 255 | |
295 | 255 255 255 255 255 255 255 253)))) | |
296 | (and (equal? (bytevector-s64-ref b 8 (endianness little)) | |
297 | -144115188075855873) | |
298 | (equal? (bytevector-s64-ref b 8 (endianness big)) | |
299 | -3)))) | |
300 | ||
301 | (pass-if "bytevector-{u64,s64}-ref" | |
302 | (let ((b (make-bytevector 8)) | |
303 | (big 9333333333333333333)) | |
304 | (bytevector-u64-set! b 0 big (endianness little)) | |
305 | (and (equal? (bytevector-u64-ref b 0 (endianness little)) | |
306 | big) | |
307 | (equal? (bytevector-s64-ref b 0 (endianness little)) | |
308 | (- big (expt 2 64)))))) | |
309 | ||
310 | (pass-if "bytevector-{u64,s64}-native-{ref,set!}" | |
311 | (let ((b (make-bytevector 8)) | |
312 | (big 9333333333333333333)) | |
313 | (bytevector-u64-native-set! b 0 big) | |
314 | (and (equal? (bytevector-u64-native-ref b 0) | |
315 | big) | |
316 | (equal? (bytevector-s64-native-ref b 0) | |
317 | (- big (expt 2 64)))))) | |
318 | ||
319 | (pass-if "ref/set! with zero" | |
320 | (let ((b (make-bytevector 8))) | |
321 | (bytevector-s64-set! b 0 -1 (endianness big)) | |
322 | (bytevector-u64-set! b 0 0 (endianness big)) | |
323 | (= 0 (bytevector-u64-ref b 0 (endianness big)))))) | |
324 | ||
325 | \f | |
a98f422e | 326 | (with-test-prefix/c&e "2.8 Operations on IEEE-754 Representations" |
1ee2c72e LC |
327 | |
328 | (pass-if "bytevector-ieee-single-native-{ref,set!}" | |
329 | (let ((b (make-bytevector 4)) | |
330 | (number 3.00)) | |
331 | (bytevector-ieee-single-native-set! b 0 number) | |
332 | (equal? (bytevector-ieee-single-native-ref b 0) | |
333 | number))) | |
334 | ||
335 | (pass-if "bytevector-ieee-single-{ref,set!}" | |
336 | (let ((b (make-bytevector 8)) | |
337 | (number 3.14)) | |
338 | (bytevector-ieee-single-set! b 0 number (endianness little)) | |
339 | (bytevector-ieee-single-set! b 4 number (endianness big)) | |
340 | (equal? (bytevector-ieee-single-ref b 0 (endianness little)) | |
341 | (bytevector-ieee-single-ref b 4 (endianness big))))) | |
342 | ||
343 | (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]" | |
344 | (let ((b (make-bytevector 9)) | |
345 | (number 3.14)) | |
346 | (bytevector-ieee-single-set! b 1 number (endianness little)) | |
347 | (bytevector-ieee-single-set! b 5 number (endianness big)) | |
348 | (equal? (bytevector-ieee-single-ref b 1 (endianness little)) | |
349 | (bytevector-ieee-single-ref b 5 (endianness big))))) | |
350 | ||
351 | (pass-if "bytevector-ieee-double-native-{ref,set!}" | |
352 | (let ((b (make-bytevector 8)) | |
353 | (number 3.14)) | |
354 | (bytevector-ieee-double-native-set! b 0 number) | |
355 | (equal? (bytevector-ieee-double-native-ref b 0) | |
356 | number))) | |
357 | ||
358 | (pass-if "bytevector-ieee-double-{ref,set!}" | |
359 | (let ((b (make-bytevector 16)) | |
360 | (number 3.14)) | |
361 | (bytevector-ieee-double-set! b 0 number (endianness little)) | |
362 | (bytevector-ieee-double-set! b 8 number (endianness big)) | |
363 | (equal? (bytevector-ieee-double-ref b 0 (endianness little)) | |
364 | (bytevector-ieee-double-ref b 8 (endianness big)))))) | |
365 | ||
366 | \f | |
1ee2c72e LC |
367 | |
368 | ;; Default to the C locale for the following tests. | |
369 | (setlocale LC_ALL "C") | |
370 | ||
371 | ||
372 | (with-test-prefix "2.9 Operations on Strings" | |
373 | ||
374 | (pass-if "string->utf8" | |
375 | (let* ((str "hello, world") | |
376 | (utf8 (string->utf8 str))) | |
377 | (and (bytevector? utf8) | |
378 | (= (bytevector-length utf8) | |
379 | (string-length str)) | |
380 | (equal? (string->list str) | |
381 | (map integer->char (bytevector->u8-list utf8)))))) | |
382 | ||
383 | (pass-if "string->utf8 [latin-1]" | |
d3b5628c LC |
384 | (let* ((str "hé, ça va bien ?") |
385 | (utf8 (string->utf8 str))) | |
386 | (and (bytevector? utf8) | |
387 | (= (bytevector-length utf8) | |
388 | (+ 2 (string-length str)))))) | |
1ee2c72e LC |
389 | |
390 | (pass-if "string->utf16" | |
391 | (let* ((str "hello, world") | |
392 | (utf16 (string->utf16 str))) | |
393 | (and (bytevector? utf16) | |
394 | (= (bytevector-length utf16) | |
395 | (* 2 (string-length str))) | |
396 | (equal? (string->list str) | |
397 | (map integer->char | |
398 | (bytevector->uint-list utf16 | |
399 | (endianness big) 2)))))) | |
400 | ||
401 | (pass-if "string->utf16 [little]" | |
402 | (let* ((str "hello, world") | |
403 | (utf16 (string->utf16 str (endianness little)))) | |
404 | (and (bytevector? utf16) | |
405 | (= (bytevector-length utf16) | |
406 | (* 2 (string-length str))) | |
407 | (equal? (string->list str) | |
408 | (map integer->char | |
409 | (bytevector->uint-list utf16 | |
410 | (endianness little) 2)))))) | |
411 | ||
412 | ||
413 | (pass-if "string->utf32" | |
414 | (let* ((str "hello, world") | |
415 | (utf32 (string->utf32 str))) | |
416 | (and (bytevector? utf32) | |
417 | (= (bytevector-length utf32) | |
418 | (* 4 (string-length str))) | |
419 | (equal? (string->list str) | |
420 | (map integer->char | |
421 | (bytevector->uint-list utf32 | |
422 | (endianness big) 4)))))) | |
423 | ||
d3b5628c LC |
424 | (pass-if "string->utf32 [Greek]" |
425 | (let* ((str "Ἄνεμοι") | |
426 | (utf32 (string->utf32 str))) | |
427 | (and (bytevector? utf32) | |
428 | (equal? (bytevector->uint-list utf32 (endianness big) 4) | |
429 | '(#x1f0c #x3bd #x3b5 #x3bc #x3bf #x3b9))))) | |
430 | ||
1ee2c72e LC |
431 | (pass-if "string->utf32 [little]" |
432 | (let* ((str "hello, world") | |
433 | (utf32 (string->utf32 str (endianness little)))) | |
434 | (and (bytevector? utf32) | |
435 | (= (bytevector-length utf32) | |
436 | (* 4 (string-length str))) | |
437 | (equal? (string->list str) | |
438 | (map integer->char | |
439 | (bytevector->uint-list utf32 | |
440 | (endianness little) 4)))))) | |
441 | ||
442 | (pass-if "utf8->string" | |
443 | (let* ((utf8 (u8-list->bytevector (map char->integer | |
444 | (string->list "hello, world")))) | |
445 | (str (utf8->string utf8))) | |
446 | (and (string? str) | |
447 | (= (string-length str) | |
448 | (bytevector-length utf8)) | |
449 | (equal? (string->list str) | |
450 | (map integer->char (bytevector->u8-list utf8)))))) | |
451 | ||
452 | (pass-if "utf8->string [latin-1]" | |
d3b5628c LC |
453 | (let* ((utf8 (string->utf8 "hé, ça va bien ?")) |
454 | (str (utf8->string utf8))) | |
455 | (and (string? str) | |
456 | (= (string-length str) | |
457 | (- (bytevector-length utf8) 2))))) | |
1ee2c72e LC |
458 | |
459 | (pass-if "utf16->string" | |
460 | (let* ((utf16 (uint-list->bytevector (map char->integer | |
461 | (string->list "hello, world")) | |
462 | (endianness big) 2)) | |
463 | (str (utf16->string utf16))) | |
464 | (and (string? str) | |
465 | (= (* 2 (string-length str)) | |
466 | (bytevector-length utf16)) | |
467 | (equal? (string->list str) | |
468 | (map integer->char | |
469 | (bytevector->uint-list utf16 (endianness big) | |
470 | 2)))))) | |
471 | ||
472 | (pass-if "utf16->string [little]" | |
473 | (let* ((utf16 (uint-list->bytevector (map char->integer | |
474 | (string->list "hello, world")) | |
475 | (endianness little) 2)) | |
476 | (str (utf16->string utf16 (endianness little)))) | |
477 | (and (string? str) | |
478 | (= (* 2 (string-length str)) | |
479 | (bytevector-length utf16)) | |
480 | (equal? (string->list str) | |
481 | (map integer->char | |
482 | (bytevector->uint-list utf16 (endianness little) | |
483 | 2)))))) | |
484 | (pass-if "utf32->string" | |
485 | (let* ((utf32 (uint-list->bytevector (map char->integer | |
486 | (string->list "hello, world")) | |
487 | (endianness big) 4)) | |
488 | (str (utf32->string utf32))) | |
489 | (and (string? str) | |
490 | (= (* 4 (string-length str)) | |
491 | (bytevector-length utf32)) | |
492 | (equal? (string->list str) | |
493 | (map integer->char | |
494 | (bytevector->uint-list utf32 (endianness big) | |
495 | 4)))))) | |
496 | ||
497 | (pass-if "utf32->string [little]" | |
498 | (let* ((utf32 (uint-list->bytevector (map char->integer | |
499 | (string->list "hello, world")) | |
500 | (endianness little) 4)) | |
501 | (str (utf32->string utf32 (endianness little)))) | |
502 | (and (string? str) | |
503 | (= (* 4 (string-length str)) | |
504 | (bytevector-length utf32)) | |
505 | (equal? (string->list str) | |
506 | (map integer->char | |
507 | (bytevector->uint-list utf32 (endianness little) | |
508 | 4))))))) | |
509 | ||
510 | ||
0ba0b384 LC |
511 | \f |
512 | (with-test-prefix "Datum Syntax" | |
513 | ||
514 | (pass-if "empty" | |
515 | (equal? (with-input-from-string "#vu8()" read) | |
516 | (make-bytevector 0))) | |
517 | ||
518 | (pass-if "simple" | |
519 | (equal? (with-input-from-string "#vu8(1 2 3 4 5)" read) | |
520 | (u8-list->bytevector '(1 2 3 4 5)))) | |
521 | ||
522 | (pass-if ">127" | |
523 | (equal? (with-input-from-string "#vu8(0 255 127 128)" read) | |
524 | (u8-list->bytevector '(0 255 127 128)))) | |
525 | ||
807e5a66 LC |
526 | (pass-if "self-evaluating?" |
527 | (self-evaluating? (make-bytevector 1))) | |
528 | ||
0ba0b384 LC |
529 | (pass-if "self-evaluating" |
530 | (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read) | |
531 | (current-module)) | |
532 | (u8-list->bytevector '(1 2 3 4 5)))) | |
533 | ||
534 | (pass-if "quoted" | |
535 | (equal? (eval (with-input-from-string "'#vu8(1 2 3 4 5)" read) | |
536 | (current-module)) | |
537 | (u8-list->bytevector '(1 2 3 4 5)))) | |
538 | ||
539 | (pass-if "literal simple" | |
540 | (equal? #vu8(1 2 3 4 5) | |
541 | (u8-list->bytevector '(1 2 3 4 5)))) | |
542 | ||
543 | (pass-if "literal >127" | |
544 | (equal? #vu8(0 255 127 128) | |
545 | (u8-list->bytevector '(0 255 127 128)))) | |
546 | ||
547 | (pass-if "literal quoted" | |
548 | (equal? '#vu8(1 2 3 4 5) | |
549 | (u8-list->bytevector '(1 2 3 4 5)))) | |
550 | ||
551 | (pass-if-exception "incorrect prefix" | |
552 | exception:read-error | |
553 | (with-input-from-string "#vi8(1 2 3)" read)) | |
554 | ||
555 | (pass-if-exception "extraneous space" | |
556 | exception:read-error | |
557 | (with-input-from-string "#vu8 (1 2 3)" read)) | |
558 | ||
559 | (pass-if-exception "negative integers" | |
560 | exception:wrong-type-arg | |
561 | (with-input-from-string "#vu8(-1 -2 -3)" read)) | |
562 | ||
563 | (pass-if-exception "out-of-range integers" | |
564 | exception:wrong-type-arg | |
565 | (with-input-from-string "#vu8(0 256)" read))) | |
566 | ||
438974d0 LC |
567 | \f |
568 | (with-test-prefix "Generalized Vectors" | |
569 | ||
570 | (pass-if "generalized-vector?" | |
571 | (generalized-vector? #vu8(1 2 3))) | |
572 | ||
573 | (pass-if "generalized-vector-length" | |
574 | (equal? (iota 16) | |
575 | (map generalized-vector-length | |
576 | (map make-bytevector (iota 16))))) | |
577 | ||
578 | (pass-if "generalized-vector-ref" | |
579 | (let ((bv #vu8(255 127))) | |
580 | (and (= 255 (generalized-vector-ref bv 0)) | |
581 | (= 127 (generalized-vector-ref bv 1))))) | |
582 | ||
583 | (pass-if-exception "generalized-vector-ref [index out-of-range]" | |
584 | exception:out-of-range | |
585 | (let ((bv #vu8(1 2))) | |
586 | (generalized-vector-ref bv 2))) | |
587 | ||
588 | (pass-if "generalized-vector-set!" | |
589 | (let ((bv (make-bytevector 2))) | |
590 | (generalized-vector-set! bv 0 255) | |
591 | (generalized-vector-set! bv 1 77) | |
592 | (equal? '(255 77) | |
593 | (bytevector->u8-list bv)))) | |
594 | ||
595 | (pass-if-exception "generalized-vector-set! [index out-of-range]" | |
596 | exception:out-of-range | |
597 | (let ((bv (make-bytevector 2))) | |
598 | (generalized-vector-set! bv 2 0))) | |
599 | ||
600 | (pass-if-exception "generalized-vector-set! [value out-of-range]" | |
601 | exception:out-of-range | |
602 | (let ((bv (make-bytevector 2))) | |
603 | (generalized-vector-set! bv 0 256))) | |
604 | ||
605 | (pass-if "array-type" | |
606 | (eq? 'vu8 (array-type #vu8()))) | |
607 | ||
608 | (pass-if "array-contents" | |
609 | (let ((bv (u8-list->bytevector (iota 10)))) | |
610 | (eq? bv (array-contents bv)))) | |
611 | ||
612 | (pass-if "array-ref" | |
613 | (let ((bv (u8-list->bytevector (iota 10)))) | |
614 | (equal? (iota 10) | |
615 | (map (lambda (i) (array-ref bv i)) | |
616 | (iota 10))))) | |
617 | ||
618 | (pass-if "array-set!" | |
619 | (let ((bv (make-bytevector 10))) | |
620 | (for-each (lambda (i) | |
621 | (array-set! bv i i)) | |
622 | (iota 10)) | |
623 | (equal? (iota 10) | |
624 | (bytevector->u8-list bv)))) | |
625 | ||
626 | (pass-if "make-typed-array" | |
627 | (let ((bv (make-typed-array 'vu8 77 33))) | |
628 | (equal? bv (u8-list->bytevector (make-list 33 77))))) | |
629 | ||
630 | (pass-if-exception "make-typed-array [out-of-range]" | |
631 | exception:out-of-range | |
29553c54 | 632 | (make-typed-array 'vu8 256 77))) |
438974d0 | 633 | |
29553c54 LC |
634 | \f |
635 | (with-test-prefix "uniform-array->bytevector" | |
636 | ||
637 | (pass-if "bytevector" | |
438974d0 | 638 | (let ((bv #vu8(0 1 128 255))) |
29553c54 LC |
639 | (equal? bv (uniform-array->bytevector bv)))) |
640 | ||
641 | (pass-if "empty bitvector" | |
642 | (let ((bv (uniform-array->bytevector (make-bitvector 0)))) | |
643 | (equal? bv #vu8()))) | |
644 | ||
645 | (pass-if "bitvector < 8" | |
646 | (let ((bv (uniform-array->bytevector (make-bitvector 4 #t)))) | |
647 | (= (bytevector-length bv) 1))) | |
648 | ||
649 | (pass-if "bitvector == 8" | |
650 | (let ((bv (uniform-array->bytevector (make-bitvector 8 #t)))) | |
651 | (= (bytevector-length bv) 1))) | |
652 | ||
653 | (pass-if "bitvector > 8" | |
654 | (let ((bv (uniform-array->bytevector (make-bitvector 9 #t)))) | |
655 | (= (bytevector-length bv) 2)))) |