test-suite/tests/bytevectors.test

   1 ;;;; bytevectors.test --- R6RS bytevectors. -*- mode: scheme; coding: utf-8; -*-
   2 ;;;;
   3 ;;;; Copyright (C) 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
   4 ;;;; Ludovic Courtès
   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
   9 ;;;; version 3 of the License, or (at your option) any later version.
  10 ;;;;
  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.
  15 ;;;;
  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)
  22   :use-module (system base compile)
  23   :use-module (rnrs bytevectors))
  24
  25 ;;; Some of the tests in here are examples taken from the R6RS Standard
  26 ;;; Libraries document.
  27
  28 \f
  29 (with-test-prefix/c&e "2.2 General Operations"
  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)
  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)))))
  53
  54 \f
  55 (with-test-prefix/c&e "2.3 Operations on Bytes and Octets"
  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)
 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))))
 140
 141 \f
 142 (with-test-prefix/c&e "2.4 Operations on Integers of Arbitrary Size"
 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
 196 (with-test-prefix/c&e "2.5 Operations on 16-Bit Integers"
 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
 244 (with-test-prefix/c&e "2.6 Operations on 32-bit Integers"
 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
 281 (with-test-prefix/c&e "2.7 Operations on 64-bit Integers"
 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
 326 (with-test-prefix/c&e "2.8 Operations on IEEE-754 Representations"
 327
 328   (pass-if "single, little endian"
 329     ;; http://bugs.gnu.org/11310
 330     (let ((b (make-bytevector 4)))
 331       (bytevector-ieee-single-set! b 0 1.0 (endianness little))
 332       (equal? #vu8(0 0 128 63) b)))
 333
 334   (pass-if "single, big endian"
 335     ;; http://bugs.gnu.org/11310
 336     (let ((b (make-bytevector 4)))
 337       (bytevector-ieee-single-set! b 0 1.0 (endianness big))
 338       (equal? #vu8(63 128 0 0) b)))
 339
 340   (pass-if "bytevector-ieee-single-native-{ref,set!}"
 341     (let ((b (make-bytevector 4))
 342           (number 3.00))
 343       (bytevector-ieee-single-native-set! b 0 number)
 344       (equal? (bytevector-ieee-single-native-ref b 0)
 345               number)))
 346
 347   (pass-if "bytevector-ieee-single-{ref,set!}"
 348     (let ((b (make-bytevector 8))
 349           (number 3.14))
 350       (bytevector-ieee-single-set! b 0 number (endianness little))
 351       (bytevector-ieee-single-set! b 4 number (endianness big))
 352       (equal? (bytevector-ieee-single-ref b 0 (endianness little))
 353               (bytevector-ieee-single-ref b 4 (endianness big)))))
 354
 355   (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
 356     (let ((b (make-bytevector 9))
 357           (number 3.14))
 358       (bytevector-ieee-single-set! b 1 number (endianness little))
 359       (bytevector-ieee-single-set! b 5 number (endianness big))
 360       (equal? (bytevector-ieee-single-ref b 1 (endianness little))
 361               (bytevector-ieee-single-ref b 5 (endianness big)))))
 362
 363   (pass-if "double, little endian"
 364     ;; http://bugs.gnu.org/11310
 365     (let ((b (make-bytevector 8)))
 366       (bytevector-ieee-double-set! b 0 1.0 (endianness little))
 367       (equal? #vu8(0 0 0 0 0 0 240 63) b)))
 368
 369   (pass-if "double, big endian"
 370     ;; http://bugs.gnu.org/11310
 371     (let ((b (make-bytevector 8)))
 372       (bytevector-ieee-double-set! b 0 1.0 (endianness big))
 373       (equal? #vu8(63 240 0 0 0 0 0 0) b)))
 374
 375   (pass-if "bytevector-ieee-double-native-{ref,set!}"
 376     (let ((b (make-bytevector 8))
 377           (number 3.14))
 378       (bytevector-ieee-double-native-set! b 0 number)
 379       (equal? (bytevector-ieee-double-native-ref b 0)
 380               number)))
 381
 382   (pass-if "bytevector-ieee-double-{ref,set!}"
 383     (let ((b (make-bytevector 16))
 384           (number 3.14))
 385       (bytevector-ieee-double-set! b 0 number (endianness little))
 386       (bytevector-ieee-double-set! b 8 number (endianness big))
 387       (equal? (bytevector-ieee-double-ref b 0 (endianness little))
 388               (bytevector-ieee-double-ref b 8 (endianness big))))))
 389
 390 \f
 391
 392 ;; Default to the C locale for the following tests.
 393 (setlocale LC_ALL "C")
 394
 395
 396 (with-test-prefix "2.9 Operations on Strings"
 397
 398   (pass-if "string->utf8"
 399     (let* ((str  "hello, world")
 400            (utf8 (string->utf8 str)))
 401       (and (bytevector? utf8)
 402            (= (bytevector-length utf8)
 403               (string-length str))
 404            (equal? (string->list str)
 405                    (map integer->char (bytevector->u8-list utf8))))))
 406
 407   (pass-if "string->utf8 [latin-1]"
 408     (let* ((str  "hé, ça va bien ?")
 409            (utf8 (string->utf8 str)))
 410       (and (bytevector? utf8)
 411            (= (bytevector-length utf8)
 412               (+ 2 (string-length str))))))
 413
 414   (pass-if "string->utf16"
 415     (let* ((str   "hello, world")
 416            (utf16 (string->utf16 str)))
 417       (and (bytevector? utf16)
 418            (= (bytevector-length utf16)
 419               (* 2 (string-length str)))
 420            (equal? (string->list str)
 421                    (map integer->char
 422                         (bytevector->uint-list utf16
 423                                                (endianness big) 2))))))
 424
 425   (pass-if "string->utf16 [little]"
 426     (let* ((str   "hello, world")
 427            (utf16 (string->utf16 str (endianness little))))
 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 little) 2))))))
 435
 436
 437   (pass-if "string->utf32"
 438     (let* ((str   "hello, world")
 439            (utf32 (string->utf32 str)))
 440       (and (bytevector? utf32)
 441            (= (bytevector-length utf32)
 442               (* 4 (string-length str)))
 443            (equal? (string->list str)
 444                    (map integer->char
 445                         (bytevector->uint-list utf32
 446                                                (endianness big) 4))))))
 447
 448   (pass-if "string->utf32 [Greek]"
 449     (let* ((str   "Ἄνεμοι")
 450            (utf32 (string->utf32 str)))
 451       (and (bytevector? utf32)
 452            (equal? (bytevector->uint-list utf32 (endianness big) 4)
 453                    '(#x1f0c #x3bd #x3b5 #x3bc #x3bf #x3b9)))))
 454
 455   (pass-if "string->utf32 [little]"
 456     (let* ((str   "hello, world")
 457            (utf32 (string->utf32 str (endianness little))))
 458       (and (bytevector? utf32)
 459            (= (bytevector-length utf32)
 460               (* 4 (string-length str)))
 461            (equal? (string->list str)
 462                    (map integer->char
 463                         (bytevector->uint-list utf32
 464                                                (endianness little) 4))))))
 465
 466   (pass-if "utf8->string"
 467     (let* ((utf8  (u8-list->bytevector (map char->integer
 468                                             (string->list "hello, world"))))
 469            (str   (utf8->string utf8)))
 470       (and (string? str)
 471            (= (string-length str)
 472               (bytevector-length utf8))
 473            (equal? (string->list str)
 474                    (map integer->char (bytevector->u8-list utf8))))))
 475
 476   (pass-if "utf8->string [latin-1]"
 477     (let* ((utf8  (string->utf8 "hé, ça va bien ?"))
 478            (str   (utf8->string utf8)))
 479       (and (string? str)
 480            (= (string-length str)
 481               (- (bytevector-length utf8) 2)))))
 482
 483   (pass-if "utf16->string"
 484     (let* ((utf16  (uint-list->bytevector (map char->integer
 485                                                (string->list "hello, world"))
 486                                           (endianness big) 2))
 487            (str   (utf16->string utf16)))
 488       (and (string? str)
 489            (= (* 2 (string-length str))
 490               (bytevector-length utf16))
 491            (equal? (string->list str)
 492                    (map integer->char
 493                         (bytevector->uint-list utf16 (endianness big)
 494                                                2))))))
 495
 496   (pass-if "utf16->string [little]"
 497     (let* ((utf16  (uint-list->bytevector (map char->integer
 498                                                (string->list "hello, world"))
 499                                           (endianness little) 2))
 500            (str   (utf16->string utf16 (endianness little))))
 501       (and (string? str)
 502            (= (* 2 (string-length str))
 503               (bytevector-length utf16))
 504            (equal? (string->list str)
 505                    (map integer->char
 506                         (bytevector->uint-list utf16 (endianness little)
 507                                                2))))))
 508   (pass-if "utf32->string"
 509     (let* ((utf32  (uint-list->bytevector (map char->integer
 510                                                (string->list "hello, world"))
 511                                           (endianness big) 4))
 512            (str   (utf32->string utf32)))
 513       (and (string? str)
 514            (= (* 4 (string-length str))
 515               (bytevector-length utf32))
 516            (equal? (string->list str)
 517                    (map integer->char
 518                         (bytevector->uint-list utf32 (endianness big)
 519                                                4))))))
 520
 521   (pass-if "utf32->string [little]"
 522     (let* ((utf32  (uint-list->bytevector (map char->integer
 523                                                (string->list "hello, world"))
 524                                           (endianness little) 4))
 525            (str   (utf32->string utf32 (endianness little))))
 526       (and (string? str)
 527            (= (* 4 (string-length str))
 528               (bytevector-length utf32))
 529            (equal? (string->list str)
 530                    (map integer->char
 531                         (bytevector->uint-list utf32 (endianness little)
 532                                                4)))))))
 533
 534
 535 \f
 536 (with-test-prefix "Datum Syntax"
 537
 538   (pass-if "empty"
 539     (equal? (with-input-from-string "#vu8()" read)
 540             (make-bytevector 0)))
 541
 542   (pass-if "simple"
 543     (equal? (with-input-from-string "#vu8(1 2 3   4 5)" read)
 544             (u8-list->bytevector '(1 2 3 4 5))))
 545
 546   (pass-if ">127"
 547     (equal? (with-input-from-string "#vu8(0 255 127 128)" read)
 548             (u8-list->bytevector '(0 255 127 128))))
 549
 550   (pass-if "self-evaluating?"
 551     (self-evaluating? (make-bytevector 1)))
 552
 553   (pass-if "self-evaluating"
 554     (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read)
 555                   (current-module))
 556             (u8-list->bytevector '(1 2 3 4 5))))
 557
 558   (pass-if "quoted"
 559     (equal? (eval (with-input-from-string "'#vu8(1 2 3 4 5)" read)
 560                   (current-module))
 561             (u8-list->bytevector '(1 2 3 4 5))))
 562
 563   (pass-if "literal simple"
 564     (equal? #vu8(1 2 3   4 5)
 565             (u8-list->bytevector '(1 2 3 4 5))))
 566
 567   (pass-if "literal >127"
 568     (equal? #vu8(0 255 127 128)
 569             (u8-list->bytevector '(0 255 127 128))))
 570
 571   (pass-if "literal quoted"
 572     (equal? '#vu8(1 2 3   4 5)
 573             (u8-list->bytevector '(1 2 3 4 5))))
 574
 575   (pass-if-exception "incorrect prefix"
 576     exception:read-error
 577     (with-input-from-string "#vi8(1 2 3)" read))
 578
 579   (pass-if-exception "extraneous space"
 580     exception:read-error
 581     (with-input-from-string "#vu8 (1 2 3)" read))
 582
 583   (pass-if-exception "negative integers"
 584     exception:wrong-type-arg
 585     (with-input-from-string "#vu8(-1 -2 -3)" read))
 586
 587   (pass-if-exception "out-of-range integers"
 588     exception:wrong-type-arg
 589     (with-input-from-string "#vu8(0 256)" read)))
 590
 591 \f
 592 (with-test-prefix "Arrays"
 593
 594   (pass-if "array?"
 595     (array? #vu8(1 2 3)))
 596
 597   (pass-if "array-length"
 598     (equal? (iota 16)
 599             (map array-length
 600                  (map make-bytevector (iota 16)))))
 601
 602   (pass-if "array-ref"
 603     (let ((bv #vu8(255 127)))
 604       (and (= 255 (array-ref bv 0))
 605            (= 127 (array-ref bv 1)))))
 606
 607   (pass-if-exception "array-ref [index out-of-range]"
 608     exception:out-of-range
 609     (let ((bv #vu8(1 2)))
 610       (array-ref bv 2)))
 611
 612   (pass-if "array-set!"
 613     (let ((bv (make-bytevector 2)))
 614       (array-set! bv 255 0)
 615       (array-set! bv 77 1)
 616       (equal? '(255 77)
 617               (bytevector->u8-list bv))))
 618
 619   (pass-if-exception "array-set! [index out-of-range]"
 620     exception:out-of-range
 621     (let ((bv (make-bytevector 2)))
 622       (array-set! bv 0 2)))
 623
 624   (pass-if-exception "array-set! [value out-of-range]"
 625     exception:out-of-range
 626     (let ((bv (make-bytevector 2)))
 627       (array-set! bv 256 0)))
 628
 629   (pass-if "array-type"
 630     (eq? 'vu8 (array-type #vu8())))
 631
 632   (pass-if "array-contents"
 633     (let ((bv (u8-list->bytevector (iota 10))))
 634       (eq? bv (array-contents bv))))
 635
 636   (pass-if "array-ref"
 637     (let ((bv (u8-list->bytevector (iota 10))))
 638       (equal? (iota 10)
 639               (map (lambda (i) (array-ref bv i))
 640                    (iota 10)))))
 641
 642   (pass-if "array-set!"
 643     (let ((bv (make-bytevector 10)))
 644       (for-each (lambda (i)
 645                   (array-set! bv i i))
 646                 (iota 10))
 647       (equal? (iota 10)
 648               (bytevector->u8-list bv))))
 649
 650   (pass-if "make-typed-array"
 651     (let ((bv (make-typed-array 'vu8 77 33)))
 652       (equal? bv (u8-list->bytevector (make-list 33 77)))))
 653
 654   (pass-if-exception "make-typed-array [out-of-range]"
 655     exception:out-of-range
 656     (make-typed-array 'vu8 256 77)))
 657
 658 \f
 659 (with-test-prefix "uniform-array->bytevector"
 660
 661   (pass-if "bytevector"
 662     (let ((bv #vu8(0 1 128 255)))
 663       (equal? bv (uniform-array->bytevector bv))))
 664
 665   (pass-if "empty bitvector"
 666     (let ((bv (uniform-array->bytevector (make-bitvector 0))))
 667       (equal? bv #vu8())))
 668
 669   (pass-if "bitvector < 8"
 670     (let ((bv (uniform-array->bytevector (make-bitvector 4 #t))))
 671       (= (bytevector-length bv) 1)))
 672
 673   (pass-if "bitvector == 8"
 674     (let ((bv (uniform-array->bytevector (make-bitvector 8 #t))))
 675       (= (bytevector-length bv) 1)))
 676
 677   (pass-if "bitvector > 8"
 678     (let ((bv (uniform-array->bytevector (make-bitvector 9 #t))))
 679       (= (bytevector-length bv) 2))))
 680
 681 ;;; Local Variables:
 682 ;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
 683 ;;; End: