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 "{sint,uint}-list->bytevector"
 150     (let ((b1 (sint-list->bytevector '(513 -253 513 513)
 151                                      (endianness little) 2))
 152           (b2 (uint-list->bytevector '(513 65283 513 513)
 153                                      (endianness little) 2))
 154           (b3 (u8-list->bytevector '(1 2 3 255 1 2 1 2))))
 155       (and (bytevector=? b1 b2)
 156            (bytevector=? b2 b3)))))
 157
 158 \f
 159 (with-test-prefix "2.5 Operations on 16-Bit Integers"
 160
 161   (pass-if "bytevector-u16-ref"
 162     (let ((b (u8-list->bytevector
 163               '(255 255 255 255 255 255 255 255
 164                 255 255 255 255 255 255 255 253))))
 165       (and (equal? (bytevector-u16-ref b 14 (endianness little))
 166                    #xfdff)
 167            (equal? (bytevector-u16-ref b 14 (endianness big))
 168                    #xfffd))))
 169
 170   (pass-if "bytevector-s16-ref"
 171     (let ((b (u8-list->bytevector
 172               '(255 255 255 255 255 255 255 255
 173                 255 255 255 255 255 255 255 253))))
 174       (and (equal? (bytevector-s16-ref b 14 (endianness little))
 175                    -513)
 176            (equal? (bytevector-s16-ref b 14 (endianness big))
 177                    -3))))
 178
 179   (pass-if "bytevector-s16-ref [unaligned]"
 180     (let ((b (u8-list->bytevector '(#xff #xf0 #xff))))
 181       (equal? (bytevector-s16-ref b 1 (endianness little))
 182               -16)))
 183
 184   (pass-if "bytevector-{u16,s16}-ref"
 185     (let ((b (make-bytevector 2)))
 186       (bytevector-u16-set! b 0 44444 (endianness little))
 187       (and (equal? (bytevector-u16-ref b 0 (endianness little))
 188                    44444)
 189            (equal? (bytevector-s16-ref b 0 (endianness little))
 190                    (- 44444 65536)))))
 191
 192   (pass-if "bytevector-native-{u16,s16}-{ref,set!}"
 193     (let ((b (make-bytevector 2)))
 194       (bytevector-u16-native-set! b 0 44444)
 195       (and (equal? (bytevector-u16-native-ref b 0)
 196                    44444)
 197            (equal? (bytevector-s16-native-ref b 0)
 198                    (- 44444 65536)))))
 199
 200   (pass-if "bytevector-s16-{ref,set!} [unaligned]"
 201     (let ((b (make-bytevector 3)))
 202       (bytevector-s16-set! b 1 -77 (endianness little))
 203       (equal? (bytevector-s16-ref b 1 (endianness little))
 204               -77))))
 205
 206 \f
 207 (with-test-prefix "2.6 Operations on 32-bit Integers"
 208
 209   (pass-if "bytevector-u32-ref"
 210     (let ((b (u8-list->bytevector
 211               '(255 255 255 255 255 255 255 255
 212                 255 255 255 255 255 255 255 253))))
 213       (and (equal? (bytevector-u32-ref b 12 (endianness little))
 214                    #xfdffffff)
 215            (equal? (bytevector-u32-ref b 12 (endianness big))
 216                    #xfffffffd))))
 217
 218   (pass-if "bytevector-s32-ref"
 219     (let ((b (u8-list->bytevector
 220               '(255 255 255 255 255 255 255 255
 221                 255 255 255 255 255 255 255 253))))
 222       (and (equal? (bytevector-s32-ref b 12 (endianness little))
 223                    -33554433)
 224            (equal? (bytevector-s32-ref b 12 (endianness big))
 225                    -3))))
 226
 227   (pass-if "bytevector-{u32,s32}-ref"
 228     (let ((b (make-bytevector 4)))
 229       (bytevector-u32-set! b 0 2222222222 (endianness little))
 230       (and (equal? (bytevector-u32-ref b 0 (endianness little))
 231                    2222222222)
 232            (equal? (bytevector-s32-ref b 0 (endianness little))
 233                    (- 2222222222 (expt 2 32))))))
 234
 235   (pass-if "bytevector-{u32,s32}-native-{ref,set!}"
 236     (let ((b (make-bytevector 4)))
 237       (bytevector-u32-native-set! b 0 2222222222)
 238       (and (equal? (bytevector-u32-native-ref b 0)
 239                    2222222222)
 240            (equal? (bytevector-s32-native-ref b 0)
 241                    (- 2222222222 (expt 2 32)))))))
 242
 243 \f
 244 (with-test-prefix "2.7 Operations on 64-bit Integers"
 245
 246   (pass-if "bytevector-u64-ref"
 247     (let ((b (u8-list->bytevector
 248               '(255 255 255 255 255 255 255 255
 249                 255 255 255 255 255 255 255 253))))
 250       (and (equal? (bytevector-u64-ref b 8 (endianness little))
 251                    #xfdffffffffffffff)
 252            (equal? (bytevector-u64-ref b 8 (endianness big))
 253                    #xfffffffffffffffd))))
 254
 255   (pass-if "bytevector-s64-ref"
 256     (let ((b (u8-list->bytevector
 257               '(255 255 255 255 255 255 255 255
 258                 255 255 255 255 255 255 255 253))))
 259       (and (equal? (bytevector-s64-ref b 8 (endianness little))
 260                    -144115188075855873)
 261            (equal? (bytevector-s64-ref b 8 (endianness big))
 262                    -3))))
 263
 264   (pass-if "bytevector-{u64,s64}-ref"
 265     (let ((b (make-bytevector 8))
 266           (big 9333333333333333333))
 267       (bytevector-u64-set! b 0 big (endianness little))
 268       (and (equal? (bytevector-u64-ref b 0 (endianness little))
 269                    big)
 270            (equal? (bytevector-s64-ref b 0 (endianness little))
 271                    (- big (expt 2 64))))))
 272
 273   (pass-if "bytevector-{u64,s64}-native-{ref,set!}"
 274     (let ((b (make-bytevector 8))
 275           (big 9333333333333333333))
 276       (bytevector-u64-native-set! b 0 big)
 277       (and (equal? (bytevector-u64-native-ref b 0)
 278                    big)
 279            (equal? (bytevector-s64-native-ref b 0)
 280                    (- big (expt 2 64))))))
 281
 282   (pass-if "ref/set! with zero"
 283      (let ((b (make-bytevector 8)))
 284        (bytevector-s64-set! b 0 -1 (endianness big))
 285        (bytevector-u64-set! b 0  0 (endianness big))
 286        (= 0 (bytevector-u64-ref b 0 (endianness big))))))
 287
 288 \f
 289 (with-test-prefix "2.8 Operations on IEEE-754 Representations"
 290
 291   (pass-if "bytevector-ieee-single-native-{ref,set!}"
 292     (let ((b (make-bytevector 4))
 293           (number 3.00))
 294       (bytevector-ieee-single-native-set! b 0 number)
 295       (equal? (bytevector-ieee-single-native-ref b 0)
 296               number)))
 297
 298   (pass-if "bytevector-ieee-single-{ref,set!}"
 299     (let ((b (make-bytevector 8))
 300           (number 3.14))
 301       (bytevector-ieee-single-set! b 0 number (endianness little))
 302       (bytevector-ieee-single-set! b 4 number (endianness big))
 303       (equal? (bytevector-ieee-single-ref b 0 (endianness little))
 304               (bytevector-ieee-single-ref b 4 (endianness big)))))
 305
 306   (pass-if "bytevector-ieee-single-{ref,set!} [unaligned]"
 307     (let ((b (make-bytevector 9))
 308           (number 3.14))
 309       (bytevector-ieee-single-set! b 1 number (endianness little))
 310       (bytevector-ieee-single-set! b 5 number (endianness big))
 311       (equal? (bytevector-ieee-single-ref b 1 (endianness little))
 312               (bytevector-ieee-single-ref b 5 (endianness big)))))
 313
 314   (pass-if "bytevector-ieee-double-native-{ref,set!}"
 315     (let ((b (make-bytevector 8))
 316           (number 3.14))
 317       (bytevector-ieee-double-native-set! b 0 number)
 318       (equal? (bytevector-ieee-double-native-ref b 0)
 319               number)))
 320
 321   (pass-if "bytevector-ieee-double-{ref,set!}"
 322     (let ((b (make-bytevector 16))
 323           (number 3.14))
 324       (bytevector-ieee-double-set! b 0 number (endianness little))
 325       (bytevector-ieee-double-set! b 8 number (endianness big))
 326       (equal? (bytevector-ieee-double-ref b 0 (endianness little))
 327               (bytevector-ieee-double-ref b 8 (endianness big))))))
 328
 329 \f
 330 (define (with-locale locale thunk)
 331   ;; Run THUNK under LOCALE.
 332   (let ((original-locale (setlocale LC_ALL)))
 333     (catch 'system-error
 334       (lambda ()
 335         (setlocale LC_ALL locale))
 336       (lambda (key . args)
 337         (throw 'unresolved)))
 338
 339     (dynamic-wind
 340         (lambda ()
 341           #t)
 342         thunk
 343         (lambda ()
 344           (setlocale LC_ALL original-locale)))))
 345
 346 (define (with-latin1-locale thunk)
 347   ;; Try out several ISO-8859-1 locales and run THUNK under the one that
 348   ;; works (if any).
 349   (define %locales
 350     (map (lambda (name)
 351            (string-append name ".ISO-8859-1"))
 352          '("fr_FR" "es_ES" "en_GB" "en_US" "de_DE" "pt_PT")))
 353
 354   (let loop ((locales %locales))
 355     (if (null? locales)
 356         (throw 'unresolved)
 357         (catch 'unresolved
 358           (lambda ()
 359             (with-locale (car locales) thunk))
 360           (lambda (key . args)
 361             (loop (cdr locales)))))))
 362
 363
 364 ;; Default to the C locale for the following tests.
 365 (setlocale LC_ALL "C")
 366
 367
 368 (with-test-prefix "2.9 Operations on Strings"
 369
 370   (pass-if "string->utf8"
 371     (let* ((str  "hello, world")
 372            (utf8 (string->utf8 str)))
 373       (and (bytevector? utf8)
 374            (= (bytevector-length utf8)
 375               (string-length str))
 376            (equal? (string->list str)
 377                    (map integer->char (bytevector->u8-list utf8))))))
 378
 379   (pass-if "string->utf8 [latin-1]"
 380     (with-latin1-locale
 381       (lambda ()
 382         (let* ((str  "hé, ça va bien ?")
 383                (utf8 (string->utf8 str)))
 384           (and (bytevector? utf8)
 385                (= (bytevector-length utf8)
 386                   (+ 2 (string-length str))))))))
 387
 388   (pass-if "string->utf16"
 389     (let* ((str   "hello, world")
 390            (utf16 (string->utf16 str)))
 391       (and (bytevector? utf16)
 392            (= (bytevector-length utf16)
 393               (* 2 (string-length str)))
 394            (equal? (string->list str)
 395                    (map integer->char
 396                         (bytevector->uint-list utf16
 397                                                (endianness big) 2))))))
 398
 399   (pass-if "string->utf16 [little]"
 400     (let* ((str   "hello, world")
 401            (utf16 (string->utf16 str (endianness little))))
 402       (and (bytevector? utf16)
 403            (= (bytevector-length utf16)
 404               (* 2 (string-length str)))
 405            (equal? (string->list str)
 406                    (map integer->char
 407                         (bytevector->uint-list utf16
 408                                                (endianness little) 2))))))
 409
 410
 411   (pass-if "string->utf32"
 412     (let* ((str   "hello, world")
 413            (utf32 (string->utf32 str)))
 414       (and (bytevector? utf32)
 415            (= (bytevector-length utf32)
 416               (* 4 (string-length str)))
 417            (equal? (string->list str)
 418                    (map integer->char
 419                         (bytevector->uint-list utf32
 420                                                (endianness big) 4))))))
 421
 422   (pass-if "string->utf32 [little]"
 423     (let* ((str   "hello, world")
 424            (utf32 (string->utf32 str (endianness little))))
 425       (and (bytevector? utf32)
 426            (= (bytevector-length utf32)
 427               (* 4 (string-length str)))
 428            (equal? (string->list str)
 429                    (map integer->char
 430                         (bytevector->uint-list utf32
 431                                                (endianness little) 4))))))
 432
 433   (pass-if "utf8->string"
 434     (let* ((utf8  (u8-list->bytevector (map char->integer
 435                                             (string->list "hello, world"))))
 436            (str   (utf8->string utf8)))
 437       (and (string? str)
 438            (= (string-length str)
 439               (bytevector-length utf8))
 440            (equal? (string->list str)
 441                    (map integer->char (bytevector->u8-list utf8))))))
 442
 443   (pass-if "utf8->string [latin-1]"
 444     (with-latin1-locale
 445       (lambda ()
 446         (let* ((utf8  (string->utf8 "hé, ça va bien ?"))
 447                (str   (utf8->string utf8)))
 448           (and (string? str)
 449                (= (string-length str)
 450                   (- (bytevector-length utf8) 2)))))))
 451
 452   (pass-if "utf16->string"
 453     (let* ((utf16  (uint-list->bytevector (map char->integer
 454                                                (string->list "hello, world"))
 455                                           (endianness big) 2))
 456            (str   (utf16->string utf16)))
 457       (and (string? str)
 458            (= (* 2 (string-length str))
 459               (bytevector-length utf16))
 460            (equal? (string->list str)
 461                    (map integer->char
 462                         (bytevector->uint-list utf16 (endianness big)
 463                                                2))))))
 464
 465   (pass-if "utf16->string [little]"
 466     (let* ((utf16  (uint-list->bytevector (map char->integer
 467                                                (string->list "hello, world"))
 468                                           (endianness little) 2))
 469            (str   (utf16->string utf16 (endianness little))))
 470       (and (string? str)
 471            (= (* 2 (string-length str))
 472               (bytevector-length utf16))
 473            (equal? (string->list str)
 474                    (map integer->char
 475                         (bytevector->uint-list utf16 (endianness little)
 476                                                2))))))
 477   (pass-if "utf32->string"
 478     (let* ((utf32  (uint-list->bytevector (map char->integer
 479                                                (string->list "hello, world"))
 480                                           (endianness big) 4))
 481            (str   (utf32->string utf32)))
 482       (and (string? str)
 483            (= (* 4 (string-length str))
 484               (bytevector-length utf32))
 485            (equal? (string->list str)
 486                    (map integer->char
 487                         (bytevector->uint-list utf32 (endianness big)
 488                                                4))))))
 489
 490   (pass-if "utf32->string [little]"
 491     (let* ((utf32  (uint-list->bytevector (map char->integer
 492                                                (string->list "hello, world"))
 493                                           (endianness little) 4))
 494            (str   (utf32->string utf32 (endianness little))))
 495       (and (string? str)
 496            (= (* 4 (string-length str))
 497               (bytevector-length utf32))
 498            (equal? (string->list str)
 499                    (map integer->char
 500                         (bytevector->uint-list utf32 (endianness little)
 501                                                4)))))))
 502
 503
 504 ;;; Local Variables:
 505 ;;; coding: latin-1
 506 ;;; mode: scheme
 507 ;;; End: