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