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) -1))
 161
 162   (pass-if-exception "bytevector->uint-list [out-of-range]"
 163     exception:out-of-range
 164     (bytevector->uint-list (make-bytevector 6) (endianness little) 0))
 165
 166   (pass-if-exception "bytevector->uint-list [word size doesn't divide length]"
 167     exception:wrong-type-arg
 168     (bytevector->uint-list (make-bytevector 6) (endianness little) 4))
 169
 170   (pass-if "{sint,uint}-list->bytevector"
 171     (let ((b1 (sint-list->bytevector '(513 -253 513 513)
 172                                      (endianness little) 2))
 173           (b2 (uint-list->bytevector '(513 65283 513 513)
 174                                      (endianness little) 2))
 175           (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
 176       (and (bytevector=? b1 b2)
 177            (bytevector=? b2 b3))))
 178
 179   (pass-if "sint-list->bytevector [limits]"
 180            (bytevector=? (sint-list->bytevector '(-32768 32767)
 181                                                 (endianness big) 2)
 182                          (let ((bv (make-bytevector 4)))
 183                            (bytevector-u8-set! bv 0 #x80)
 184                            (bytevector-u8-set! bv 1 #x00)
 185                            (bytevector-u8-set! bv 2 #x7f)
 186                            (bytevector-u8-set! bv 3 #xff)
 187                            bv)))
 188
 189   (pass-if-exception "sint-list->bytevector [out-of-range]"
 190     exception:out-of-range
 191     (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)
 192                            2))
 193
 194   (pass-if-exception "uint-list->bytevector [out-of-range]"
 195     exception:out-of-range
 196     (uint-list->bytevector '(0 -1) (endianness big) 2)))
 197
 198 \f
 199 (with-test-prefix/c&e "2.5 Operations on 16-Bit Integers"
 200
 201   (pass-if "bytevector-u16-ref"
 202     (let ((b (u8-list->bytevector
 203               '(255 255 255 255 255 255 255 255
 204                 255 255 255 255 255 255 255 253))))
 205       (and (equal? (bytevector-u16-ref b 14 (endianness little))
 206                    #xfdff)
 207            (equal? (bytevector-u16-ref b 14 (endianness big))
 208                    #xfffd))))
 209
 210   (pass-if "bytevector-s16-ref"
 211     (let ((b (u8-list->bytevector
 212               '(255 255 255 255 255 255 255 255
 213                 255 255 255 255 255 255 255 253))))
 214       (and (equal? (bytevector-s16-ref b 14 (endianness little))
 215                    -513)
 216            (equal? (bytevector-s16-ref b 14 (endianness big))
 217                    -3))))
 218
 219   (pass-if "bytevector-s16-ref [unaligned]"
 220     (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
 221       (equal? (bytevector-s16-ref b 1 (endianness little))
 222               -16)))
 223
 224   (pass-if "bytevector-{u16,s16}-ref"
 225     (let ((b (make-bytevector 2)))
 226       (bytevector-u16-set! b 0 44444 (endianness little))
 227       (and (equal? (bytevector-u16-ref b 0 (endianness little))
 228                    44444)
 229            (equal? (bytevector-s16-ref b 0 (endianness little))
 230                    (- 44444 65536)))))
 231
 232   (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
 233     (let ((b (make-bytevector 2)))
 234       (bytevector-u16-native-set! b 0 44444)
 235       (and (equal? (bytevector-u16-native-ref b 0)
 236                    44444)
 237            (equal? (bytevector-s16-native-ref b 0)
 238                    (- 44444 65536)))))
 239
 240   (pass-if "bytevector-s16-{ref,set!} [unaligned]"
 241     (let ((b (make-bytevector 3)))
 242       (bytevector-s16-set! b 1 -77 (endianness little))
 243       (equal? (bytevector-s16-ref b 1 (endianness little))
 244               -77))))
 245
 246 \f
 247 (with-test-prefix/c&e "2.6 Operations on 32-bit Integers"
 248
 249   (pass-if "bytevector-u32-ref"
 250     (let ((b (u8-list->bytevector
 251               '(255 255 255 255 255 255 255 255
 252                 255 255 255 255 255 255 255 253))))
 253       (and (equal? (bytevector-u32-ref b 12 (endianness little))
 254                    #xfdffffff)
 255            (equal? (bytevector-u32-ref b 12 (endianness big))
 256                    #xfffffffd))))
 257
 258   (pass-if "bytevector-s32-ref"
 259     (let ((b (u8-list->bytevector
 260               '(255 255 255 255 255 255 255 255
 261                 255 255 255 255 255 255 255 253))))
 262       (and (equal? (bytevector-s32-ref b 12 (endianness little))
 263                    -33554433)
 264            (equal? (bytevector-s32-ref b 12 (endianness big))
 265                    -3))))
 266
 267   (pass-if "bytevector-{u32,s32}-ref"
 268     (let ((b (make-bytevector 4)))
 269       (bytevector-u32-set! b 0 2222222222 (endianness little))
 270       (and (equal? (bytevector-u32-ref b 0 (endianness little))
 271                    2222222222)
 272            (equal? (bytevector-s32-ref b 0 (endianness little))
 273                    (- 2222222222 (expt 2 32))))))
 274
 275   (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
 276     (let ((b (make-bytevector 4)))
 277       (bytevector-u32-native-set! b 0 2222222222)
 278       (and (equal? (bytevector-u32-native-ref b 0)
 279                    2222222222)
 280            (equal? (bytevector-s32-native-ref b 0)
 281                    (- 2222222222 (expt 2 32)))))))
 282
 283 \f
 284 (with-test-prefix/c&e "2.7 Operations on 64-bit Integers"
 285
 286   (pass-if "bytevector-u64-ref"
 287     (let ((b (u8-list->bytevector
 288               '(255 255 255 255 255 255 255 255
 289                 255 255 255 255 255 255 255 253))))
 290       (and (equal? (bytevector-u64-ref b 8 (endianness little))
 291                    #xfdffffffffffffff)
 292            (equal? (bytevector-u64-ref b 8 (endianness big))
 293                    #xfffffffffffffffd))))
 294
 295   (pass-if "bytevector-s64-ref"
 296     (let ((b (u8-list->bytevector
 297               '(255 255 255 255 255 255 255 255
 298                 255 255 255 255 255 255 255 253))))
 299       (and (equal? (bytevector-s64-ref b 8 (endianness little))
 300                    -144115188075855873)
 301            (equal? (bytevector-s64-ref b 8 (endianness big))
 302                    -3))))
 303
 304   (pass-if "bytevector-{u64,s64}-ref"
 305     (let ((b (make-bytevector 8))
 306           (big 9333333333333333333))
 307       (bytevector-u64-set! b 0 big (endianness little))
 308       (and (equal? (bytevector-u64-ref b 0 (endianness little))
 309                    big)
 310            (equal? (bytevector-s64-ref b 0 (endianness little))
 311                    (- big (expt 2 64))))))
 312
 313   (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
 314     (let ((b (make-bytevector 8))
 315           (big 9333333333333333333))
 316       (bytevector-u64-native-set! b 0 big)
 317       (and (equal? (bytevector-u64-native-ref b 0)
 318                    big)
 319            (equal? (bytevector-s64-native-ref b 0)
 320                    (- big (expt 2 64))))))
 321
 322   (pass-if "ref/set! with zero"
 323      (let ((b (make-bytevector 8)))
 324        (bytevector-s64-set! b 0 -1 (endianness big))
 325        (bytevector-u64-set! b 0  0 (endianness big))
 326        (= 0 (bytevector-u64-ref b 0 (endianness big))))))
 327
 328 \f
 329 (with-test-prefix/c&e "2.8 Operations on IEEE-754 Representations"
 330
 331   (pass-if "single, little endian"
 332     ;; http://bugs.gnu.org/11310
 333     (let ((b (make-bytevector 4)))
 334       (bytevector-ieee-single-set! b 0 1.0 (endianness little))
 335       (equal? #vu8(0 0 128 63) b)))
 336
 337   (pass-if "single, big endian"
 338     ;; http://bugs.gnu.org/11310
 339     (let ((b (make-bytevector 4)))
 340       (bytevector-ieee-single-set! b 0 1.0 (endianness big))
 341       (equal? #vu8(63 128 0 0) b)))
 342
 343   (pass-if "bytevector-ieee-single-native-{ref,set!}"
 344     (let ((b (make-bytevector 4))
 345           (number 3.00))
 346       (bytevector-ieee-single-native-set! b 0 number)
 347       (equal? (bytevector-ieee-single-native-ref b 0)
 348               number)))
 349
 350   (pass-if "bytevector-ieee-single-{ref,set!}"
 351     (let ((b (make-bytevector 8))
 352           (number 3.14))
 353       (bytevector-ieee-single-set! b 0 number (endianness little))
 354       (bytevector-ieee-single-set! b 4 number (endianness big))
 355       (equal? (bytevector-ieee-single-ref b 0 (endianness little))
 356               (bytevector-ieee-single-ref b 4 (endianness big)))))
 357
 358   (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
 359     (let ((b (make-bytevector 9))
 360           (number 3.14))
 361       (bytevector-ieee-single-set! b 1 number (endianness little))
 362       (bytevector-ieee-single-set! b 5 number (endianness big))
 363       (equal? (bytevector-ieee-single-ref b 1 (endianness little))
 364               (bytevector-ieee-single-ref b 5 (endianness big)))))
 365
 366   (pass-if "double, little endian"
 367     ;; http://bugs.gnu.org/11310
 368     (let ((b (make-bytevector 8)))
 369       (bytevector-ieee-double-set! b 0 1.0 (endianness little))
 370       (equal? #vu8(0 0 0 0 0 0 240 63) b)))
 371
 372   (pass-if "double, big endian"
 373     ;; http://bugs.gnu.org/11310
 374     (let ((b (make-bytevector 8)))
 375       (bytevector-ieee-double-set! b 0 1.0 (endianness big))
 376       (equal? #vu8(63 240 0 0 0 0 0 0) b)))
 377
 378   (pass-if "bytevector-ieee-double-native-{ref,set!}"
 379     (let ((b (make-bytevector 8))
 380           (number 3.14))
 381       (bytevector-ieee-double-native-set! b 0 number)
 382       (equal? (bytevector-ieee-double-native-ref b 0)
 383               number)))
 384
 385   (pass-if "bytevector-ieee-double-{ref,set!}"
 386     (let ((b (make-bytevector 16))
 387           (number 3.14))
 388       (bytevector-ieee-double-set! b 0 number (endianness little))
 389       (bytevector-ieee-double-set! b 8 number (endianness big))
 390       (equal? (bytevector-ieee-double-ref b 0 (endianness little))
 391               (bytevector-ieee-double-ref b 8 (endianness big))))))
 392
 393 \f
 394
 395 ;; Default to the C locale for the following tests.
 396 (setlocale LC_ALL "C")
 397
 398
 399 (with-test-prefix "2.9 Operations on Strings"
 400
 401   (pass-if "string->utf8"
 402     (let* ((str  "hello, world")
 403            (utf8 (string->utf8 str)))
 404       (and (bytevector? utf8)
 405            (= (bytevector-length utf8)
 406               (string-length str))
 407            (equal? (string->list str)
 408                    (map integer->char (bytevector->u8-list utf8))))))
 409
 410   (pass-if "string->utf8 [latin-1]"
 411     (let* ((str  "hé, ça va bien ?")
 412            (utf8 (string->utf8 str)))
 413       (and (bytevector? utf8)
 414            (= (bytevector-length utf8)
 415               (+ 2 (string-length str))))))
 416
 417   (pass-if "string->utf16"
 418     (let* ((str   "hello, world")
 419            (utf16 (string->utf16 str)))
 420       (and (bytevector? utf16)
 421            (= (bytevector-length utf16)
 422               (* 2 (string-length str)))
 423            (equal? (string->list str)
 424                    (map integer->char
 425                         (bytevector->uint-list utf16
 426                                                (endianness big) 2))))))
 427
 428   (pass-if "string->utf16 [little]"
 429     (let* ((str   "hello, world")
 430            (utf16 (string->utf16 str (endianness little))))
 431       (and (bytevector? utf16)
 432            (= (bytevector-length utf16)
 433               (* 2 (string-length str)))
 434            (equal? (string->list str)
 435                    (map integer->char
 436                         (bytevector->uint-list utf16
 437                                                (endianness little) 2))))))
 438
 439
 440   (pass-if "string->utf32"
 441     (let* ((str   "hello, world")
 442            (utf32 (string->utf32 str)))
 443       (and (bytevector? utf32)
 444            (= (bytevector-length utf32)
 445               (* 4 (string-length str)))
 446            (equal? (string->list str)
 447                    (map integer->char
 448                         (bytevector->uint-list utf32
 449                                                (endianness big) 4))))))
 450
 451   (pass-if "string->utf32 [Greek]"
 452     (let* ((str   "Ἄνεμοι")
 453            (utf32 (string->utf32 str)))
 454       (and (bytevector? utf32)
 455            (equal? (bytevector->uint-list utf32 (endianness big) 4)
 456                    '(#x1f0c #x3bd #x3b5 #x3bc #x3bf #x3b9)))))
 457
 458   (pass-if "string->utf32 [little]"
 459     (let* ((str   "hello, world")
 460            (utf32 (string->utf32 str (endianness little))))
 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 little) 4))))))
 468
 469   (pass-if "utf8->string"
 470     (let* ((utf8  (u8-list->bytevector (map char->integer
 471                                             (string->list "hello, world"))))
 472            (str   (utf8->string utf8)))
 473       (and (string? str)
 474            (= (string-length str)
 475               (bytevector-length utf8))
 476            (equal? (string->list str)
 477                    (map integer->char (bytevector->u8-list utf8))))))
 478
 479   (pass-if "utf8->string [latin-1]"
 480     (let* ((utf8  (string->utf8 "hé, ça va bien ?"))
 481            (str   (utf8->string utf8)))
 482       (and (string? str)
 483            (= (string-length str)
 484               (- (bytevector-length utf8) 2)))))
 485
 486   (pass-if "utf16->string"
 487     (let* ((utf16  (uint-list->bytevector (map char->integer
 488                                                (string->list "hello, world"))
 489                                           (endianness big) 2))
 490            (str   (utf16->string utf16)))
 491       (and (string? str)
 492            (= (* 2 (string-length str))
 493               (bytevector-length utf16))
 494            (equal? (string->list str)
 495                    (map integer->char
 496                         (bytevector->uint-list utf16 (endianness big)
 497                                                2))))))
 498
 499   (pass-if "utf16->string [little]"
 500     (let* ((utf16  (uint-list->bytevector (map char->integer
 501                                                (string->list "hello, world"))
 502                                           (endianness little) 2))
 503            (str   (utf16->string utf16 (endianness little))))
 504       (and (string? str)
 505            (= (* 2 (string-length str))
 506               (bytevector-length utf16))
 507            (equal? (string->list str)
 508                    (map integer->char
 509                         (bytevector->uint-list utf16 (endianness little)
 510                                                2))))))
 511   (pass-if "utf32->string"
 512     (let* ((utf32  (uint-list->bytevector (map char->integer
 513                                                (string->list "hello, world"))
 514                                           (endianness big) 4))
 515            (str   (utf32->string utf32)))
 516       (and (string? str)
 517            (= (* 4 (string-length str))
 518               (bytevector-length utf32))
 519            (equal? (string->list str)
 520                    (map integer->char
 521                         (bytevector->uint-list utf32 (endianness big)
 522                                                4))))))
 523
 524   (pass-if "utf32->string [little]"
 525     (let* ((utf32  (uint-list->bytevector (map char->integer
 526                                                (string->list "hello, world"))
 527                                           (endianness little) 4))
 528            (str   (utf32->string utf32 (endianness little))))
 529       (and (string? str)
 530            (= (* 4 (string-length str))
 531               (bytevector-length utf32))
 532            (equal? (string->list str)
 533                    (map integer->char
 534                         (bytevector->uint-list utf32 (endianness little)
 535                                                4)))))))
 536
 537
 538 \f
 539 (with-test-prefix "Datum Syntax"
 540
 541   (pass-if "empty"
 542     (equal? (with-input-from-string "#vu8()" read)
 543             (make-bytevector 0)))
 544
 545   (pass-if "simple"
 546     (equal? (with-input-from-string "#vu8(1 2 3   4 5)" read)
 547             (u8-list->bytevector '(1 2 3 4 5))))
 548
 549   (pass-if ">127"
 550     (equal? (with-input-from-string "#vu8(0 255 127 128)" read)
 551             (u8-list->bytevector '(0 255 127 128))))
 552
 553   (pass-if "self-evaluating?"
 554     (self-evaluating? (make-bytevector 1)))
 555
 556   (pass-if "self-evaluating"
 557     (equal? (eval (with-input-from-string "#vu8(1 2 3 4 5)" read)
 558                   (current-module))
 559             (u8-list->bytevector '(1 2 3 4 5))))
 560
 561   (pass-if "quoted"
 562     (equal? (eval (with-input-from-string "'#vu8(1 2 3 4 5)" read)
 563                   (current-module))
 564             (u8-list->bytevector '(1 2 3 4 5))))
 565
 566   (pass-if "literal simple"
 567     (equal? #vu8(1 2 3   4 5)
 568             (u8-list->bytevector '(1 2 3 4 5))))
 569
 570   (pass-if "literal >127"
 571     (equal? #vu8(0 255 127 128)
 572             (u8-list->bytevector '(0 255 127 128))))
 573
 574   (pass-if "literal quoted"
 575     (equal? '#vu8(1 2 3   4 5)
 576             (u8-list->bytevector '(1 2 3 4 5))))
 577
 578   (pass-if-exception "incorrect prefix"
 579     exception:read-error
 580     (with-input-from-string "#vi8(1 2 3)" read))
 581
 582   (pass-if-exception "extraneous space"
 583     exception:read-error
 584     (with-input-from-string "#vu8 (1 2 3)" read))
 585
 586   (pass-if-exception "negative integers"
 587     exception:wrong-type-arg
 588     (with-input-from-string "#vu8(-1 -2 -3)" read))
 589
 590   (pass-if-exception "out-of-range integers"
 591     exception:wrong-type-arg
 592     (with-input-from-string "#vu8(0 256)" read)))
 593
 594 \f
 595 (with-test-prefix "Arrays"
 596
 597   (pass-if "array?"
 598     (array? #vu8(1 2 3)))
 599
 600   (pass-if "array-length"
 601     (equal? (iota 16)
 602             (map array-length
 603                  (map make-bytevector (iota 16)))))
 604
 605   (pass-if "array-ref"
 606     (let ((bv #vu8(255 127)))
 607       (and (= 255 (array-ref bv 0))
 608            (= 127 (array-ref bv 1)))))
 609
 610   (pass-if-exception "array-ref [index out-of-range]"
 611     exception:out-of-range
 612     (let ((bv #vu8(1 2)))
 613       (array-ref bv 2)))
 614
 615   (pass-if "array-set!"
 616     (let ((bv (make-bytevector 2)))
 617       (array-set! bv 255 0)
 618       (array-set! bv 77 1)
 619       (equal? '(255 77)
 620               (bytevector->u8-list bv))))
 621
 622   (pass-if-exception "array-set! [index out-of-range]"
 623     exception:out-of-range
 624     (let ((bv (make-bytevector 2)))
 625       (array-set! bv 0 2)))
 626
 627   (pass-if-exception "array-set! [value out-of-range]"
 628     exception:out-of-range
 629     (let ((bv (make-bytevector 2)))
 630       (array-set! bv 256 0)))
 631
 632   (pass-if "array-type"
 633     (eq? 'vu8 (array-type #vu8())))
 634
 635   (pass-if "array-contents"
 636     (let ((bv (u8-list->bytevector (iota 10))))
 637       (eq? bv (array-contents bv))))
 638
 639   (pass-if "array-ref"
 640     (let ((bv (u8-list->bytevector (iota 10))))
 641       (equal? (iota 10)
 642               (map (lambda (i) (array-ref bv i))
 643                    (iota 10)))))
 644
 645   (pass-if "array-set!"
 646     (let ((bv (make-bytevector 10)))
 647       (for-each (lambda (i)
 648                   (array-set! bv i i))
 649                 (iota 10))
 650       (equal? (iota 10)
 651               (bytevector->u8-list bv))))
 652
 653   (pass-if "make-typed-array"
 654     (let ((bv (make-typed-array 'vu8 77 33)))
 655       (equal? bv (u8-list->bytevector (make-list 33 77)))))
 656
 657   (pass-if-exception "make-typed-array [out-of-range]"
 658     exception:out-of-range
 659     (make-typed-array 'vu8 256 77)))
 660
 661 \f
 662 (with-test-prefix "uniform-array->bytevector"
 663
 664   (pass-if "bytevector"
 665     (let ((bv #vu8(0 1 128 255)))
 666       (equal? bv (uniform-array->bytevector bv))))
 667
 668   (pass-if "empty bitvector"
 669     (let ((bv (uniform-array->bytevector (make-bitvector 0))))
 670       (equal? bv #vu8())))
 671
 672   (pass-if "bitvector < 8"
 673     (let ((bv (uniform-array->bytevector (make-bitvector 4 #t))))
 674       (= (bytevector-length bv) 4)))
 675
 676   (pass-if "bitvector == 8"
 677     (let ((bv (uniform-array->bytevector (make-bitvector 8 #t))))
 678       (= (bytevector-length bv) 4)))
 679
 680   (pass-if "bitvector > 8"
 681     (let ((bv (uniform-array->bytevector (make-bitvector 9 #t))))
 682       (= (bytevector-length bv) 4)))
 683
 684   (pass-if "bitvector == 32"
 685     (let ((bv (uniform-array->bytevector (make-bitvector 32 #t))))
 686       (= (bytevector-length bv) 4)))
 687
 688   (pass-if "bitvector > 32"
 689     (let ((bv (uniform-array->bytevector (make-bitvector 33 #t))))
 690       (= (bytevector-length bv) 8))))
 691
 692 ;;; Local Variables:
 693 ;;; eval: (put 'with-test-prefix/c&e 'scheme-indent-function 1)
 694 ;;; End: