test-suite/tests/bytevectors.test

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