guile18/test-suite/tests/unif.test

   1 ;;;; unif.test --- tests guile's uniform arrays     -*- scheme -*-
   2 ;;;;
   3 ;;;; Copyright 2004, 2006 Free Software Foundation, Inc.
   4 ;;;;
   5 ;;;; This library is free software; you can redistribute it and/or
   6 ;;;; modify it under the terms of the GNU Lesser General Public
   7 ;;;; License as published by the Free Software Foundation; either
   8 ;;;; version 2.1 of the License, or (at your option) any later version.
   9 ;;;;
  10 ;;;; This library is distributed in the hope that it will be useful,
  11 ;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 ;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13 ;;;; Lesser General Public License for more details.
  14 ;;;;
  15 ;;;; You should have received a copy of the GNU Lesser General Public
  16 ;;;; License along with this library; if not, write to the Free Software
  17 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
  18
  19 (define-module (test-suite test-unif)
  20   #:use-module (test-suite lib))
  21
  22 ;;;
  23 ;;; array?
  24 ;;;
  25
  26 (define exception:wrong-num-indices
  27   (cons 'misc-error "^wrong number of indices.*"))
  28
  29 (define exception:length-non-negative
  30   (cons 'read-error ".*array length must be non-negative.*"))
  31
  32
  33 (with-test-prefix "array?"
  34
  35   (let ((bool     (make-typed-array 'b    #t  '(5 6)))
  36         (char     (make-typed-array 'a    #\a '(5 6)))
  37         (byte     (make-typed-array 'u8   0   '(5 6)))
  38         (short    (make-typed-array 's16  0   '(5 6)))
  39         (ulong    (make-typed-array 'u32  0   '(5 6)))
  40         (long     (make-typed-array 's32  0   '(5 6)))
  41         (longlong (make-typed-array 's64  0   '(5 6)))
  42         (float    (make-typed-array 'f32  0   '(5 6)))
  43         (double   (make-typed-array 'f64  0   '(5 6)))
  44         (complex  (make-typed-array 'c64  0   '(5 6)))
  45         (scm      (make-typed-array #t    0   '(5 6))))
  46
  47     (with-test-prefix "is bool"
  48       (pass-if (eq? #t (typed-array? bool     'b)))
  49       (pass-if (eq? #f (typed-array? char     'b)))
  50       (pass-if (eq? #f (typed-array? byte     'b)))
  51       (pass-if (eq? #f (typed-array? short    'b)))
  52       (pass-if (eq? #f (typed-array? ulong    'b)))
  53       (pass-if (eq? #f (typed-array? long     'b)))
  54       (pass-if (eq? #f (typed-array? longlong 'b)))
  55       (pass-if (eq? #f (typed-array? float    'b)))
  56       (pass-if (eq? #f (typed-array? double   'b)))
  57       (pass-if (eq? #f (typed-array? complex  'b)))
  58       (pass-if (eq? #f (typed-array? scm      'b))))
  59
  60     (with-test-prefix "is char"
  61       (pass-if (eq? #f (typed-array? bool     'a)))
  62       (pass-if (eq? #t (typed-array? char     'a)))
  63       (pass-if (eq? #f (typed-array? byte     'a)))
  64       (pass-if (eq? #f (typed-array? short    'a)))
  65       (pass-if (eq? #f (typed-array? ulong    'a)))
  66       (pass-if (eq? #f (typed-array? long     'a)))
  67       (pass-if (eq? #f (typed-array? longlong 'a)))
  68       (pass-if (eq? #f (typed-array? float    'a)))
  69       (pass-if (eq? #f (typed-array? double   'a)))
  70       (pass-if (eq? #f (typed-array? complex  'a)))
  71       (pass-if (eq? #f (typed-array? scm      'a))))
  72
  73     (with-test-prefix "is byte"
  74       (pass-if (eq? #f (typed-array? bool     'u8)))
  75       (pass-if (eq? #f (typed-array? char     'u8)))
  76       (pass-if (eq? #t (typed-array? byte     'u8)))
  77       (pass-if (eq? #f (typed-array? short    'u8)))
  78       (pass-if (eq? #f (typed-array? ulong    'u8)))
  79       (pass-if (eq? #f (typed-array? long     'u8)))
  80       (pass-if (eq? #f (typed-array? longlong 'u8)))
  81       (pass-if (eq? #f (typed-array? float    'u8)))
  82       (pass-if (eq? #f (typed-array? double   'u8)))
  83       (pass-if (eq? #f (typed-array? complex  'u8)))
  84       (pass-if (eq? #f (typed-array? scm      'u8))))
  85
  86     (with-test-prefix "is short"
  87       (pass-if (eq? #f (typed-array? bool     's16)))
  88       (pass-if (eq? #f (typed-array? char     's16)))
  89       (pass-if (eq? #f (typed-array? byte     's16)))
  90       (pass-if (eq? #t (typed-array? short    's16)))
  91       (pass-if (eq? #f (typed-array? ulong    's16)))
  92       (pass-if (eq? #f (typed-array? long     's16)))
  93       (pass-if (eq? #f (typed-array? longlong 's16)))
  94       (pass-if (eq? #f (typed-array? float    's16)))
  95       (pass-if (eq? #f (typed-array? double   's16)))
  96       (pass-if (eq? #f (typed-array? complex  's16)))
  97       (pass-if (eq? #f (typed-array? scm      's16))))
  98
  99     (with-test-prefix "is ulong"
 100       (pass-if (eq? #f (typed-array? bool     'u32)))
 101       (pass-if (eq? #f (typed-array? char     'u32)))
 102       (pass-if (eq? #f (typed-array? byte     'u32)))
 103       (pass-if (eq? #f (typed-array? short    'u32)))
 104       (pass-if (eq? #t (typed-array? ulong    'u32)))
 105       (pass-if (eq? #f (typed-array? long     'u32)))
 106       (pass-if (eq? #f (typed-array? longlong 'u32)))
 107       (pass-if (eq? #f (typed-array? float    'u32)))
 108       (pass-if (eq? #f (typed-array? double   'u32)))
 109       (pass-if (eq? #f (typed-array? complex  'u32)))
 110       (pass-if (eq? #f (typed-array? scm      'u32))))
 111
 112     (with-test-prefix "is long"
 113       (pass-if (eq? #f (typed-array? bool     's32)))
 114       (pass-if (eq? #f (typed-array? char     's32)))
 115       (pass-if (eq? #f (typed-array? byte     's32)))
 116       (pass-if (eq? #f (typed-array? short    's32)))
 117       (pass-if (eq? #f (typed-array? ulong    's32)))
 118       (pass-if (eq? #t (typed-array? long     's32)))
 119       (pass-if (eq? #f (typed-array? longlong 's32)))
 120       (pass-if (eq? #f (typed-array? float    's32)))
 121       (pass-if (eq? #f (typed-array? double   's32)))
 122       (pass-if (eq? #f (typed-array? complex  's32)))
 123       (pass-if (eq? #f (typed-array? scm      's32))))
 124
 125     (with-test-prefix "is long long"
 126       (pass-if (eq? #f (typed-array? bool     's64)))
 127       (pass-if (eq? #f (typed-array? char     's64)))
 128       (pass-if (eq? #f (typed-array? byte     's64)))
 129       (pass-if (eq? #f (typed-array? short    's64)))
 130       (pass-if (eq? #f (typed-array? ulong    's64)))
 131       (pass-if (eq? #f (typed-array? long     's64)))
 132       (pass-if (eq? #t (typed-array? longlong 's64)))
 133       (pass-if (eq? #f (typed-array? float    's64)))
 134       (pass-if (eq? #f (typed-array? double   's64)))
 135       (pass-if (eq? #f (typed-array? complex  's64)))
 136       (pass-if (eq? #f (typed-array? scm      's64))))
 137
 138     (with-test-prefix "is float"
 139       (pass-if (eq? #f (typed-array? bool     'f32)))
 140       (pass-if (eq? #f (typed-array? char     'f32)))
 141       (pass-if (eq? #f (typed-array? byte     'f32)))
 142       (pass-if (eq? #f (typed-array? short    'f32)))
 143       (pass-if (eq? #f (typed-array? ulong    'f32)))
 144       (pass-if (eq? #f (typed-array? long     'f32)))
 145       (pass-if (eq? #f (typed-array? longlong 'f32)))
 146       (pass-if (eq? #t (typed-array? float    'f32)))
 147       (pass-if (eq? #f (typed-array? double   'f32)))
 148       (pass-if (eq? #f (typed-array? complex  'f32)))
 149       (pass-if (eq? #f (typed-array? scm      'f32))))
 150
 151     (with-test-prefix "is double"
 152       (pass-if (eq? #f (typed-array? bool     'f64)))
 153       (pass-if (eq? #f (typed-array? char     'f64)))
 154       (pass-if (eq? #f (typed-array? byte     'f64)))
 155       (pass-if (eq? #f (typed-array? short    'f64)))
 156       (pass-if (eq? #f (typed-array? ulong    'f64)))
 157       (pass-if (eq? #f (typed-array? long     'f64)))
 158       (pass-if (eq? #f (typed-array? longlong 'f64)))
 159       (pass-if (eq? #f (typed-array? float    'f64)))
 160       (pass-if (eq? #t (typed-array? double   'f64)))
 161       (pass-if (eq? #f (typed-array? complex  'f64)))
 162       (pass-if (eq? #f (typed-array? scm      'f64))))
 163
 164     (with-test-prefix "is complex"
 165       (pass-if (eq? #f (typed-array? bool     'c64)))
 166       (pass-if (eq? #f (typed-array? char     'c64)))
 167       (pass-if (eq? #f (typed-array? byte     'c64)))
 168       (pass-if (eq? #f (typed-array? short    'c64)))
 169       (pass-if (eq? #f (typed-array? ulong    'c64)))
 170       (pass-if (eq? #f (typed-array? long     'c64)))
 171       (pass-if (eq? #f (typed-array? longlong 'c64)))
 172       (pass-if (eq? #f (typed-array? float    'c64)))
 173       (pass-if (eq? #f (typed-array? double   'c64)))
 174       (pass-if (eq? #t (typed-array? complex  'c64)))
 175       (pass-if (eq? #f (typed-array? scm      'c64))))
 176
 177     (with-test-prefix "is scm"
 178       (pass-if (eq? #f (typed-array? bool     #t)))
 179       (pass-if (eq? #f (typed-array? char     #t)))
 180       (pass-if (eq? #f (typed-array? byte     #t)))
 181       (pass-if (eq? #f (typed-array? short    #t)))
 182       (pass-if (eq? #f (typed-array? ulong    #t)))
 183       (pass-if (eq? #f (typed-array? long     #t)))
 184       (pass-if (eq? #f (typed-array? longlong #t)))
 185       (pass-if (eq? #f (typed-array? float    #t)))
 186       (pass-if (eq? #f (typed-array? double   #t)))
 187       (pass-if (eq? #f (typed-array? complex  #t)))
 188       (pass-if (eq? #t (typed-array? scm      #t))))))
 189
 190 ;;;
 191 ;;; array-equal?
 192 ;;;
 193
 194 (with-test-prefix "array-equal?"
 195
 196   (pass-if "#s16(...)"
 197     (array-equal? #s16(1 2 3) #s16(1 2 3))))
 198
 199 ;;;
 200 ;;; array-fill!
 201 ;;;
 202
 203 (with-test-prefix "array-fill!"
 204
 205   (with-test-prefix "bool"
 206     (let ((a (make-bitvector 1 #t)))
 207       (pass-if "#f" (array-fill! a #f) #t)
 208       (pass-if "#t" (array-fill! a #t) #t)))
 209
 210   (with-test-prefix "char"
 211     (let ((a (make-string 1 #\a)))
 212       (pass-if "x" (array-fill! a #\x) #t)))
 213
 214   (with-test-prefix "byte"
 215     (let ((a (make-s8vector 1 0)))
 216       (pass-if "0"    (array-fill! a 0)    #t)
 217       (pass-if "127" (array-fill! a 127)   #t)
 218       (pass-if "-128" (array-fill! a -128) #t)
 219       (pass-if-exception "128" exception:out-of-range
 220         (array-fill! a 128))
 221       (pass-if-exception "-129" exception:out-of-range
 222         (array-fill! a -129))
 223       (pass-if-exception "symbol" exception:wrong-type-arg
 224         (array-fill! a 'symbol))))
 225
 226   (with-test-prefix "short"
 227     (let ((a (make-s16vector 1 0)))
 228       (pass-if "0"    (array-fill! a 0)    #t)
 229       (pass-if "123"  (array-fill! a 123)  #t)
 230       (pass-if "-123" (array-fill! a -123) #t)))
 231
 232   (with-test-prefix "ulong"
 233     (let ((a (make-u32vector 1 1)))
 234       (pass-if "0"    (array-fill! a 0)   #t)
 235       (pass-if "123"  (array-fill! a 123) #t)
 236       (pass-if-exception "-123" exception:out-of-range
 237         (array-fill! a -123) #t)))
 238
 239   (with-test-prefix "long"
 240     (let ((a (make-s32vector 1 -1)))
 241       (pass-if "0"    (array-fill! a 0)    #t)
 242       (pass-if "123"  (array-fill! a 123)  #t)
 243       (pass-if "-123" (array-fill! a -123) #t)))
 244
 245   (with-test-prefix "float"
 246     (let ((a (make-f32vector 1 1.0)))
 247       (pass-if "0.0"    (array-fill! a 0)      #t)
 248       (pass-if "123.0"  (array-fill! a 123.0)  #t)
 249       (pass-if "-123.0" (array-fill! a -123.0) #t)
 250       (pass-if "0"      (array-fill! a 0)      #t)
 251       (pass-if "123"    (array-fill! a 123)    #t)
 252       (pass-if "-123"   (array-fill! a -123)   #t)
 253       (pass-if "5/8"    (array-fill! a 5/8)    #t)))
 254
 255   (with-test-prefix "double"
 256     (let ((a (make-f64vector 1 1/3)))
 257       (pass-if "0.0"    (array-fill! a 0)      #t)
 258       (pass-if "123.0"  (array-fill! a 123.0)  #t)
 259       (pass-if "-123.0" (array-fill! a -123.0) #t)
 260       (pass-if "0"      (array-fill! a 0)      #t)
 261       (pass-if "123"    (array-fill! a 123)    #t)
 262       (pass-if "-123"   (array-fill! a -123)   #t)
 263       (pass-if "5/8"    (array-fill! a 5/8)    #t))))
 264
 265 ;;;
 266 ;;; array-in-bounds?
 267 ;;;
 268
 269 (with-test-prefix "array-in-bounds?"
 270
 271   (pass-if (let ((a (make-array #f '(425 425))))
 272              (eq? #f (array-in-bounds? a 0)))))
 273
 274 ;;;
 275 ;;; array-prototype
 276 ;;;
 277
 278 (with-test-prefix "array-type"
 279
 280   (with-test-prefix "on make-foo-vector"
 281
 282     (pass-if "bool"
 283       (eq? 'b (array-type (make-bitvector 1))))
 284
 285     (pass-if "char"
 286       (eq? 'a (array-type (make-string 1))))
 287
 288     (pass-if "byte"
 289       (eq? 'u8 (array-type (make-u8vector 1))))
 290
 291     (pass-if "short"
 292       (eq? 's16 (array-type (make-s16vector 1))))
 293
 294     (pass-if "ulong"
 295       (eq? 'u32 (array-type (make-u32vector 1))))
 296
 297     (pass-if "long"
 298       (eq? 's32 (array-type (make-s32vector 1))))
 299
 300     (pass-if "long long"
 301       (eq? 's64 (array-type (make-s64vector 1))))
 302
 303     (pass-if "float"
 304       (eq? 'f32 (array-type (make-f32vector 1))))
 305
 306     (pass-if "double"
 307       (eq? 'f64 (array-type (make-f64vector 1))))
 308
 309     (pass-if "complex"
 310       (eq? 'c64 (array-type (make-c64vector 1))))
 311
 312     (pass-if "scm"
 313       (eq? #t (array-type (make-vector 1)))))
 314
 315   (with-test-prefix "on make-typed-array"
 316
 317     (let ((types '(b a u8 s8 u16 s16 u32 s32 u64 u64 f32 f64 c32 c64)))
 318       (for-each (lambda (type)
 319                   (pass-if (symbol->string type)
 320                      (eq? type
 321                           (array-type (make-typed-array type
 322                                                         *unspecified*
 323                                                         '(5 6))))))
 324                 types))))
 325
 326 ;;;
 327 ;;; array-set!
 328 ;;;
 329
 330 (with-test-prefix "array-set!"
 331
 332   (with-test-prefix "bitvector"
 333
 334     ;; in Guile 1.8.0 a bug in bitvector_set() caused a segv in array-set!
 335     ;; on a bitvector like the following
 336     (let ((a (make-bitvector 1)))
 337       (pass-if "one elem set #t"
 338         (begin
 339           (array-set! a #t 0)
 340           (eq? #t (array-ref a 0))))
 341       (pass-if "one elem set #f"
 342         (begin
 343           (array-set! a #f 0)
 344           (eq? #f (array-ref a 0))))))
 345
 346   (with-test-prefix "byte"
 347
 348     (let ((a (make-s8vector 1)))
 349
 350       (pass-if "-128"
 351         (begin (array-set! a -128 0) #t))
 352       (pass-if "0"
 353         (begin (array-set! a 0 0) #t))
 354       (pass-if "127"
 355         (begin (array-set! a 127 0) #t))
 356       (pass-if-exception "-129" exception:out-of-range
 357         (begin (array-set! a -129 0) #t))
 358       (pass-if-exception "128" exception:out-of-range
 359         (begin (array-set! a 128 0) #t))))
 360
 361   (with-test-prefix "short"
 362
 363     (let ((a (make-s16vector 1)))
 364       ;; true if n can be array-set! into a
 365       (define (fits? n)
 366         (false-if-exception (begin (array-set! a n 0) #t)))
 367
 368       (with-test-prefix "store/fetch"
 369         ;; Check array-ref gives back what was put with array-set!.
 370         ;; In Guile 1.6.4 and earlier, array-set! only demanded an inum and
 371         ;; would silently truncate to a short.
 372
 373         (do ((n 1 (1+ (* 2 n))))  ;; n=2^k-1
 374             ((not (fits? n)))
 375           (array-set! a n 0)
 376           (pass-if n
 377             (= n (array-ref a 0))))
 378
 379         (do ((n -1 (* 2 n)))      ;; -n=2^k
 380             ((not (fits? n)))
 381           (array-set! a n 0)
 382           (pass-if n
 383             (= n (array-ref a 0))))))))
 384
 385 ;;;
 386 ;;; array-set!
 387 ;;;
 388
 389 (with-test-prefix "array-set!"
 390
 391   (with-test-prefix "one dim"
 392     (let ((a (make-array #f '(3 5))))
 393       (pass-if "start"
 394         (array-set! a 'y 3)
 395         #t)
 396       (pass-if "end"
 397         (array-set! a 'y 5)
 398         #t)
 399       (pass-if-exception "start-1" exception:out-of-range
 400         (array-set! a 'y 2))
 401       (pass-if-exception "end+1" exception:out-of-range
 402         (array-set! a 'y 6))
 403       (pass-if-exception "two indexes" exception:out-of-range
 404         (array-set! a 'y 6 7))))
 405
 406   (with-test-prefix "two dim"
 407     (let ((a (make-array #f '(3 5) '(7 9))))
 408       (pass-if "start"
 409         (array-set! a 'y 3 7)
 410         #t)
 411       (pass-if "end"
 412         (array-set! a 'y 5 9)
 413         #t)
 414       (pass-if-exception "start i-1" exception:out-of-range
 415         (array-set! a 'y 2 7))
 416       (pass-if-exception "end i+1" exception:out-of-range
 417         (array-set! a 'y 6 9))
 418       (pass-if-exception "one index" exception:wrong-num-indices
 419         (array-set! a 'y 4))
 420       (pass-if-exception "three indexes" exception:wrong-num-indices
 421         (array-set! a 'y 4 8 0)))))
 422
 423 ;;;
 424 ;;; make-shared-array
 425 ;;;
 426
 427 (define exception:mapping-out-of-range
 428   (cons 'misc-error "^mapping out of range"))  ;; per scm_make_shared_array
 429
 430 (with-test-prefix "make-shared-array"
 431
 432   ;; this failed in guile 1.8.0
 433   (pass-if "vector unchanged"
 434     (let* ((a (make-array #f '(0 7)))
 435            (s (make-shared-array a list '(0 7))))
 436       (array-equal? a s)))
 437
 438   (pass-if-exception "vector, high too big" exception:mapping-out-of-range
 439     (let* ((a (make-array #f '(0 7))))
 440       (make-shared-array a list '(0 8))))
 441
 442   (pass-if-exception "vector, low too big" exception:out-of-range
 443     (let* ((a (make-array #f '(0 7))))
 444       (make-shared-array a list '(-1 7))))
 445
 446   (pass-if "truncate columns"
 447     (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) list 3 2)
 448                   #2((a b) (d e) (g h))))
 449
 450   (pass-if "pick one column"
 451     (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
 452                                      (lambda (i) (list i 2))
 453                                      '(0 2))
 454                   #(c f i)))
 455
 456   (pass-if "diagonal"
 457     (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
 458                                      (lambda (i) (list i i))
 459                                      '(0 2))
 460                   #(a e i)))
 461
 462   ;; this failed in guile 1.8.0
 463   (pass-if "2 dims from 1 dim"
 464     (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
 465                                      (lambda (i j) (list (+ (* i 3) j)))
 466                                      4 3)
 467                   #2((a b c) (d e f) (g h i) (j k l))))
 468
 469   (pass-if "reverse columns"
 470     (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
 471                                      (lambda (i j) (list i (- 2 j)))
 472                                      3 3)
 473                   #2((c b a) (f e d) (i h g))))
 474
 475   (pass-if "fixed offset, 0 based becomes 1 based"
 476     (let* ((x #2((a b c) (d e f) (g h i)))
 477            (y (make-shared-array x
 478                                  (lambda (i j) (list (1- i) (1- j)))
 479                                  '(1 3) '(1 3))))
 480       (and (eq? (array-ref x 0 0) 'a)
 481            (eq? (array-ref y 1 1) 'a))))
 482
 483   ;; this failed in guile 1.8.0
 484   (pass-if "stride every third element"
 485     (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
 486                                      (lambda (i) (list (* i 3)))
 487                                      4)
 488                   #1(a d g j)))
 489
 490   (pass-if "shared of shared"
 491     (let* ((a  #2((1 2 3) (4 5 6) (7 8 9)))
 492            (s1 (make-shared-array a (lambda (i) (list i 1)) 3))
 493            (s2 (make-shared-array s1 list '(1 2))))
 494       (and (eqv? 5 (array-ref s2 1))
 495            (eqv? 8 (array-ref s2 2))))))
 496
 497 ;;;
 498 ;;; uniform-vector-ref
 499 ;;;
 500
 501 (with-test-prefix "uniform-vector-ref"
 502
 503   (with-test-prefix "byte"
 504
 505     (let ((a (make-s8vector 1)))
 506
 507       (pass-if "0"
 508         (begin
 509           (array-set! a 0 0)
 510           (= 0 (uniform-vector-ref a 0))))
 511       (pass-if "127"
 512         (begin
 513           (array-set! a 127 0)
 514           (= 127 (uniform-vector-ref a 0))))
 515       (pass-if "-128"
 516         (begin
 517           (array-set! a -128 0)
 518           (= -128 (uniform-vector-ref a 0)))))))
 519
 520 ;;;
 521 ;;; syntax
 522 ;;;
 523
 524 (with-test-prefix "syntax"
 525
 526   (pass-if "rank and lower bounds"
 527     ;; uniform u32 array of rank 2 with index ranges 2..3 and 7..8.
 528     (let ((a '#2u32@2@7((1 2) (3 4))))
 529       (and (array? a)
 530            (typed-array? a 'u32)
 531            (= (array-rank a) 2)
 532            (let loop ((bounds '((2 7) (2 8) (3 7) (3 8)))
 533                       (result #t))
 534              (if (null? bounds)
 535                  result
 536                  (and result
 537                       (loop (cdr bounds)
 538                             (apply array-in-bounds? a (car bounds)))))))))
 539
 540   (pass-if "negative lower bound"
 541      (let ((a '#1@-3(a b)))
 542        (and (array? a)
 543             (= (array-rank a) 1)
 544             (array-in-bounds? a -3) (array-in-bounds? a -2)
 545             (eq? 'a (array-ref a -3))
 546             (eq? 'b (array-ref a -2)))))
 547
 548   (pass-if-exception "negative length" exception:length-non-negative
 549      (with-input-from-string "'#1:-3(#t #t)" read)))
 550
 551
 552 ;;;
 553 ;;; equal? with vector and one-dimensional array
 554 ;;;
 555
 556 (pass-if "vector equal? one-dimensional array"
 557   (equal? (make-shared-array #2((a b c) (d e f) (g h i))
 558                              (lambda (i) (list i i))
 559                              '(0 2))
 560           #(a e i)))