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