tests/bytevector.test

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