test-suite/tests/bytevectors.test

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