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