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