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 "{sint,uint}-list->bytevector"
150 (let ((b1 (sint-list->bytevector '(513 -253 513 513)
151 (endianness little) 2))
152 (b2 (uint-list->bytevector '(513 65283 513 513)
153 (endianness little) 2))
154 (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
155 (and (bytevector=? b1 b2)
156 (bytevector=? b2 b3)))))
159 (with-test-prefix "2.5 Operations on 16-Bit Integers"
161 (pass-if "bytevector-u16-ref"
162 (let ((b (u8-list->bytevector
163 '(255 255 255 255 255 255 255 255
164 255 255 255 255 255 255 255 253))))
165 (and (equal? (bytevector-u16-ref b 14 (endianness little))
167 (equal? (bytevector-u16-ref b 14 (endianness big))
170 (pass-if "bytevector-s16-ref"
171 (let ((b (u8-list->bytevector
172 '(255 255 255 255 255 255 255 255
173 255 255 255 255 255 255 255 253))))
174 (and (equal? (bytevector-s16-ref b 14 (endianness little))
176 (equal? (bytevector-s16-ref b 14 (endianness big))
179 (pass-if "bytevector-s16-ref [unaligned]"
180 (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
181 (equal? (bytevector-s16-ref b 1 (endianness little))
184 (pass-if "bytevector-{u16,s16}-ref"
185 (let ((b (make-bytevector 2)))
186 (bytevector-u16-set! b 0 44444 (endianness little))
187 (and (equal? (bytevector-u16-ref b 0 (endianness little))
189 (equal? (bytevector-s16-ref b 0 (endianness little))
192 (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
193 (let ((b (make-bytevector 2)))
194 (bytevector-u16-native-set! b 0 44444)
195 (and (equal? (bytevector-u16-native-ref b 0)
197 (equal? (bytevector-s16-native-ref b 0)
200 (pass-if "bytevector-s16-{ref,set!} [unaligned]"
201 (let ((b (make-bytevector 3)))
202 (bytevector-s16-set! b 1 -77 (endianness little))
203 (equal? (bytevector-s16-ref b 1 (endianness little))
207 (with-test-prefix "2.6 Operations on 32-bit Integers"
209 (pass-if "bytevector-u32-ref"
210 (let ((b (u8-list->bytevector
211 '(255 255 255 255 255 255 255 255
212 255 255 255 255 255 255 255 253))))
213 (and (equal? (bytevector-u32-ref b 12 (endianness little))
215 (equal? (bytevector-u32-ref b 12 (endianness big))
218 (pass-if "bytevector-s32-ref"
219 (let ((b (u8-list->bytevector
220 '(255 255 255 255 255 255 255 255
221 255 255 255 255 255 255 255 253))))
222 (and (equal? (bytevector-s32-ref b 12 (endianness little))
224 (equal? (bytevector-s32-ref b 12 (endianness big))
227 (pass-if "bytevector-{u32,s32}-ref"
228 (let ((b (make-bytevector 4)))
229 (bytevector-u32-set! b 0 2222222222 (endianness little))
230 (and (equal? (bytevector-u32-ref b 0 (endianness little))
232 (equal? (bytevector-s32-ref b 0 (endianness little))
233 (- 2222222222 (expt 2 32))))))
235 (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
236 (let ((b (make-bytevector 4)))
237 (bytevector-u32-native-set! b 0 2222222222)
238 (and (equal? (bytevector-u32-native-ref b 0)
240 (equal? (bytevector-s32-native-ref b 0)
241 (- 2222222222 (expt 2 32)))))))
244 (with-test-prefix "2.7 Operations on 64-bit Integers"
246 (pass-if "bytevector-u64-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-u64-ref b 8 (endianness little))
252 (equal? (bytevector-u64-ref b 8 (endianness big))
253 #xfffffffffffffffd))))
255 (pass-if "bytevector-s64-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-s64-ref b 8 (endianness little))
261 (equal? (bytevector-s64-ref b 8 (endianness big))
264 (pass-if "bytevector-{u64,s64}-ref"
265 (let ((b (make-bytevector 8))
266 (big 9333333333333333333))
267 (bytevector-u64-set! b 0 big (endianness little))
268 (and (equal? (bytevector-u64-ref b 0 (endianness little))
270 (equal? (bytevector-s64-ref b 0 (endianness little))
271 (- big (expt 2 64))))))
273 (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
274 (let ((b (make-bytevector 8))
275 (big 9333333333333333333))
276 (bytevector-u64-native-set! b 0 big)
277 (and (equal? (bytevector-u64-native-ref b 0)
279 (equal? (bytevector-s64-native-ref b 0)
280 (- big (expt 2 64))))))
282 (pass-if "ref/set! with zero"
283 (let ((b (make-bytevector 8)))
284 (bytevector-s64-set! b 0 -1 (endianness big))
285 (bytevector-u64-set! b 0 0 (endianness big))
286 (= 0 (bytevector-u64-ref b 0 (endianness big))))))
289 (with-test-prefix "2.8 Operations on IEEE-754 Representations"
291 (pass-if "bytevector-ieee-single-native-{ref,set!}"
292 (let ((b (make-bytevector 4))
294 (bytevector-ieee-single-native-set! b 0 number)
295 (equal? (bytevector-ieee-single-native-ref b 0)
298 (pass-if "bytevector-ieee-single-{ref,set!}"
299 (let ((b (make-bytevector 8))
301 (bytevector-ieee-single-set! b 0 number (endianness little))
302 (bytevector-ieee-single-set! b 4 number (endianness big))
303 (equal? (bytevector-ieee-single-ref b 0 (endianness little))
304 (bytevector-ieee-single-ref b 4 (endianness big)))))
306 (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
307 (let ((b (make-bytevector 9))
309 (bytevector-ieee-single-set! b 1 number (endianness little))
310 (bytevector-ieee-single-set! b 5 number (endianness big))
311 (equal? (bytevector-ieee-single-ref b 1 (endianness little))
312 (bytevector-ieee-single-ref b 5 (endianness big)))))
314 (pass-if "bytevector-ieee-double-native-{ref,set!}"
315 (let ((b (make-bytevector 8))
317 (bytevector-ieee-double-native-set! b 0 number)
318 (equal? (bytevector-ieee-double-native-ref b 0)
321 (pass-if "bytevector-ieee-double-{ref,set!}"
322 (let ((b (make-bytevector 16))
324 (bytevector-ieee-double-set! b 0 number (endianness little))
325 (bytevector-ieee-double-set! b 8 number (endianness big))
326 (equal? (bytevector-ieee-double-ref b 0 (endianness little))
327 (bytevector-ieee-double-ref b 8 (endianness big))))))
330 (define (with-locale locale thunk)
331 ;; Run THUNK under LOCALE.
332 (let ((original-locale (setlocale LC_ALL)))
335 (setlocale LC_ALL locale))
337 (throw 'unresolved)))
344 (setlocale LC_ALL original-locale)))))
346 (define (with-latin1-locale thunk)
347 ;; Try out several ISO-8859-1 locales and run THUNK under the one that
351 (string-append name ".ISO-8859-1"))
352 '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
354 (let loop ((locales %locales))
359 (with-locale (car locales) thunk))
361 (loop (cdr locales)))))))
364 ;; Default to the C locale for the following tests.
365 (setlocale LC_ALL "C")
368 (with-test-prefix "2.9 Operations on Strings"
370 (pass-if "string->utf8"
371 (let* ((str "hello, world")
372 (utf8 (string->utf8 str)))
373 (and (bytevector? utf8)
374 (= (bytevector-length utf8)
376 (equal? (string->list str)
377 (map integer->char (bytevector->u8-list utf8))))))
379 (pass-if "string->utf8 [latin-1]"
382 (let* ((str "hé, ça va bien ?")
383 (utf8 (string->utf8 str)))
384 (and (bytevector? utf8)
385 (= (bytevector-length utf8)
386 (+ 2 (string-length str))))))))
388 (pass-if "string->utf16"
389 (let* ((str "hello, world")
390 (utf16 (string->utf16 str)))
391 (and (bytevector? utf16)
392 (= (bytevector-length utf16)
393 (* 2 (string-length str)))
394 (equal? (string->list str)
396 (bytevector->uint-list utf16
397 (endianness big) 2))))))
399 (pass-if "string->utf16 [little]"
400 (let* ((str "hello, world")
401 (utf16 (string->utf16 str (endianness little))))
402 (and (bytevector? utf16)
403 (= (bytevector-length utf16)
404 (* 2 (string-length str)))
405 (equal? (string->list str)
407 (bytevector->uint-list utf16
408 (endianness little) 2))))))
411 (pass-if "string->utf32"
412 (let* ((str "hello, world")
413 (utf32 (string->utf32 str)))
414 (and (bytevector? utf32)
415 (= (bytevector-length utf32)
416 (* 4 (string-length str)))
417 (equal? (string->list str)
419 (bytevector->uint-list utf32
420 (endianness big) 4))))))
422 (pass-if "string->utf32 [little]"
423 (let* ((str "hello, world")
424 (utf32 (string->utf32 str (endianness little))))
425 (and (bytevector? utf32)
426 (= (bytevector-length utf32)
427 (* 4 (string-length str)))
428 (equal? (string->list str)
430 (bytevector->uint-list utf32
431 (endianness little) 4))))))
433 (pass-if "utf8->string"
434 (let* ((utf8 (u8-list->bytevector (map char->integer
435 (string->list "hello, world"))))
436 (str (utf8->string utf8)))
438 (= (string-length str)
439 (bytevector-length utf8))
440 (equal? (string->list str)
441 (map integer->char (bytevector->u8-list utf8))))))
443 (pass-if "utf8->string [latin-1]"
446 (let* ((utf8 (string->utf8 "hé, ça va bien ?"))
447 (str (utf8->string utf8)))
449 (= (string-length str)
450 (- (bytevector-length utf8) 2)))))))
452 (pass-if "utf16->string"
453 (let* ((utf16 (uint-list->bytevector (map char->integer
454 (string->list "hello, world"))
456 (str (utf16->string utf16)))
458 (= (* 2 (string-length str))
459 (bytevector-length utf16))
460 (equal? (string->list str)
462 (bytevector->uint-list utf16 (endianness big)
465 (pass-if "utf16->string [little]"
466 (let* ((utf16 (uint-list->bytevector (map char->integer
467 (string->list "hello, world"))
468 (endianness little) 2))
469 (str (utf16->string utf16 (endianness little))))
471 (= (* 2 (string-length str))
472 (bytevector-length utf16))
473 (equal? (string->list str)
475 (bytevector->uint-list utf16 (endianness little)
477 (pass-if "utf32->string"
478 (let* ((utf32 (uint-list->bytevector (map char->integer
479 (string->list "hello, world"))
481 (str (utf32->string utf32)))
483 (= (* 4 (string-length str))
484 (bytevector-length utf32))
485 (equal? (string->list str)
487 (bytevector->uint-list utf32 (endianness big)
490 (pass-if "utf32->string [little]"
491 (let* ((utf32 (uint-list->bytevector (map char->integer
492 (string->list "hello, world"))
493 (endianness little) 4))
494 (str (utf32->string utf32 (endianness little))))
496 (= (* 4 (string-length str))
497 (bytevector-length utf32))
498 (equal? (string->list str)
500 (bytevector->uint-list utf32 (endianness little)