3 ;;; Copyright 2007 Ludovic Courtès <ludovic.courtes@laas.fr>
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 (r6rs 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 "{sint,uint}-list->bytevector"
146 (let ((b1 (sint-list->bytevector '(513 -253 513 513)
147 (endianness little) 2))
148 (b2 (uint-list->bytevector '(513 65283 513 513)
149 (endianness little) 2))
150 (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
151 (and (bytevector=? b1 b2)
152 (bytevector=? b2 b3)))))
155 (with-test-prefix "2.5 Operations on 16-Bit Integers"
157 (pass-if "bytevector-u16-ref"
158 (let ((b (u8-list->bytevector
159 '(255 255 255 255 255 255 255 255
160 255 255 255 255 255 255 255 253))))
161 (and (equal? (bytevector-u16-ref b 14 (endianness little))
163 (equal? (bytevector-u16-ref b 14 (endianness big))
166 (pass-if "bytevector-s16-ref"
167 (let ((b (u8-list->bytevector
168 '(255 255 255 255 255 255 255 255
169 255 255 255 255 255 255 255 253))))
170 (and (equal? (bytevector-s16-ref b 14 (endianness little))
172 (equal? (bytevector-s16-ref b 14 (endianness big))
175 (pass-if "bytevector-s16-ref [unaligned]"
176 (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
177 (equal? (bytevector-s16-ref b 1 (endianness little))
180 (pass-if "bytevector-{u16,s16}-ref"
181 (let ((b (make-bytevector 2)))
182 (bytevector-u16-set! b 0 44444 (endianness little))
183 (and (equal? (bytevector-u16-ref b 0 (endianness little))
185 (equal? (bytevector-s16-ref b 0 (endianness little))
188 (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
189 (let ((b (make-bytevector 2)))
190 (bytevector-u16-native-set! b 0 44444)
191 (and (equal? (bytevector-u16-native-ref b 0)
193 (equal? (bytevector-s16-native-ref b 0)
196 (pass-if "bytevector-s16-{ref,set!} [unaligned]"
197 (let ((b (make-bytevector 3)))
198 (bytevector-s16-set! b 1 -77 (endianness little))
199 (equal? (bytevector-s16-ref b 1 (endianness little))
203 (with-test-prefix "2.6 Operations on 32-bit Integers"
205 (pass-if "bytevector-u32-ref"
206 (let ((b (u8-list->bytevector
207 '(255 255 255 255 255 255 255 255
208 255 255 255 255 255 255 255 253))))
209 (and (equal? (bytevector-u32-ref b 12 (endianness little))
211 (equal? (bytevector-u32-ref b 12 (endianness big))
214 (pass-if "bytevector-s32-ref"
215 (let ((b (u8-list->bytevector
216 '(255 255 255 255 255 255 255 255
217 255 255 255 255 255 255 255 253))))
218 (and (equal? (bytevector-s32-ref b 12 (endianness little))
220 (equal? (bytevector-s32-ref b 12 (endianness big))
223 (pass-if "bytevector-{u32,s32}-ref"
224 (let ((b (make-bytevector 4)))
225 (bytevector-u32-set! b 0 2222222222 (endianness little))
226 (and (equal? (bytevector-u32-ref b 0 (endianness little))
228 (equal? (bytevector-s32-ref b 0 (endianness little))
229 (- 2222222222 (expt 2 32))))))
231 (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
232 (let ((b (make-bytevector 4)))
233 (bytevector-u32-native-set! b 0 2222222222)
234 (and (equal? (bytevector-u32-native-ref b 0)
236 (equal? (bytevector-s32-native-ref b 0)
237 (- 2222222222 (expt 2 32)))))))
240 (with-test-prefix "2.7 Operations on 64-bit Integers"
242 (pass-if "bytevector-u64-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-u64-ref b 8 (endianness little))
248 (equal? (bytevector-u64-ref b 8 (endianness big))
249 #xfffffffffffffffd))))
251 (pass-if "bytevector-s64-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-s64-ref b 8 (endianness little))
257 (equal? (bytevector-s64-ref b 8 (endianness big))
260 (pass-if "bytevector-{u64,s64}-ref"
261 (let ((b (make-bytevector 8))
262 (big 9333333333333333333))
263 (bytevector-u64-set! b 0 big (endianness little))
264 (and (equal? (bytevector-u64-ref b 0 (endianness little))
266 (equal? (bytevector-s64-ref b 0 (endianness little))
267 (- big (expt 2 64))))))
269 (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
270 (let ((b (make-bytevector 8))
271 (big 9333333333333333333))
272 (bytevector-u64-native-set! b 0 big)
273 (and (equal? (bytevector-u64-native-ref b 0)
275 (equal? (bytevector-s64-native-ref b 0)
276 (- big (expt 2 64))))))
278 (pass-if "ref/set! with zero"
279 (let ((b (make-bytevector 8)))
280 (bytevector-s64-set! b 0 -1 (endianness big))
281 (bytevector-u64-set! b 0 0 (endianness big))
282 (= 0 (bytevector-u64-ref b 0 (endianness big))))))
285 (with-test-prefix "2.8 Operations on IEEE-754 Representations"
287 (pass-if "bytevector-ieee-single-native-{ref,set!}"
288 (let ((b (make-bytevector 4))
290 (bytevector-ieee-single-native-set! b 0 number)
291 (equal? (bytevector-ieee-single-native-ref b 0)
294 (pass-if "bytevector-ieee-single-{ref,set!}"
295 (let ((b (make-bytevector 8))
297 (bytevector-ieee-single-set! b 0 number (endianness little))
298 (bytevector-ieee-single-set! b 4 number (endianness big))
299 (equal? (bytevector-ieee-single-ref b 0 (endianness little))
300 (bytevector-ieee-single-ref b 4 (endianness big)))))
302 (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
303 (let ((b (make-bytevector 9))
305 (bytevector-ieee-single-set! b 1 number (endianness little))
306 (bytevector-ieee-single-set! b 5 number (endianness big))
307 (equal? (bytevector-ieee-single-ref b 1 (endianness little))
308 (bytevector-ieee-single-ref b 5 (endianness big)))))
310 (pass-if "bytevector-ieee-double-native-{ref,set!}"
311 (let ((b (make-bytevector 8))
313 (bytevector-ieee-double-native-set! b 0 number)
314 (equal? (bytevector-ieee-double-native-ref b 0)
317 (pass-if "bytevector-ieee-double-{ref,set!}"
318 (let ((b (make-bytevector 16))
320 (bytevector-ieee-double-set! b 0 number (endianness little))
321 (bytevector-ieee-double-set! b 8 number (endianness big))
322 (equal? (bytevector-ieee-double-ref b 0 (endianness little))
323 (bytevector-ieee-double-ref b 8 (endianness big))))))
326 (define (with-locale locale thunk)
327 ;; Run THUNK under LOCALE.
328 (let ((original-locale (setlocale LC_ALL)))
331 (setlocale LC_ALL locale))
333 (throw 'unresolved)))
340 (setlocale LC_ALL original-locale)))))
342 (define (with-latin1-locale thunk)
343 ;; Try out several ISO-8859-1 locales and run THUNK under the one that
347 (string-append name ".ISO-8859-1"))
348 '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
350 (let loop ((locales %locales))
355 (with-locale (car locales) thunk))
357 (loop (cdr locales)))))))
360 ;; Default to the C locale for the following tests.
361 (setlocale LC_ALL "C")
364 (with-test-prefix "2.9 Operations on Strings"
366 (pass-if "string->utf8"
367 (let* ((str "hello, world")
368 (utf8 (string->utf8 str)))
369 (and (bytevector? utf8)
370 (= (bytevector-length utf8)
372 (equal? (string->list str)
373 (map integer->char (bytevector->u8-list utf8))))))
375 (pass-if "string->utf8 [latin-1]"
378 (let* ((str "hé, ça va bien ?")
379 (utf8 (string->utf8 str)))
380 (and (bytevector? utf8)
381 (= (bytevector-length utf8)
382 (+ 2 (string-length str))))))))
384 (pass-if "string->utf16"
385 (let* ((str "hello, world")
386 (utf16 (string->utf16 str)))
387 (and (bytevector? utf16)
388 (= (bytevector-length utf16)
389 (* 2 (string-length str)))
390 (equal? (string->list str)
392 (bytevector->uint-list utf16
393 (endianness big) 2))))))
395 (pass-if "string->utf16 [little]"
396 (let* ((str "hello, world")
397 (utf16 (string->utf16 str (endianness little))))
398 (and (bytevector? utf16)
399 (= (bytevector-length utf16)
400 (* 2 (string-length str)))
401 (equal? (string->list str)
403 (bytevector->uint-list utf16
404 (endianness little) 2))))))
407 (pass-if "string->utf32"
408 (let* ((str "hello, world")
409 (utf32 (string->utf32 str)))
410 (and (bytevector? utf32)
411 (= (bytevector-length utf32)
412 (* 4 (string-length str)))
413 (equal? (string->list str)
415 (bytevector->uint-list utf32
416 (endianness big) 4))))))
418 (pass-if "string->utf32 [little]"
419 (let* ((str "hello, world")
420 (utf32 (string->utf32 str (endianness little))))
421 (and (bytevector? utf32)
422 (= (bytevector-length utf32)
423 (* 4 (string-length str)))
424 (equal? (string->list str)
426 (bytevector->uint-list utf32
427 (endianness little) 4))))))
429 (pass-if "utf8->string"
430 (let* ((utf8 (u8-list->bytevector (map char->integer
431 (string->list "hello, world"))))
432 (str (utf8->string utf8)))
434 (= (string-length str)
435 (bytevector-length utf8))
436 (equal? (string->list str)
437 (map integer->char (bytevector->u8-list utf8))))))
439 (pass-if "utf8->string [latin-1]"
442 (let* ((utf8 (string->utf8 "hé, ça va bien ?"))
443 (str (utf8->string utf8)))
445 (= (string-length str)
446 (- (bytevector-length utf8) 2)))))))
448 (pass-if "utf16->string"
449 (let* ((utf16 (uint-list->bytevector (map char->integer
450 (string->list "hello, world"))
452 (str (utf16->string utf16)))
454 (= (* 2 (string-length str))
455 (bytevector-length utf16))
456 (equal? (string->list str)
458 (bytevector->uint-list utf16 (endianness big)
461 (pass-if "utf16->string [little]"
462 (let* ((utf16 (uint-list->bytevector (map char->integer
463 (string->list "hello, world"))
464 (endianness little) 2))
465 (str (utf16->string utf16 (endianness little))))
467 (= (* 2 (string-length str))
468 (bytevector-length utf16))
469 (equal? (string->list str)
471 (bytevector->uint-list utf16 (endianness little)
473 (pass-if "utf32->string"
474 (let* ((utf32 (uint-list->bytevector (map char->integer
475 (string->list "hello, world"))
477 (str (utf32->string utf32)))
479 (= (* 4 (string-length str))
480 (bytevector-length utf32))
481 (equal? (string->list str)
483 (bytevector->uint-list utf32 (endianness big)
486 (pass-if "utf32->string [little]"
487 (let* ((utf32 (uint-list->bytevector (map char->integer
488 (string->list "hello, world"))
489 (endianness little) 4))
490 (str (utf32->string utf32 (endianness little))))
492 (= (* 4 (string-length str))
493 (bytevector-length utf32))
494 (equal? (string->list str)
496 (bytevector->uint-list utf32 (endianness little)