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