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)
126 '(#xff #xf0 #xff)))))
129 (with-test-prefix "2.4 Operations on Integers of Arbitrary Size"
131 (pass-if "bytevector->sint-list"
132 (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
133 (equal? (bytevector->sint-list b (endianness little) 2)
134 '(513 -253 513 513))))
136 (pass-if "bytevector->uint-list"
137 (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1))))
138 (equal? (bytevector->uint-list b (endianness big) 2)
139 '(513 65283 513 513))))
141 (pass-if "bytevector->uint-list [empty]"
142 (let ((b (make-bytevector 0)))
143 (null? (bytevector->uint-list b (endianness big) 2))))
145 (pass-if-exception "bytevector->sint-list [out-of-range]"
146 exception:out-of-range
147 (bytevector->sint-list (make-bytevector 6) (endianness little) 8))
149 (pass-if "bytevector->sint-list [off-by-one]"
150 (equal? (bytevector->sint-list (make-bytevector 31 #xff)
151 (endianness little) 8)
154 (pass-if "{sint,uint}-list->bytevector"
155 (let ((b1 (sint-list->bytevector '(513 -253 513 513)
156 (endianness little) 2))
157 (b2 (uint-list->bytevector '(513 65283 513 513)
158 (endianness little) 2))
159 (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
160 (and (bytevector=? b1 b2)
161 (bytevector=? b2 b3))))
163 (pass-if "sint-list->bytevector [limits]"
164 (bytevector=? (sint-list->bytevector '(-32768 32767)
166 (let ((bv (make-bytevector 4)))
167 (bytevector-u8-set! bv 0 #x80)
168 (bytevector-u8-set! bv 1 #x00)
169 (bytevector-u8-set! bv 2 #x7f)
170 (bytevector-u8-set! bv 3 #xff)
173 (pass-if-exception "sint-list->bytevector [out-of-range]"
174 exception:out-of-range
175 (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)
178 (pass-if-exception "uint-list->bytevector [out-of-range]"
179 exception:out-of-range
180 (uint-list->bytevector '(0 -1) (endianness big) 2)))
183 (with-test-prefix "2.5 Operations on 16-Bit Integers"
185 (pass-if "bytevector-u16-ref"
186 (let ((b (u8-list->bytevector
187 '(255 255 255 255 255 255 255 255
188 255 255 255 255 255 255 255 253))))
189 (and (equal? (bytevector-u16-ref b 14 (endianness little))
191 (equal? (bytevector-u16-ref b 14 (endianness big))
194 (pass-if "bytevector-s16-ref"
195 (let ((b (u8-list->bytevector
196 '(255 255 255 255 255 255 255 255
197 255 255 255 255 255 255 255 253))))
198 (and (equal? (bytevector-s16-ref b 14 (endianness little))
200 (equal? (bytevector-s16-ref b 14 (endianness big))
203 (pass-if "bytevector-s16-ref [unaligned]"
204 (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
205 (equal? (bytevector-s16-ref b 1 (endianness little))
208 (pass-if "bytevector-{u16,s16}-ref"
209 (let ((b (make-bytevector 2)))
210 (bytevector-u16-set! b 0 44444 (endianness little))
211 (and (equal? (bytevector-u16-ref b 0 (endianness little))
213 (equal? (bytevector-s16-ref b 0 (endianness little))
216 (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
217 (let ((b (make-bytevector 2)))
218 (bytevector-u16-native-set! b 0 44444)
219 (and (equal? (bytevector-u16-native-ref b 0)
221 (equal? (bytevector-s16-native-ref b 0)
224 (pass-if "bytevector-s16-{ref,set!} [unaligned]"
225 (let ((b (make-bytevector 3)))
226 (bytevector-s16-set! b 1 -77 (endianness little))
227 (equal? (bytevector-s16-ref b 1 (endianness little))
231 (with-test-prefix "2.6 Operations on 32-bit Integers"
233 (pass-if "bytevector-u32-ref"
234 (let ((b (u8-list->bytevector
235 '(255 255 255 255 255 255 255 255
236 255 255 255 255 255 255 255 253))))
237 (and (equal? (bytevector-u32-ref b 12 (endianness little))
239 (equal? (bytevector-u32-ref b 12 (endianness big))
242 (pass-if "bytevector-s32-ref"
243 (let ((b (u8-list->bytevector
244 '(255 255 255 255 255 255 255 255
245 255 255 255 255 255 255 255 253))))
246 (and (equal? (bytevector-s32-ref b 12 (endianness little))
248 (equal? (bytevector-s32-ref b 12 (endianness big))
251 (pass-if "bytevector-{u32,s32}-ref"
252 (let ((b (make-bytevector 4)))
253 (bytevector-u32-set! b 0 2222222222 (endianness little))
254 (and (equal? (bytevector-u32-ref b 0 (endianness little))
256 (equal? (bytevector-s32-ref b 0 (endianness little))
257 (- 2222222222 (expt 2 32))))))
259 (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
260 (let ((b (make-bytevector 4)))
261 (bytevector-u32-native-set! b 0 2222222222)
262 (and (equal? (bytevector-u32-native-ref b 0)
264 (equal? (bytevector-s32-native-ref b 0)
265 (- 2222222222 (expt 2 32)))))))
268 (with-test-prefix "2.7 Operations on 64-bit Integers"
270 (pass-if "bytevector-u64-ref"
271 (let ((b (u8-list->bytevector
272 '(255 255 255 255 255 255 255 255
273 255 255 255 255 255 255 255 253))))
274 (and (equal? (bytevector-u64-ref b 8 (endianness little))
276 (equal? (bytevector-u64-ref b 8 (endianness big))
277 #xfffffffffffffffd))))
279 (pass-if "bytevector-s64-ref"
280 (let ((b (u8-list->bytevector
281 '(255 255 255 255 255 255 255 255
282 255 255 255 255 255 255 255 253))))
283 (and (equal? (bytevector-s64-ref b 8 (endianness little))
285 (equal? (bytevector-s64-ref b 8 (endianness big))
288 (pass-if "bytevector-{u64,s64}-ref"
289 (let ((b (make-bytevector 8))
290 (big 9333333333333333333))
291 (bytevector-u64-set! b 0 big (endianness little))
292 (and (equal? (bytevector-u64-ref b 0 (endianness little))
294 (equal? (bytevector-s64-ref b 0 (endianness little))
295 (- big (expt 2 64))))))
297 (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
298 (let ((b (make-bytevector 8))
299 (big 9333333333333333333))
300 (bytevector-u64-native-set! b 0 big)
301 (and (equal? (bytevector-u64-native-ref b 0)
303 (equal? (bytevector-s64-native-ref b 0)
304 (- big (expt 2 64))))))
306 (pass-if "ref/set! with zero"
307 (let ((b (make-bytevector 8)))
308 (bytevector-s64-set! b 0 -1 (endianness big))
309 (bytevector-u64-set! b 0 0 (endianness big))
310 (= 0 (bytevector-u64-ref b 0 (endianness big))))))
313 (with-test-prefix "2.8 Operations on IEEE-754 Representations"
315 (pass-if "bytevector-ieee-single-native-{ref,set!}"
316 (let ((b (make-bytevector 4))
318 (bytevector-ieee-single-native-set! b 0 number)
319 (equal? (bytevector-ieee-single-native-ref b 0)
322 (pass-if "bytevector-ieee-single-{ref,set!}"
323 (let ((b (make-bytevector 8))
325 (bytevector-ieee-single-set! b 0 number (endianness little))
326 (bytevector-ieee-single-set! b 4 number (endianness big))
327 (equal? (bytevector-ieee-single-ref b 0 (endianness little))
328 (bytevector-ieee-single-ref b 4 (endianness big)))))
330 (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
331 (let ((b (make-bytevector 9))
333 (bytevector-ieee-single-set! b 1 number (endianness little))
334 (bytevector-ieee-single-set! b 5 number (endianness big))
335 (equal? (bytevector-ieee-single-ref b 1 (endianness little))
336 (bytevector-ieee-single-ref b 5 (endianness big)))))
338 (pass-if "bytevector-ieee-double-native-{ref,set!}"
339 (let ((b (make-bytevector 8))
341 (bytevector-ieee-double-native-set! b 0 number)
342 (equal? (bytevector-ieee-double-native-ref b 0)
345 (pass-if "bytevector-ieee-double-{ref,set!}"
346 (let ((b (make-bytevector 16))
348 (bytevector-ieee-double-set! b 0 number (endianness little))
349 (bytevector-ieee-double-set! b 8 number (endianness big))
350 (equal? (bytevector-ieee-double-ref b 0 (endianness little))
351 (bytevector-ieee-double-ref b 8 (endianness big))))))
354 (define (with-locale locale thunk)
355 ;; Run THUNK under LOCALE.
356 (let ((original-locale (setlocale LC_ALL)))
359 (setlocale LC_ALL locale))
361 (throw 'unresolved)))
368 (setlocale LC_ALL original-locale)))))
370 (define (with-latin1-locale thunk)
371 ;; Try out several ISO-8859-1 locales and run THUNK under the one that
375 (string-append name ".ISO-8859-1"))
376 '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
378 (let loop ((locales %locales))
383 (with-locale (car locales) thunk))
385 (loop (cdr locales)))))))
388 ;; Default to the C locale for the following tests.
389 (setlocale LC_ALL "C")
392 (with-test-prefix "2.9 Operations on Strings"
394 (pass-if "string->utf8"
395 (let* ((str "hello, world")
396 (utf8 (string->utf8 str)))
397 (and (bytevector? utf8)
398 (= (bytevector-length utf8)
400 (equal? (string->list str)
401 (map integer->char (bytevector->u8-list utf8))))))
403 (pass-if "string->utf8 [latin-1]"
406 (let* ((str "hé, ça va bien ?")
407 (utf8 (string->utf8 str)))
408 (and (bytevector? utf8)
409 (= (bytevector-length utf8)
410 (+ 2 (string-length str))))))))
412 (pass-if "string->utf16"
413 (let* ((str "hello, world")
414 (utf16 (string->utf16 str)))
415 (and (bytevector? utf16)
416 (= (bytevector-length utf16)
417 (* 2 (string-length str)))
418 (equal? (string->list str)
420 (bytevector->uint-list utf16
421 (endianness big) 2))))))
423 (pass-if "string->utf16 [little]"
424 (let* ((str "hello, world")
425 (utf16 (string->utf16 str (endianness little))))
426 (and (bytevector? utf16)
427 (= (bytevector-length utf16)
428 (* 2 (string-length str)))
429 (equal? (string->list str)
431 (bytevector->uint-list utf16
432 (endianness little) 2))))))
435 (pass-if "string->utf32"
436 (let* ((str "hello, world")
437 (utf32 (string->utf32 str)))
438 (and (bytevector? utf32)
439 (= (bytevector-length utf32)
440 (* 4 (string-length str)))
441 (equal? (string->list str)
443 (bytevector->uint-list utf32
444 (endianness big) 4))))))
446 (pass-if "string->utf32 [little]"
447 (let* ((str "hello, world")
448 (utf32 (string->utf32 str (endianness little))))
449 (and (bytevector? utf32)
450 (= (bytevector-length utf32)
451 (* 4 (string-length str)))
452 (equal? (string->list str)
454 (bytevector->uint-list utf32
455 (endianness little) 4))))))
457 (pass-if "utf8->string"
458 (let* ((utf8 (u8-list->bytevector (map char->integer
459 (string->list "hello, world"))))
460 (str (utf8->string utf8)))
462 (= (string-length str)
463 (bytevector-length utf8))
464 (equal? (string->list str)
465 (map integer->char (bytevector->u8-list utf8))))))
467 (pass-if "utf8->string [latin-1]"
470 (let* ((utf8 (string->utf8 "hé, ça va bien ?"))
471 (str (utf8->string utf8)))
473 (= (string-length str)
474 (- (bytevector-length utf8) 2)))))))
476 (pass-if "utf16->string"
477 (let* ((utf16 (uint-list->bytevector (map char->integer
478 (string->list "hello, world"))
480 (str (utf16->string utf16)))
482 (= (* 2 (string-length str))
483 (bytevector-length utf16))
484 (equal? (string->list str)
486 (bytevector->uint-list utf16 (endianness big)
489 (pass-if "utf16->string [little]"
490 (let* ((utf16 (uint-list->bytevector (map char->integer
491 (string->list "hello, world"))
492 (endianness little) 2))
493 (str (utf16->string utf16 (endianness little))))
495 (= (* 2 (string-length str))
496 (bytevector-length utf16))
497 (equal? (string->list str)
499 (bytevector->uint-list utf16 (endianness little)
501 (pass-if "utf32->string"
502 (let* ((utf32 (uint-list->bytevector (map char->integer
503 (string->list "hello, world"))
505 (str (utf32->string utf32)))
507 (= (* 4 (string-length str))
508 (bytevector-length utf32))
509 (equal? (string->list str)
511 (bytevector->uint-list utf32 (endianness big)
514 (pass-if "utf32->string [little]"
515 (let* ((utf32 (uint-list->bytevector (map char->integer
516 (string->list "hello, world"))
517 (endianness little) 4))
518 (str (utf32->string utf32 (endianness little))))
520 (= (* 4 (string-length str))
521 (bytevector-length utf32))
522 (equal? (string->list str)
524 (bytevector->uint-list utf32 (endianness little)