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