tests/bytevector.test

   1 ;;; R6RS Byte Vectors.
   2 ;;;
   3 ;;; Copyright 2007, 2009  Ludovic Courtès <ludo@gnu.org>
   4 ;;;
   5 ;;;
   6 ;;; This program is free software; you can redistribute it and/or modify
   7 ;;; it under the terms of the GNU General Public License as published by
   8 ;;; the Free Software Foundation; either version 2 of the License, or
   9 ;;; (at your option) any later version.
  10 ;;;
  11 ;;; This program 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
  14 ;;; GNU General Public License for more details.
  15 ;;;
  16 ;;; You should have received a copy of the GNU General Public License
  17 ;;; along with this program; if not, write to the Free Software
  18 ;;; Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301 USA
  19
  20 (define-module (test-bytevector)
  21   :use-module (test-suite lib)
  22   :use-module (rnrs bytevector))
  23
  24 ;;; Some of the tests in here are examples taken from the R6RS Standard
  25 ;;; Libraries document.
  26
  27 \f
  28 (with-test-prefix "2.2 General Operations"
  29
  30   (pass-if "native-endianness"
  31     (not (not (memq (native-endianness) '(big little)))))
  32
  33   (pass-if "make-bytevector"
  34     (and (bytevector? (make-bytevector 20))
  35          (bytevector? (make-bytevector 20 3))))
  36
  37   (pass-if "bytevector-length"
  38     (= (bytevector-length (make-bytevector 20)) 20))
  39
  40   (pass-if "bytevector=?"
  41     (and (bytevector=? (make-bytevector 20 7)
  42                        (make-bytevector 20 7))
  43          (not (bytevector=? (make-bytevector 20 7)
  44                             (make-bytevector 20 0))))))
  45
  46 \f
  47 (with-test-prefix "2.3 Operations on Bytes and Octets"
  48
  49   (pass-if "bytevector-{u8,s8}-ref"
  50     (equal? '(-127 129 -1 255)
  51             (let ((b1 (make-bytevector 16 -127))
  52                   (b2 (make-bytevector 16 255)))
  53               (list (bytevector-s8-ref b1 0)
  54                     (bytevector-u8-ref b1 0)
  55                     (bytevector-s8-ref b2 0)
  56                     (bytevector-u8-ref b2 0)))))
  57
  58   (pass-if "bytevector-{u8,s8}-set!"
  59     (equal? '(-126 130 -10 246)
  60             (let ((b (make-bytevector 16 -127)))
  61
  62               (bytevector-s8-set! b 0 -126)
  63               (bytevector-u8-set! b 1 246)
  64
  65               (list (bytevector-s8-ref b 0)
  66                     (bytevector-u8-ref b 0)
  67                     (bytevector-s8-ref b 1)
  68                     (bytevector-u8-ref b 1)))))
  69
  70   (pass-if "bytevector->u8-list"
  71     (let ((lst '(1 2 3 128 150 255)))
  72       (equal? lst
  73               (bytevector->u8-list
  74                (let ((b (make-bytevector 6)))
  75                  (for-each (lambda (i v)
  76                              (bytevector-u8-set! b i v))
  77                            (iota 6)
  78                            lst)
  79                  b)))))
  80
  81   (pass-if "u8-list->bytevector"
  82     (let ((lst '(1 2 3 128 150 255)))
  83       (equal? lst
  84               (bytevector->u8-list (u8-list->bytevector lst)))))
  85
  86   (pass-if "bytevector-uint-{ref,set!} [small]"
  87     (let ((b (make-bytevector 15)))
  88       (bytevector-uint-set! b 0 #x1234
  89                             (endianness little) 2)
  90       (equal? (bytevector-uint-ref b 0 (endianness big) 2)
  91               #x3412)))
  92
  93   (pass-if "bytevector-uint-set! [large]"
  94     (let ((b (make-bytevector 16)))
  95       (bytevector-uint-set! b 0 (- (expt 2 128) 3)
  96                             (endianness little) 16)
  97       (equal? (bytevector->u8-list b)
  98               '(253 255 255 255 255 255 255 255
  99                 255 255 255 255 255 255 255 255))))
 100
 101   (pass-if "bytevector-uint-{ref,set!} [large]"
 102     (let ((b (make-bytevector 120)))
 103       (bytevector-uint-set! b 0 (- (expt 2 128) 3)
 104                             (endianness little) 16)
 105       (equal? (bytevector-uint-ref b 0 (endianness little) 16)
 106               #xfffffffffffffffffffffffffffffffd)))
 107
 108   (pass-if "bytevector-sint-ref [small]"
 109     (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
 110       (equal? (bytevector-sint-ref b 0 (endianness big) 2)
 111               (bytevector-sint-ref b 1 (endianness little) 2)
 112               -16)))
 113
 114   (pass-if "bytevector-sint-ref [large]"
 115     (let ((b (make-bytevector 50)))
 116       (bytevector-uint-set! b 0 (- (expt 2 128) 3)
 117                             (endianness little) 16)
 118       (equal? (bytevector-sint-ref b 0 (endianness little) 16)
 119               -3)))
 120
 121   (pass-if "bytevector-sint-set! [small]"
 122     (let ((b (make-bytevector 3)))
 123       (bytevector-sint-set! b 0 -16 (endianness big) 2)
 124       (bytevector-sint-set! b 1 -16 (endianness little) 2)
 125       (equal? (bytevector->u8-list b)
 126               '(#xff #xf0 #xff)))))
 127
 128 \f
 129 (with-test-prefix "2.4 Operations on Integers of Arbitrary Size"
 130
 131   (pass-if "bytevector->sint-list"
 132     (let ((b (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
 133       (equal? (bytevector->sint-list b (endianness little) 2)
 134               '(513 -253 513 513))))
 135
 136   (pass-if "bytevector->uint-list"
 137     (let ((b (u8-list->bytevector '(2 1 255 3 2 1 2 1))))
 138       (equal? (bytevector->uint-list b (endianness big) 2)
 139               '(513 65283 513 513))))
 140
 141   (pass-if "bytevector->uint-list [empty]"
 142     (let ((b (make-bytevector 0)))
 143       (null? (bytevector->uint-list b (endianness big) 2))))
 144
 145   (pass-if-exception "bytevector->sint-list [out-of-range]"
 146     exception:out-of-range
 147     (bytevector->sint-list (make-bytevector 6) (endianness little) 8))
 148
 149   (pass-if "bytevector->sint-list [off-by-one]"
 150     (equal? (bytevector->sint-list (make-bytevector 31 #xff)
 151                                    (endianness little) 8)
 152             '(-1 -1 -1)))
 153
 154   (pass-if "{sint,uint}-list->bytevector"
 155     (let ((b1 (sint-list->bytevector '(513 -253 513 513)
 156                                      (endianness little) 2))
 157           (b2 (uint-list->bytevector '(513 65283 513 513)
 158                                      (endianness little) 2))
 159           (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
 160       (and (bytevector=? b1 b2)
 161            (bytevector=? b2 b3))))
 162
 163   (pass-if "sint-list->bytevector [limits]"
 164            (bytevector=? (sint-list->bytevector '(-32768 32767)
 165                                                 (endianness big) 2)
 166                          (let ((bv (make-bytevector 4)))
 167                            (bytevector-u8-set! bv 0 #x80)
 168                            (bytevector-u8-set! bv 1 #x00)
 169                            (bytevector-u8-set! bv 2 #x7f)
 170                            (bytevector-u8-set! bv 3 #xff)
 171                            bv)))
 172
 173   (pass-if-exception "sint-list->bytevector [out-of-range]"
 174     exception:out-of-range
 175     (sint-list->bytevector (list 0 0 (expt 2 16)) (endianness big)
 176                            2))
 177
 178   (pass-if-exception "uint-list->bytevector [out-of-range]"
 179     exception:out-of-range
 180     (uint-list->bytevector '(0 -1) (endianness big) 2)))
 181
 182 \f
 183 (with-test-prefix "2.5 Operations on 16-Bit Integers"
 184
 185   (pass-if "bytevector-u16-ref"
 186     (let ((b (u8-list->bytevector
 187               '(255 255 255 255 255 255 255 255
 188                 255 255 255 255 255 255 255 253))))
 189       (and (equal? (bytevector-u16-ref b 14 (endianness little))
 190                    #xfdff)
 191            (equal? (bytevector-u16-ref b 14 (endianness big))
 192                    #xfffd))))
 193
 194   (pass-if "bytevector-s16-ref"
 195     (let ((b (u8-list->bytevector
 196               '(255 255 255 255 255 255 255 255
 197                 255 255 255 255 255 255 255 253))))
 198       (and (equal? (bytevector-s16-ref b 14 (endianness little))
 199                    -513)
 200            (equal? (bytevector-s16-ref b 14 (endianness big))
 201                    -3))))
 202
 203   (pass-if "bytevector-s16-ref [unaligned]"
 204     (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
 205       (equal? (bytevector-s16-ref b 1 (endianness little))
 206               -16)))
 207
 208   (pass-if "bytevector-{u16,s16}-ref"
 209     (let ((b (make-bytevector 2)))
 210       (bytevector-u16-set! b 0 44444 (endianness little))
 211       (and (equal? (bytevector-u16-ref b 0 (endianness little))
 212                    44444)
 213            (equal? (bytevector-s16-ref b 0 (endianness little))
 214                    (- 44444 65536)))))
 215
 216   (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
 217     (let ((b (make-bytevector 2)))
 218       (bytevector-u16-native-set! b 0 44444)
 219       (and (equal? (bytevector-u16-native-ref b 0)
 220                    44444)
 221            (equal? (bytevector-s16-native-ref b 0)
 222                    (- 44444 65536)))))
 223
 224   (pass-if "bytevector-s16-{ref,set!} [unaligned]"
 225     (let ((b (make-bytevector 3)))
 226       (bytevector-s16-set! b 1 -77 (endianness little))
 227       (equal? (bytevector-s16-ref b 1 (endianness little))
 228               -77))))
 229
 230 \f
 231 (with-test-prefix "2.6 Operations on 32-bit Integers"
 232
 233   (pass-if "bytevector-u32-ref"
 234     (let ((b (u8-list->bytevector
 235               '(255 255 255 255 255 255 255 255
 236                 255 255 255 255 255 255 255 253))))
 237       (and (equal? (bytevector-u32-ref b 12 (endianness little))
 238                    #xfdffffff)
 239            (equal? (bytevector-u32-ref b 12 (endianness big))
 240                    #xfffffffd))))
 241
 242   (pass-if "bytevector-s32-ref"
 243     (let ((b (u8-list->bytevector
 244               '(255 255 255 255 255 255 255 255
 245                 255 255 255 255 255 255 255 253))))
 246       (and (equal? (bytevector-s32-ref b 12 (endianness little))
 247                    -33554433)
 248            (equal? (bytevector-s32-ref b 12 (endianness big))
 249                    -3))))
 250
 251   (pass-if "bytevector-{u32,s32}-ref"
 252     (let ((b (make-bytevector 4)))
 253       (bytevector-u32-set! b 0 2222222222 (endianness little))
 254       (and (equal? (bytevector-u32-ref b 0 (endianness little))
 255                    2222222222)
 256            (equal? (bytevector-s32-ref b 0 (endianness little))
 257                    (- 2222222222 (expt 2 32))))))
 258
 259   (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
 260     (let ((b (make-bytevector 4)))
 261       (bytevector-u32-native-set! b 0 2222222222)
 262       (and (equal? (bytevector-u32-native-ref b 0)
 263                    2222222222)
 264            (equal? (bytevector-s32-native-ref b 0)
 265                    (- 2222222222 (expt 2 32)))))))
 266
 267 \f
 268 (with-test-prefix "2.7 Operations on 64-bit Integers"
 269
 270   (pass-if "bytevector-u64-ref"
 271     (let ((b (u8-list->bytevector
 272               '(255 255 255 255 255 255 255 255
 273                 255 255 255 255 255 255 255 253))))
 274       (and (equal? (bytevector-u64-ref b 8 (endianness little))
 275                    #xfdffffffffffffff)
 276            (equal? (bytevector-u64-ref b 8 (endianness big))
 277                    #xfffffffffffffffd))))
 278
 279   (pass-if "bytevector-s64-ref"
 280     (let ((b (u8-list->bytevector
 281               '(255 255 255 255 255 255 255 255
 282                 255 255 255 255 255 255 255 253))))
 283       (and (equal? (bytevector-s64-ref b 8 (endianness little))
 284                    -144115188075855873)
 285            (equal? (bytevector-s64-ref b 8 (endianness big))
 286                    -3))))
 287
 288   (pass-if "bytevector-{u64,s64}-ref"
 289     (let ((b (make-bytevector 8))
 290           (big 9333333333333333333))
 291       (bytevector-u64-set! b 0 big (endianness little))
 292       (and (equal? (bytevector-u64-ref b 0 (endianness little))
 293                    big)
 294            (equal? (bytevector-s64-ref b 0 (endianness little))
 295                    (- big (expt 2 64))))))
 296
 297   (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
 298     (let ((b (make-bytevector 8))
 299           (big 9333333333333333333))
 300       (bytevector-u64-native-set! b 0 big)
 301       (and (equal? (bytevector-u64-native-ref b 0)
 302                    big)
 303            (equal? (bytevector-s64-native-ref b 0)
 304                    (- big (expt 2 64))))))
 305
 306   (pass-if "ref/set! with zero"
 307      (let ((b (make-bytevector 8)))
 308        (bytevector-s64-set! b 0 -1 (endianness big))
 309        (bytevector-u64-set! b 0  0 (endianness big))
 310        (= 0 (bytevector-u64-ref b 0 (endianness big))))))
 311
 312 \f
 313 (with-test-prefix "2.8 Operations on IEEE-754 Representations"
 314
 315   (pass-if "bytevector-ieee-single-native-{ref,set!}"
 316     (let ((b (make-bytevector 4))
 317           (number 3.00))
 318       (bytevector-ieee-single-native-set! b 0 number)
 319       (equal? (bytevector-ieee-single-native-ref b 0)
 320               number)))
 321
 322   (pass-if "bytevector-ieee-single-{ref,set!}"
 323     (let ((b (make-bytevector 8))
 324           (number 3.14))
 325       (bytevector-ieee-single-set! b 0 number (endianness little))
 326       (bytevector-ieee-single-set! b 4 number (endianness big))
 327       (equal? (bytevector-ieee-single-ref b 0 (endianness little))
 328               (bytevector-ieee-single-ref b 4 (endianness big)))))
 329
 330   (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
 331     (let ((b (make-bytevector 9))
 332           (number 3.14))
 333       (bytevector-ieee-single-set! b 1 number (endianness little))
 334       (bytevector-ieee-single-set! b 5 number (endianness big))
 335       (equal? (bytevector-ieee-single-ref b 1 (endianness little))
 336               (bytevector-ieee-single-ref b 5 (endianness big)))))
 337
 338   (pass-if "bytevector-ieee-double-native-{ref,set!}"
 339     (let ((b (make-bytevector 8))
 340           (number 3.14))
 341       (bytevector-ieee-double-native-set! b 0 number)
 342       (equal? (bytevector-ieee-double-native-ref b 0)
 343               number)))
 344
 345   (pass-if "bytevector-ieee-double-{ref,set!}"
 346     (let ((b (make-bytevector 16))
 347           (number 3.14))
 348       (bytevector-ieee-double-set! b 0 number (endianness little))
 349       (bytevector-ieee-double-set! b 8 number (endianness big))
 350       (equal? (bytevector-ieee-double-ref b 0 (endianness little))
 351               (bytevector-ieee-double-ref b 8 (endianness big))))))
 352
 353 \f
 354 (define (with-locale locale thunk)
 355   ;; Run THUNK under LOCALE.
 356   (let ((original-locale (setlocale LC_ALL)))
 357     (catch 'system-error
 358       (lambda ()
 359         (setlocale LC_ALL locale))
 360       (lambda (key . args)
 361         (throw 'unresolved)))
 362
 363     (dynamic-wind
 364         (lambda ()
 365           #t)
 366         thunk
 367         (lambda ()
 368           (setlocale LC_ALL original-locale)))))
 369
 370 (define (with-latin1-locale thunk)
 371   ;; Try out several ISO-8859-1 locales and run THUNK under the one that
 372   ;; works (if any).
 373   (define %locales
 374     (map (lambda (name)
 375            (string-append name ".ISO-8859-1"))
 376          '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
 377
 378   (let loop ((locales %locales))
 379     (if (null? locales)
 380         (throw 'unresolved)
 381         (catch 'unresolved
 382           (lambda ()
 383             (with-locale (car locales) thunk))
 384           (lambda (key . args)
 385             (loop (cdr locales)))))))
 386
 387
 388 ;; Default to the C locale for the following tests.
 389 (setlocale LC_ALL "C")
 390
 391
 392 (with-test-prefix "2.9 Operations on Strings"
 393
 394   (pass-if "string->utf8"
 395     (let* ((str  "hello, world")
 396            (utf8 (string->utf8 str)))
 397       (and (bytevector? utf8)
 398            (= (bytevector-length utf8)
 399               (string-length str))
 400            (equal? (string->list str)
 401                    (map integer->char (bytevector->u8-list utf8))))))
 402
 403   (pass-if "string->utf8 [latin-1]"
 404     (with-latin1-locale
 405       (lambda ()
 406         (let* ((str  "hé, ça va bien ?")
 407                (utf8 (string->utf8 str)))
 408           (and (bytevector? utf8)
 409                (= (bytevector-length utf8)
 410                   (+ 2 (string-length str))))))))
 411
 412   (pass-if "string->utf16"
 413     (let* ((str   "hello, world")
 414            (utf16 (string->utf16 str)))
 415       (and (bytevector? utf16)
 416            (= (bytevector-length utf16)
 417               (* 2 (string-length str)))
 418            (equal? (string->list str)
 419                    (map integer->char
 420                         (bytevector->uint-list utf16
 421                                                (endianness big) 2))))))
 422
 423   (pass-if "string->utf16 [little]"
 424     (let* ((str   "hello, world")
 425            (utf16 (string->utf16 str (endianness little))))
 426       (and (bytevector? utf16)
 427            (= (bytevector-length utf16)
 428               (* 2 (string-length str)))
 429            (equal? (string->list str)
 430                    (map integer->char
 431                         (bytevector->uint-list utf16
 432                                                (endianness little) 2))))))
 433
 434
 435   (pass-if "string->utf32"
 436     (let* ((str   "hello, world")
 437            (utf32 (string->utf32 str)))
 438       (and (bytevector? utf32)
 439            (= (bytevector-length utf32)
 440               (* 4 (string-length str)))
 441            (equal? (string->list str)
 442                    (map integer->char
 443                         (bytevector->uint-list utf32
 444                                                (endianness big) 4))))))
 445
 446   (pass-if "string->utf32 [little]"
 447     (let* ((str   "hello, world")
 448            (utf32 (string->utf32 str (endianness little))))
 449       (and (bytevector? utf32)
 450            (= (bytevector-length utf32)
 451               (* 4 (string-length str)))
 452            (equal? (string->list str)
 453                    (map integer->char
 454                         (bytevector->uint-list utf32
 455                                                (endianness little) 4))))))
 456
 457   (pass-if "utf8->string"
 458     (let* ((utf8  (u8-list->bytevector (map char->integer
 459                                             (string->list "hello, world"))))
 460            (str   (utf8->string utf8)))
 461       (and (string? str)
 462            (= (string-length str)
 463               (bytevector-length utf8))
 464            (equal? (string->list str)
 465                    (map integer->char (bytevector->u8-list utf8))))))
 466
 467   (pass-if "utf8->string [latin-1]"
 468     (with-latin1-locale
 469       (lambda ()
 470         (let* ((utf8  (string->utf8 "hé, ça va bien ?"))
 471                (str   (utf8->string utf8)))
 472           (and (string? str)
 473                (= (string-length str)
 474                   (- (bytevector-length utf8) 2)))))))
 475
 476   (pass-if "utf16->string"
 477     (let* ((utf16  (uint-list->bytevector (map char->integer
 478                                                (string->list "hello, world"))
 479                                           (endianness big) 2))
 480            (str   (utf16->string utf16)))
 481       (and (string? str)
 482            (= (* 2 (string-length str))
 483               (bytevector-length utf16))
 484            (equal? (string->list str)
 485                    (map integer->char
 486                         (bytevector->uint-list utf16 (endianness big)
 487                                                2))))))
 488
 489   (pass-if "utf16->string [little]"
 490     (let* ((utf16  (uint-list->bytevector (map char->integer
 491                                                (string->list "hello, world"))
 492                                           (endianness little) 2))
 493            (str   (utf16->string utf16 (endianness little))))
 494       (and (string? str)
 495            (= (* 2 (string-length str))
 496               (bytevector-length utf16))
 497            (equal? (string->list str)
 498                    (map integer->char
 499                         (bytevector->uint-list utf16 (endianness little)
 500                                                2))))))
 501   (pass-if "utf32->string"
 502     (let* ((utf32  (uint-list->bytevector (map char->integer
 503                                                (string->list "hello, world"))
 504                                           (endianness big) 4))
 505            (str   (utf32->string utf32)))
 506       (and (string? str)
 507            (= (* 4 (string-length str))
 508               (bytevector-length utf32))
 509            (equal? (string->list str)
 510                    (map integer->char
 511                         (bytevector->uint-list utf32 (endianness big)
 512                                                4))))))
 513
 514   (pass-if "utf32->string [little]"
 515     (let* ((utf32  (uint-list->bytevector (map char->integer
 516                                                (string->list "hello, world"))
 517                                           (endianness little) 4))
 518            (str   (utf32->string utf32 (endianness little))))
 519       (and (string? str)
 520            (= (* 4 (string-length str))
 521               (bytevector-length utf32))
 522            (equal? (string->list str)
 523                    (map integer->char
 524                         (bytevector->uint-list utf32 (endianness little)
 525                                                4)))))))
 526
 527
 528 ;;; Local Variables:
 529 ;;; coding: latin-1
 530 ;;; mode: scheme
 531 ;;; End: