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