3 ;;; Copyright 2007, 2009 Ludovic Courtès <ludo@gnu.org>
6 ;;; This program is free software; you can redistribute it and/or modify
7 ;;; it under the terms of the GNU General Public License as published by
8 ;;; the Free Software Foundation; either version 2 of the License, or
9 ;;; (at your option) any later version.
11 ;;; This program 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
14 ;;; GNU General Public License for more details.
16 ;;; You should have received a copy of the GNU General Public License
17 ;;; along with this program; if not, write to the Free Software
18 ;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA
20 (define-module (test-bytevector)
21 :use-module (test-suite lib)
22 :use-module (rnrs bytevector))
24 ;;; Some of the tests in here are examples taken from the R6RS Standard
25 ;;; Libraries document.
28 (with-test-prefix "2.2 General Operations"
30 (pass-if "native-endianness"
31 (not (not (memq (native-endianness) '(big little)))))
33 (pass-if "make-bytevector"
34 (and (bytevector? (make-bytevector 20))
35 (bytevector? (make-bytevector 20 3))))
37 (pass-if "bytevector-length"
38 (= (bytevector-length (make-bytevector 20)) 20))
40 (pass-if "bytevector=?"
41 (and (bytevector=? (make-bytevector 20 7)
42 (make-bytevector 20 7))
43 (not (bytevector=? (make-bytevector 20 7)
44 (make-bytevector 20 0))))))
47 (with-test-prefix "2.3 Operations on Bytes and Octets"
49 (pass-if "bytevector-{u8,s8}-ref"
50 (equal? '(-127 129 -1 255)
51 (let ((b1 (make-bytevector 16 -127))
52 (b2 (make-bytevector 16 255)))
53 (list (bytevector-s8-ref b1 0)
54 (bytevector-u8-ref b1 0)
55 (bytevector-s8-ref b2 0)
56 (bytevector-u8-ref b2 0)))))
58 (pass-if "bytevector-{u8,s8}-set!"
59 (equal? '(-126 130 -10 246)
60 (let ((b (make-bytevector 16 -127)))
62 (bytevector-s8-set! b 0 -126)
63 (bytevector-u8-set! b 1 246)
65 (list (bytevector-s8-ref b 0)
66 (bytevector-u8-ref b 0)
67 (bytevector-s8-ref b 1)
68 (bytevector-u8-ref b 1)))))
70 (pass-if "bytevector->u8-list"
71 (let ((lst '(1 2 3 128 150 255)))
74 (let ((b (make-bytevector 6)))
75 (for-each (lambda (i v)
76 (bytevector-u8-set! b i v))
81 (pass-if "u8-list->bytevector"
82 (let ((lst '(1 2 3 128 150 255)))
84 (bytevector->u8-list (u8-list->bytevector lst)))))
86 (pass-if "bytevector-uint-{ref,set!} [small]"
87 (let ((b (make-bytevector 15)))
88 (bytevector-uint-set! b 0 #x1234
89 (endianness little) 2)
90 (equal? (bytevector-uint-ref b 0 (endianness big) 2)
93 (pass-if "bytevector-uint-set! [large]"
94 (let ((b (make-bytevector 16)))
95 (bytevector-uint-set! b 0 (- (expt 2 128) 3)
96 (endianness little) 16)
97 (equal? (bytevector->u8-list b)
98 '(253 255 255 255 255 255 255 255
99 255 255 255 255 255 255 255 255))))
101 (pass-if "bytevector-uint-{ref,set!} [large]"
102 (let ((b (make-bytevector 120)))
103 (bytevector-uint-set! b 0 (- (expt 2 128) 3)
104 (endianness little) 16)
105 (equal? (bytevector-uint-ref b 0 (endianness little) 16)
106 #xfffffffffffffffffffffffffffffffd)))
108 (pass-if "bytevector-sint-ref [small]"
109 (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
110 (equal? (bytevector-sint-ref b 0 (endianness big) 2)
111 (bytevector-sint-ref b 1 (endianness little) 2)
114 (pass-if "bytevector-sint-ref [large]"
115 (let ((b (make-bytevector 50)))
116 (bytevector-uint-set! b 0 (- (expt 2 128) 3)
117 (endianness little) 16)
118 (equal? (bytevector-sint-ref b 0 (endianness little) 16)
121 (pass-if "bytevector-sint-set! [small]"
122 (let ((b (make-bytevector 3)))
123 (bytevector-sint-set! b 0 -16 (endianness big) 2)
124 (bytevector-sint-set! b 1 -16 (endianness little) 2)
125 (equal? (bytevector->u8-list b)
129 (let ((bv1 (u8-list->bytevector (iota 123)))
130 (bv2 (u8-list->bytevector (iota 123))))
134 (with-test-prefix "2.4 Operations on Integers of Arbitrary Size"
136 (pass-if "bytevector->sint-list"
137 (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
138 (equal? (bytevector->sint-list b (endianness little) 2)
139 '(513 -253 513 513))))
141 (pass-if "bytevector->uint-list"
142 (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1))))
143 (equal? (bytevector->uint-list b (endianness big) 2)
144 '(513 65283 513 513))))
146 (pass-if "bytevector->uint-list [empty]"
147 (let ((b (make-bytevector 0)))
148 (null? (bytevector->uint-list b (endianness big) 2))))
150 (pass-if-exception "bytevector->sint-list [out-of-range]"
151 exception:out-of-range
152 (bytevector->sint-list (make-bytevector 6) (endianness little) 8))
154 (pass-if "bytevector->sint-list [off-by-one]"
155 (equal? (bytevector->sint-list (make-bytevector 31 #xff)
156 (endianness little) 8)
159 (pass-if "{sint,uint}-list->bytevector"
160 (let ((b1 (sint-list->bytevector '(513 -253 513 513)
161 (endianness little) 2))
162 (b2 (uint-list->bytevector '(513 65283 513 513)
163 (endianness little) 2))
164 (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
165 (and (bytevector=? b1 b2)
166 (bytevector=? b2 b3))))
168 (pass-if "sint-list->bytevector [limits]"
169 (bytevector=? (sint-list->bytevector '(-32768 32767)
171 (let ((bv (make-bytevector 4)))
172 (bytevector-u8-set! bv 0 #x80)
173 (bytevector-u8-set! bv 1 #x00)
174 (bytevector-u8-set! bv 2 #x7f)
175 (bytevector-u8-set! bv 3 #xff)
178 (pass-if-exception "sint-list->bytevector [out-of-range]"
179 exception:out-of-range
180 (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)
183 (pass-if-exception "uint-list->bytevector [out-of-range]"
184 exception:out-of-range
185 (uint-list->bytevector '(0 -1) (endianness big) 2)))
188 (with-test-prefix "2.5 Operations on 16-Bit Integers"
190 (pass-if "bytevector-u16-ref"
191 (let ((b (u8-list->bytevector
192 '(255 255 255 255 255 255 255 255
193 255 255 255 255 255 255 255 253))))
194 (and (equal? (bytevector-u16-ref b 14 (endianness little))
196 (equal? (bytevector-u16-ref b 14 (endianness big))
199 (pass-if "bytevector-s16-ref"
200 (let ((b (u8-list->bytevector
201 '(255 255 255 255 255 255 255 255
202 255 255 255 255 255 255 255 253))))
203 (and (equal? (bytevector-s16-ref b 14 (endianness little))
205 (equal? (bytevector-s16-ref b 14 (endianness big))
208 (pass-if "bytevector-s16-ref [unaligned]"
209 (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
210 (equal? (bytevector-s16-ref b 1 (endianness little))
213 (pass-if "bytevector-{u16,s16}-ref"
214 (let ((b (make-bytevector 2)))
215 (bytevector-u16-set! b 0 44444 (endianness little))
216 (and (equal? (bytevector-u16-ref b 0 (endianness little))
218 (equal? (bytevector-s16-ref b 0 (endianness little))
221 (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
222 (let ((b (make-bytevector 2)))
223 (bytevector-u16-native-set! b 0 44444)
224 (and (equal? (bytevector-u16-native-ref b 0)
226 (equal? (bytevector-s16-native-ref b 0)
229 (pass-if "bytevector-s16-{ref,set!} [unaligned]"
230 (let ((b (make-bytevector 3)))
231 (bytevector-s16-set! b 1 -77 (endianness little))
232 (equal? (bytevector-s16-ref b 1 (endianness little))
236 (with-test-prefix "2.6 Operations on 32-bit Integers"
238 (pass-if "bytevector-u32-ref"
239 (let ((b (u8-list->bytevector
240 '(255 255 255 255 255 255 255 255
241 255 255 255 255 255 255 255 253))))
242 (and (equal? (bytevector-u32-ref b 12 (endianness little))
244 (equal? (bytevector-u32-ref b 12 (endianness big))
247 (pass-if "bytevector-s32-ref"
248 (let ((b (u8-list->bytevector
249 '(255 255 255 255 255 255 255 255
250 255 255 255 255 255 255 255 253))))
251 (and (equal? (bytevector-s32-ref b 12 (endianness little))
253 (equal? (bytevector-s32-ref b 12 (endianness big))
256 (pass-if "bytevector-{u32,s32}-ref"
257 (let ((b (make-bytevector 4)))
258 (bytevector-u32-set! b 0 2222222222 (endianness little))
259 (and (equal? (bytevector-u32-ref b 0 (endianness little))
261 (equal? (bytevector-s32-ref b 0 (endianness little))
262 (- 2222222222 (expt 2 32))))))
264 (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
265 (let ((b (make-bytevector 4)))
266 (bytevector-u32-native-set! b 0 2222222222)
267 (and (equal? (bytevector-u32-native-ref b 0)
269 (equal? (bytevector-s32-native-ref b 0)
270 (- 2222222222 (expt 2 32)))))))
273 (with-test-prefix "2.7 Operations on 64-bit Integers"
275 (pass-if "bytevector-u64-ref"
276 (let ((b (u8-list->bytevector
277 '(255 255 255 255 255 255 255 255
278 255 255 255 255 255 255 255 253))))
279 (and (equal? (bytevector-u64-ref b 8 (endianness little))
281 (equal? (bytevector-u64-ref b 8 (endianness big))
282 #xfffffffffffffffd))))
284 (pass-if "bytevector-s64-ref"
285 (let ((b (u8-list->bytevector
286 '(255 255 255 255 255 255 255 255
287 255 255 255 255 255 255 255 253))))
288 (and (equal? (bytevector-s64-ref b 8 (endianness little))
290 (equal? (bytevector-s64-ref b 8 (endianness big))
293 (pass-if "bytevector-{u64,s64}-ref"
294 (let ((b (make-bytevector 8))
295 (big 9333333333333333333))
296 (bytevector-u64-set! b 0 big (endianness little))
297 (and (equal? (bytevector-u64-ref b 0 (endianness little))
299 (equal? (bytevector-s64-ref b 0 (endianness little))
300 (- big (expt 2 64))))))
302 (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
303 (let ((b (make-bytevector 8))
304 (big 9333333333333333333))
305 (bytevector-u64-native-set! b 0 big)
306 (and (equal? (bytevector-u64-native-ref b 0)
308 (equal? (bytevector-s64-native-ref b 0)
309 (- big (expt 2 64))))))
311 (pass-if "ref/set! with zero"
312 (let ((b (make-bytevector 8)))
313 (bytevector-s64-set! b 0 -1 (endianness big))
314 (bytevector-u64-set! b 0 0 (endianness big))
315 (= 0 (bytevector-u64-ref b 0 (endianness big))))))
318 (with-test-prefix "2.8 Operations on IEEE-754 Representations"
320 (pass-if "bytevector-ieee-single-native-{ref,set!}"
321 (let ((b (make-bytevector 4))
323 (bytevector-ieee-single-native-set! b 0 number)
324 (equal? (bytevector-ieee-single-native-ref b 0)
327 (pass-if "bytevector-ieee-single-{ref,set!}"
328 (let ((b (make-bytevector 8))
330 (bytevector-ieee-single-set! b 0 number (endianness little))
331 (bytevector-ieee-single-set! b 4 number (endianness big))
332 (equal? (bytevector-ieee-single-ref b 0 (endianness little))
333 (bytevector-ieee-single-ref b 4 (endianness big)))))
335 (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
336 (let ((b (make-bytevector 9))
338 (bytevector-ieee-single-set! b 1 number (endianness little))
339 (bytevector-ieee-single-set! b 5 number (endianness big))
340 (equal? (bytevector-ieee-single-ref b 1 (endianness little))
341 (bytevector-ieee-single-ref b 5 (endianness big)))))
343 (pass-if "bytevector-ieee-double-native-{ref,set!}"
344 (let ((b (make-bytevector 8))
346 (bytevector-ieee-double-native-set! b 0 number)
347 (equal? (bytevector-ieee-double-native-ref b 0)
350 (pass-if "bytevector-ieee-double-{ref,set!}"
351 (let ((b (make-bytevector 16))
353 (bytevector-ieee-double-set! b 0 number (endianness little))
354 (bytevector-ieee-double-set! b 8 number (endianness big))
355 (equal? (bytevector-ieee-double-ref b 0 (endianness little))
356 (bytevector-ieee-double-ref b 8 (endianness big))))))
359 (define (with-locale locale thunk)
360 ;; Run THUNK under LOCALE.
361 (let ((original-locale (setlocale LC_ALL)))
364 (setlocale LC_ALL locale))
366 (throw 'unresolved)))
373 (setlocale LC_ALL original-locale)))))
375 (define (with-latin1-locale thunk)
376 ;; Try out several ISO-8859-1 locales and run THUNK under the one that
380 (string-append name ".ISO-8859-1"))
381 '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
383 (let loop ((locales %locales))
388 (with-locale (car locales) thunk))
390 (loop (cdr locales)))))))
393 ;; Default to the C locale for the following tests.
394 (setlocale LC_ALL "C")
397 (with-test-prefix "2.9 Operations on Strings"
399 (pass-if "string->utf8"
400 (let* ((str "hello, world")
401 (utf8 (string->utf8 str)))
402 (and (bytevector? utf8)
403 (= (bytevector-length utf8)
405 (equal? (string->list str)
406 (map integer->char (bytevector->u8-list utf8))))))
408 (pass-if "string->utf8 [latin-1]"
411 (let* ((str "hé, ça va bien ?")
412 (utf8 (string->utf8 str)))
413 (and (bytevector? utf8)
414 (= (bytevector-length utf8)
415 (+ 2 (string-length str))))))))
417 (pass-if "string->utf16"
418 (let* ((str "hello, world")
419 (utf16 (string->utf16 str)))
420 (and (bytevector? utf16)
421 (= (bytevector-length utf16)
422 (* 2 (string-length str)))
423 (equal? (string->list str)
425 (bytevector->uint-list utf16
426 (endianness big) 2))))))
428 (pass-if "string->utf16 [little]"
429 (let* ((str "hello, world")
430 (utf16 (string->utf16 str (endianness little))))
431 (and (bytevector? utf16)
432 (= (bytevector-length utf16)
433 (* 2 (string-length str)))
434 (equal? (string->list str)
436 (bytevector->uint-list utf16
437 (endianness little) 2))))))
440 (pass-if "string->utf32"
441 (let* ((str "hello, world")
442 (utf32 (string->utf32 str)))
443 (and (bytevector? utf32)
444 (= (bytevector-length utf32)
445 (* 4 (string-length str)))
446 (equal? (string->list str)
448 (bytevector->uint-list utf32
449 (endianness big) 4))))))
451 (pass-if "string->utf32 [little]"
452 (let* ((str "hello, world")
453 (utf32 (string->utf32 str (endianness little))))
454 (and (bytevector? utf32)
455 (= (bytevector-length utf32)
456 (* 4 (string-length str)))
457 (equal? (string->list str)
459 (bytevector->uint-list utf32
460 (endianness little) 4))))))
462 (pass-if "utf8->string"
463 (let* ((utf8 (u8-list->bytevector (map char->integer
464 (string->list "hello, world"))))
465 (str (utf8->string utf8)))
467 (= (string-length str)
468 (bytevector-length utf8))
469 (equal? (string->list str)
470 (map integer->char (bytevector->u8-list utf8))))))
472 (pass-if "utf8->string [latin-1]"
475 (let* ((utf8 (string->utf8 "hé, ça va bien ?"))
476 (str (utf8->string utf8)))
478 (= (string-length str)
479 (- (bytevector-length utf8) 2)))))))
481 (pass-if "utf16->string"
482 (let* ((utf16 (uint-list->bytevector (map char->integer
483 (string->list "hello, world"))
485 (str (utf16->string utf16)))
487 (= (* 2 (string-length str))
488 (bytevector-length utf16))
489 (equal? (string->list str)
491 (bytevector->uint-list utf16 (endianness big)
494 (pass-if "utf16->string [little]"
495 (let* ((utf16 (uint-list->bytevector (map char->integer
496 (string->list "hello, world"))
497 (endianness little) 2))
498 (str (utf16->string utf16 (endianness little))))
500 (= (* 2 (string-length str))
501 (bytevector-length utf16))
502 (equal? (string->list str)
504 (bytevector->uint-list utf16 (endianness little)
506 (pass-if "utf32->string"
507 (let* ((utf32 (uint-list->bytevector (map char->integer
508 (string->list "hello, world"))
510 (str (utf32->string utf32)))
512 (= (* 4 (string-length str))
513 (bytevector-length utf32))
514 (equal? (string->list str)
516 (bytevector->uint-list utf32 (endianness big)
519 (pass-if "utf32->string [little]"
520 (let* ((utf32 (uint-list->bytevector (map char->integer
521 (string->list "hello, world"))
522 (endianness little) 4))
523 (str (utf32->string utf32 (endianness little))))
525 (= (* 4 (string-length str))
526 (bytevector-length utf32))
527 (equal? (string->list str)
529 (bytevector->uint-list utf32 (endianness little)