test-suite/tests/srfi-4.test

   1 ;;;; srfi-4.test --- Test suite for Guile's SRFI-4 functions. -*- scheme -*-
   2 ;;;; Martin Grabmueller, 2001-06-26
   3 ;;;;
   4 ;;;; Copyright (C) 2001, 2006, 2010, 2011, 2013, 2014 Free Software Foundation, Inc.
   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 (use-modules (srfi srfi-4)
  21              (srfi srfi-4 gnu)
  22              (test-suite lib))
  23
  24 (with-test-prefix "u8 vectors"
  25
  26   (pass-if "u8vector? success"
  27     (u8vector? (u8vector)))
  28
  29   (pass-if "u8vector? failure"
  30     (not (u8vector? (s8vector))))
  31
  32   (pass-if "u8vector-length success 1"
  33     (= (u8vector-length (u8vector)) 0))
  34
  35   (pass-if "u8vector-length success 2"
  36     (= (u8vector-length (u8vector 3)) 1))
  37
  38   (pass-if "u8vector-length failure"
  39     (not (= (u8vector-length (u8vector 3)) 3)))
  40
  41   (pass-if "u8vector-ref"
  42     (= (u8vector-ref (u8vector 1 2 3) 1) 2))
  43
  44   (pass-if "u8vector-set!/ref"
  45     (= (let ((s (make-u8vector 10 0)))
  46          (u8vector-set! s 4 33)
  47          (u8vector-ref s 4)) 33))
  48
  49   (pass-if "u8vector->list/list->u8vector"
  50     (equal? (u8vector->list (u8vector 1 2 3 4))
  51             (u8vector->list (list->u8vector '(1 2 3 4)))))
  52
  53   (pass-if "u8vector->list/array->list"
  54     (equal? (u8vector->list (u8vector 1 2 3 4))
  55             (array->list (u8vector 1 2 3 4))))
  56
  57   (pass-if "make-u8vector"
  58     (equal? (list->u8vector '(7 7 7 7))
  59             (make-u8vector 4 7))))
  60
  61 (with-test-prefix "s8 vectors"
  62
  63   (pass-if "s8vector? success"
  64     (s8vector? (s8vector)))
  65
  66   (pass-if "s8vector? failure"
  67     (not (s8vector? (u8vector))))
  68
  69   (pass-if "s8vector-length success 1"
  70     (= (s8vector-length (s8vector)) 0))
  71
  72   (pass-if "s8vector-length success 2"
  73     (= (s8vector-length (s8vector -3)) 1))
  74
  75   (pass-if "s8vector-length failure"
  76     (not (= (s8vector-length (s8vector 3)) 3)))
  77
  78   (pass-if "s8vector-ref"
  79     (= (s8vector-ref (s8vector 1 2 3) 1) 2))
  80
  81   (pass-if "s8vector-set!/ref"
  82     (= (let ((s (make-s8vector 10 0)))
  83          (s8vector-set! s 4 33)
  84          (s8vector-ref s 4)) 33))
  85
  86   (pass-if "s8vector->list/list->s8vector"
  87     (equal? (s8vector->list (s8vector 1 2 3 4))
  88             (s8vector->list (list->s8vector '(1 2 3 4)))))
  89
  90   (pass-if "s8vector->list/array->list"
  91     (equal? (s8vector->list (s8vector 1 2 3 4))
  92             (array->list (s8vector 1 2 3 4))))
  93
  94   (pass-if "make-s8vector"
  95     (equal? (list->s8vector '(7 7 7 7))
  96             (make-s8vector 4 7))))
  97
  98
  99 (with-test-prefix "u16 vectors"
 100
 101   (pass-if "u16vector? success"
 102     (u16vector? (u16vector)))
 103
 104   (pass-if "u16vector? failure"
 105     (not (u16vector? (s16vector))))
 106
 107   (pass-if "u16vector-length success 1"
 108     (= (u16vector-length (u16vector)) 0))
 109
 110   (pass-if "u16vector-length success 2"
 111     (= (u16vector-length (u16vector 3)) 1))
 112
 113   (pass-if "u16vector-length failure"
 114     (not (= (u16vector-length (u16vector 3)) 3)))
 115
 116   (pass-if "u16vector-ref"
 117     (= (u16vector-ref (u16vector 1 2 3) 1) 2))
 118
 119   (pass-if "u16vector-set!/ref"
 120     (= (let ((s (make-u16vector 10 0)))
 121          (u16vector-set! s 4 33)
 122          (u16vector-ref s 4)) 33))
 123
 124   (pass-if "u16vector->list/list->u16vector"
 125     (equal? (u16vector->list (u16vector 1 2 3 4))
 126             (u16vector->list (list->u16vector '(1 2 3 4)))))
 127
 128   (pass-if "u16vector->list/array->list"
 129     (equal? (u16vector->list (u16vector 1 2 3 4))
 130             (array->list (u16vector 1 2 3 4))))
 131
 132   (pass-if "make-u16vector"
 133     (equal? (list->u16vector '(7 7 7 7))
 134             (make-u16vector 4 7))))
 135
 136 (with-test-prefix "s16 vectors"
 137
 138   (pass-if "s16vector? success"
 139     (s16vector? (s16vector)))
 140
 141   (pass-if "s16vector? failure"
 142     (not (s16vector? (u16vector))))
 143
 144   (pass-if "s16vector-length success 1"
 145     (= (s16vector-length (s16vector)) 0))
 146
 147   (pass-if "s16vector-length success 2"
 148     (= (s16vector-length (s16vector -3)) 1))
 149
 150   (pass-if "s16vector-length failure"
 151     (not (= (s16vector-length (s16vector 3)) 3)))
 152
 153   (pass-if "s16vector-ref"
 154     (= (s16vector-ref (s16vector 1 2 3) 1) 2))
 155
 156   (pass-if "s16vector-set!/ref"
 157     (= (let ((s (make-s16vector 10 0)))
 158          (s16vector-set! s 4 33)
 159          (s16vector-ref s 4)) 33))
 160
 161   (pass-if "s16vector->list/list->s16vector"
 162     (equal? (s16vector->list (s16vector 1 2 3 4))
 163             (s16vector->list (list->s16vector '(1 2 3 4)))))
 164
 165   (pass-if "s16vector->list/array->list"
 166     (equal? (s16vector->list (s16vector 1 2 3 4))
 167             (array->list (s16vector 1 2 3 4))))
 168
 169   (pass-if "make-s16vector"
 170     (equal? (list->s16vector '(7 7 7 7))
 171             (make-s16vector 4 7))))
 172
 173 (with-test-prefix "u32 vectors"
 174
 175   (pass-if "u32vector? success"
 176     (u32vector? (u32vector)))
 177
 178   (pass-if "u32vector? failure"
 179     (not (u32vector? (s32vector))))
 180
 181   (pass-if "u32vector-length success 1"
 182     (= (u32vector-length (u32vector)) 0))
 183
 184   (pass-if "u32vector-length success 2"
 185     (= (u32vector-length (u32vector 3)) 1))
 186
 187   (pass-if "u32vector-length failure"
 188     (not (= (u32vector-length (u32vector 3)) 3)))
 189
 190   (pass-if "u32vector-ref"
 191     (= (u32vector-ref (u32vector 1 2 3) 1) 2))
 192
 193   (pass-if "u32vector-set!/ref"
 194     (= (let ((s (make-u32vector 10 0)))
 195          (u32vector-set! s 4 33)
 196          (u32vector-ref s 4)) 33))
 197
 198   (pass-if "u32vector->list/list->u32vector"
 199     (equal? (u32vector->list (u32vector 1 2 3 4))
 200             (u32vector->list (list->u32vector '(1 2 3 4)))))
 201
 202   (pass-if "u32vector->list/array->list"
 203     (equal? (u32vector->list (u32vector 1 2 3 4))
 204             (array->list (u32vector 1 2 3 4))))
 205
 206   (pass-if "make-u32vector"
 207     (equal? (list->u32vector '(7 7 7 7))
 208             (make-u32vector 4 7))))
 209
 210 (with-test-prefix "s32 vectors"
 211
 212   (pass-if "s32vector? success"
 213     (s32vector? (s32vector)))
 214
 215   (pass-if "s32vector? failure"
 216     (not (s32vector? (u32vector))))
 217
 218   (pass-if "s32vector-length success 1"
 219     (= (s32vector-length (s32vector)) 0))
 220
 221   (pass-if "s32vector-length success 2"
 222     (= (s32vector-length (s32vector -3)) 1))
 223
 224   (pass-if "s32vector-length failure"
 225     (not (= (s32vector-length (s32vector 3)) 3)))
 226
 227   (pass-if "s32vector-ref"
 228     (= (s32vector-ref (s32vector 1 2 3) 1) 2))
 229
 230   (pass-if "s32vector-set!/ref"
 231     (= (let ((s (make-s32vector 10 0)))
 232          (s32vector-set! s 4 33)
 233          (s32vector-ref s 4)) 33))
 234
 235   (pass-if "s32vector->list/list->s32vector"
 236     (equal? (s32vector->list (s32vector 1 2 3 4))
 237             (s32vector->list (list->s32vector '(1 2 3 4)))))
 238
 239   (pass-if "s32vector->list/array->list"
 240     (equal? (s32vector->list (s32vector 1 2 3 4))
 241             (array->list (s32vector 1 2 3 4))))
 242
 243   (pass-if "make-s32vector"
 244     (equal? (list->s32vector '(7 7 7 7))
 245             (make-s32vector 4 7))))
 246
 247 (with-test-prefix "u64 vectors"
 248
 249   (pass-if "u64vector? success"
 250     (u64vector? (u64vector)))
 251
 252   (pass-if "u64vector? failure"
 253     (not (u64vector? (s64vector))))
 254
 255   (pass-if "u64vector-length success 1"
 256     (= (u64vector-length (u64vector)) 0))
 257
 258   (pass-if "u64vector-length success 2"
 259     (= (u64vector-length (u64vector 3)) 1))
 260
 261   (pass-if "u64vector-length failure"
 262     (not (= (u64vector-length (u64vector 3)) 3)))
 263
 264   (pass-if "u64vector-ref"
 265     (= (u64vector-ref (u64vector 1 2 3) 1) 2))
 266
 267   (pass-if "u64vector-set!/ref"
 268     (= (let ((s (make-u64vector 10 0)))
 269          (u64vector-set! s 4 33)
 270          (u64vector-ref s 4)) 33))
 271
 272   (pass-if "u64vector->list/list->u64vector"
 273     (equal? (u64vector->list (u64vector 1 2 3 4))
 274             (u64vector->list (list->u64vector '(1 2 3 4)))))
 275
 276   (pass-if "u64vector->list/array->list"
 277     (equal? (u64vector->list (u64vector 1 2 3 4))
 278             (array->list (u64vector 1 2 3 4))))
 279
 280   (pass-if "make-u64vector"
 281     (equal? (list->u64vector '(7 7 7 7))
 282             (make-u64vector 4 7))))
 283
 284 (with-test-prefix "s64 vectors"
 285
 286   (pass-if "s64vector? success"
 287     (s64vector? (s64vector)))
 288
 289   (pass-if "s64vector? failure"
 290     (not (s64vector? (u64vector))))
 291
 292   (pass-if "s64vector-length success 1"
 293     (= (s64vector-length (s64vector)) 0))
 294
 295   (pass-if "s64vector-length success 2"
 296     (= (s64vector-length (s64vector -3)) 1))
 297
 298   (pass-if "s64vector-length failure"
 299     (not (= (s64vector-length (s64vector 3)) 3)))
 300
 301   (pass-if "s64vector-ref"
 302     (= (s64vector-ref (s64vector 1 2 3) 1) 2))
 303
 304   (pass-if "s64vector-set!/ref"
 305     (= (let ((s (make-s64vector 10 0)))
 306          (s64vector-set! s 4 33)
 307          (s64vector-ref s 4)) 33))
 308
 309   (pass-if "s64vector->list/list->s64vector"
 310     (equal? (s64vector->list (s64vector 1 2 3 4))
 311             (s64vector->list (list->s64vector '(1 2 3 4)))))
 312
 313   (pass-if "s64vector->list/array->list"
 314     (equal? (s64vector->list (s64vector 1 2 3 4))
 315             (array->list (s64vector 1 2 3 4))))
 316
 317   (pass-if "make-s64vector"
 318     (equal? (list->s64vector '(7 7 7 7))
 319             (make-s64vector 4 7))))
 320
 321 (with-test-prefix "f32 vectors"
 322
 323   (pass-if "f32vector? success"
 324     (f32vector? (f32vector)))
 325
 326   (pass-if "f32vector? failure"
 327     (not (f32vector? (s8vector))))
 328
 329   (pass-if "f32vector-length success 1"
 330     (= (f32vector-length (f32vector)) 0))
 331
 332   (pass-if "f32vector-length success 2"
 333     (= (f32vector-length (f32vector -3)) 1))
 334
 335   (pass-if "f32vector-length failure"
 336     (not (= (f32vector-length (f32vector 3)) 3)))
 337
 338   (pass-if "f32vector-ref"
 339     (= (f32vector-ref (f32vector 1 2 3) 1) 2))
 340
 341   (pass-if "f32vector-set!/ref"
 342     (= (let ((s (make-f32vector 10 0)))
 343          (f32vector-set! s 4 33)
 344          (f32vector-ref s 4)) 33))
 345
 346   (pass-if "f32vector->list/list->f32vector"
 347     (equal? (f32vector->list (f32vector 1 2 3 4))
 348             (f32vector->list (list->f32vector '(1 2 3 4)))))
 349
 350   (pass-if "f32vector->list/array->list"
 351     (equal? (f32vector->list (f32vector 1 2 3 4))
 352             (array->list (f32vector 1 2 3 4))))
 353
 354   (pass-if "make-f32vector"
 355     (equal? (list->f32vector '(7 7 7 7))
 356             (make-f32vector 4 7)))
 357
 358   (pass-if "+inf.0, -inf.0, +nan.0 in f32vector"
 359     (f32vector? #f32(+inf.0 -inf.0 +nan.0))))
 360
 361 (with-test-prefix "f64 vectors"
 362
 363   (pass-if "f64vector? success"
 364     (f64vector? (f64vector)))
 365
 366   (pass-if "f64vector? failure"
 367     (not (f64vector? (f32vector))))
 368
 369   (pass-if "f64vector-length success 1"
 370     (= (f64vector-length (f64vector)) 0))
 371
 372   (pass-if "f64vector-length success 2"
 373     (= (f64vector-length (f64vector -3)) 1))
 374
 375   (pass-if "f64vector-length failure"
 376     (not (= (f64vector-length (f64vector 3)) 3)))
 377
 378   (pass-if "f64vector-ref"
 379     (= (f64vector-ref (f64vector 1 2 3) 1) 2))
 380
 381   (pass-if "f64vector-set!/ref"
 382     (= (let ((s (make-f64vector 10 0)))
 383          (f64vector-set! s 4 33)
 384          (f64vector-ref s 4)) 33))
 385
 386   (pass-if "f64vector->list/list->f64vector"
 387     (equal? (f64vector->list (f64vector 1 2 3 4))
 388             (f64vector->list (list->f64vector '(1 2 3 4)))))
 389
 390   (pass-if "f64vector->list/array->list"
 391     (equal? (f64vector->list (f64vector 1 2 3 4))
 392             (array->list (f64vector 1 2 3 4))))
 393
 394   (pass-if "make-f64vector"
 395     (equal? (list->f64vector '(7 7 7 7))
 396             (make-f64vector 4 7)))
 397
 398   (pass-if "+inf.0, -inf.0, +nan.0 in f64vector"
 399     (f64vector? #f64(+inf.0 -inf.0 +nan.0))))
 400
 401 (with-test-prefix "c32 vectors"
 402
 403   (pass-if "c32vector? success"
 404     (c32vector? (c32vector)))
 405
 406   (pass-if "c32vector? failure"
 407     (not (c32vector? (s8vector))))
 408
 409   (pass-if "c32vector-length success 1"
 410     (= (c32vector-length (c32vector)) 0))
 411
 412   (pass-if "c32vector-length success 2"
 413     (= (c32vector-length (c32vector -3-2i)) 1))
 414
 415   (pass-if "c32vector-length failure"
 416     (not (= (c32vector-length (c32vector 3)) 3)))
 417
 418   (pass-if "c32vector-ref"
 419     (= (c32vector-ref (c32vector 1 2+13i 3) 1) 2+13i))
 420
 421   (pass-if "c32vector-set!/ref"
 422     (= (let ((s (make-c32vector 10 0)))
 423          (c32vector-set! s 4 33-1i)
 424          (c32vector-ref s 4)) 33-1i))
 425
 426   (pass-if "c32vector->list/list->c32vector"
 427     (equal? (c32vector->list (c32vector 1 2 3 4))
 428             (c32vector->list (list->c32vector '(1 2 3 4)))))
 429
 430   (pass-if "c32vector->list/array->list"
 431     (equal? (c32vector->list (c32vector 1 2 3 4))
 432             (array->list (c32vector 1 2 3 4))))
 433
 434   (pass-if "make-c32vector"
 435     (equal? (list->c32vector '(7 7 7 7))
 436             (make-c32vector 4 7)))
 437
 438   (pass-if "+inf.0, -inf.0, +nan.0 in c32vector"
 439     (c32vector? #c32(+inf.0 -inf.0 +nan.0)))
 440
 441   (pass-if "array-ref"
 442     (let ((v (c32vector 1+1i)))
 443       (= (c32vector-ref v 0)
 444          (array-ref v 0))))
 445
 446   (pass-if "array-set!"
 447     (let ((x 1+1i)
 448           (v (c32vector 0)))
 449       (array-set! v x 0)
 450       (= x (array-ref v 0))))
 451
 452   (pass-if-exception "array-ref, out-of-range"
 453     exception:out-of-range
 454     (array-ref (c32vector 1.0) 1))
 455
 456   (pass-if-exception "array-set!, out-of-range"
 457     exception:out-of-range
 458     (array-set! (c32vector 1.0) 2.0 1)))
 459
 460 (with-test-prefix "c64 vectors"
 461
 462   (pass-if "c64vector? success"
 463     (c64vector? (c64vector)))
 464
 465   (pass-if "c64vector? failure"
 466     (not (c64vector? (s8vector))))
 467
 468   (pass-if "c64vector-length success 1"
 469     (= (c64vector-length (c64vector)) 0))
 470
 471   (pass-if "c64vector-length success 2"
 472     (= (c64vector-length (c64vector -3-2i)) 1))
 473
 474   (pass-if "c64vector-length failure"
 475     (not (= (c64vector-length (c64vector 3)) 3)))
 476
 477   (pass-if "c64vector-ref"
 478     (= (c64vector-ref (c64vector 1+2i 2+3i 3) 1) 2+3i))
 479
 480   (pass-if "c64vector-set!/ref"
 481     (= (let ((s (make-c64vector 10 0)))
 482          (c64vector-set! s 4 33+1i)
 483          (c64vector-ref s 4)) 33+1i))
 484
 485   (pass-if "c64vector->list/list->c64vector"
 486     (equal? (c64vector->list (c64vector 1 2 3 4))
 487             (c64vector->list (list->c64vector '(1 2 3 4)))))
 488
 489   (pass-if "c64vector->list/array->list"
 490     (equal? (c64vector->list (c64vector 1 2 3 4))
 491             (array->list (c64vector 1 2 3 4))))
 492
 493   (pass-if "make-c64vector"
 494     (equal? (list->c64vector '(7 7 7 7))
 495             (make-c64vector 4 7)))
 496
 497   (pass-if "+inf.0, -inf.0, +nan.0 in c64vector"
 498     (c64vector? #c64(+inf.0 -inf.0 +nan.0)))
 499
 500   (pass-if "array-ref"
 501     (let ((v (c64vector 1+1i)))
 502       (= (c64vector-ref v 0)
 503          (array-ref v 0))))
 504
 505   (pass-if "array-set!"
 506     (let ((x 1+1i)
 507           (v (c64vector 0)))
 508       (array-set! v x 0)
 509       (= x (array-ref v 0))))
 510
 511   (pass-if-exception "array-ref, out-of-range"
 512     exception:out-of-range
 513     (array-ref (c64vector 1.0) 1))
 514
 515   (pass-if-exception "array-set!, out-of-range"
 516     exception:out-of-range
 517     (array-set! (c64vector 1.0) 2.0 1)))
 518
 519 (with-test-prefix "accessing uniform vectors of different types"
 520
 521   (pass-if "u32vector-length of u16vector"
 522     (= 2 (u32vector-length (make-u16vector 4))))
 523
 524   (pass-if "u32vector-length of u8vector"
 525     (= 2 (u32vector-length (make-u8vector 8))))
 526
 527   (pass-if "u8vector-length of u16vector"
 528     (= 4 (u8vector-length (make-u16vector 2))))
 529
 530   (pass-if "u8vector-length of u32vector"
 531     (= 8 (u8vector-length (make-u32vector 2))))
 532
 533   (pass-if "u32vector-set! of u16vector"
 534     (let ((v (make-u16vector 4 #xFFFF)))
 535       (u32vector-set! v 1 0)
 536       (equal? v #u16(#xFFFF #xFFFF 0 0))))
 537
 538   (pass-if "u16vector-set! of u32vector"
 539     (let ((v (make-u32vector 2 #xFFFFFFFF)))
 540       (u16vector-set! v 2 0)
 541       (u16vector-set! v 3 0)
 542       (equal? v #u32(#xFFFFFFFF 0)))))