1 ;;;; unif.test --- tests guile's uniform arrays -*- scheme -*-
3 ;;;; Copyright 2004, 2006, 2009, 2010, 2011, 2012, 2013 Free Software Foundation, Inc.
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 3 of the License, or (at your option) any later version.
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.
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
19 (define-module (test-suite test-arrays)
20 #:use-module ((system base compile) #:select (compile))
21 #:use-module (test-suite lib)
22 #:use-module (srfi srfi-4)
23 #:use-module (srfi srfi-4 gnu))
29 (define exception:wrong-num-indices
30 (cons 'misc-error "^wrong number of indices.*"))
32 (define exception:length-non-negative
33 (cons 'read-error ".*array length must be non-negative.*"))
36 (with-test-prefix "sanity"
37 ;; At the current time of writing, bignums have a tc7 that is one bit
38 ;; away from strings. It used to be that the vector implementation
39 ;; registered for strings had the TYP7S mask, not the TYP7 mask,
40 ;; making the system think that bignums were vectors. Doh!
41 (pass-if (not (uniform-vector? 12345678901234567890123456789))))
43 (with-test-prefix "array?"
45 (let ((bool (make-typed-array 'b #t '(5 6)))
46 (char (make-typed-array 'a #\a '(5 6)))
47 (byte (make-typed-array 'u8 0 '(5 6)))
48 (short (make-typed-array 's16 0 '(5 6)))
49 (ulong (make-typed-array 'u32 0 '(5 6)))
50 (long (make-typed-array 's32 0 '(5 6)))
51 (longlong (make-typed-array 's64 0 '(5 6)))
52 (float (make-typed-array 'f32 0 '(5 6)))
53 (double (make-typed-array 'f64 0 '(5 6)))
54 (complex (make-typed-array 'c64 0 '(5 6)))
55 (scm (make-typed-array #t 0 '(5 6))))
57 (with-test-prefix "is bool"
58 (pass-if (eq? #t (typed-array? bool 'b)))
59 (pass-if (eq? #f (typed-array? char 'b)))
60 (pass-if (eq? #f (typed-array? byte 'b)))
61 (pass-if (eq? #f (typed-array? short 'b)))
62 (pass-if (eq? #f (typed-array? ulong 'b)))
63 (pass-if (eq? #f (typed-array? long 'b)))
64 (pass-if (eq? #f (typed-array? longlong 'b)))
65 (pass-if (eq? #f (typed-array? float 'b)))
66 (pass-if (eq? #f (typed-array? double 'b)))
67 (pass-if (eq? #f (typed-array? complex 'b)))
68 (pass-if (eq? #f (typed-array? scm 'b))))
70 (with-test-prefix "is char"
71 (pass-if (eq? #f (typed-array? bool 'a)))
72 (pass-if (eq? #t (typed-array? char 'a)))
73 (pass-if (eq? #f (typed-array? byte 'a)))
74 (pass-if (eq? #f (typed-array? short 'a)))
75 (pass-if (eq? #f (typed-array? ulong 'a)))
76 (pass-if (eq? #f (typed-array? long 'a)))
77 (pass-if (eq? #f (typed-array? longlong 'a)))
78 (pass-if (eq? #f (typed-array? float 'a)))
79 (pass-if (eq? #f (typed-array? double 'a)))
80 (pass-if (eq? #f (typed-array? complex 'a)))
81 (pass-if (eq? #f (typed-array? scm 'a))))
83 (with-test-prefix "is byte"
84 (pass-if (eq? #f (typed-array? bool 'u8)))
85 (pass-if (eq? #f (typed-array? char 'u8)))
86 (pass-if (eq? #t (typed-array? byte 'u8)))
87 (pass-if (eq? #f (typed-array? short 'u8)))
88 (pass-if (eq? #f (typed-array? ulong 'u8)))
89 (pass-if (eq? #f (typed-array? long 'u8)))
90 (pass-if (eq? #f (typed-array? longlong 'u8)))
91 (pass-if (eq? #f (typed-array? float 'u8)))
92 (pass-if (eq? #f (typed-array? double 'u8)))
93 (pass-if (eq? #f (typed-array? complex 'u8)))
94 (pass-if (eq? #f (typed-array? scm 'u8))))
96 (with-test-prefix "is short"
97 (pass-if (eq? #f (typed-array? bool 's16)))
98 (pass-if (eq? #f (typed-array? char 's16)))
99 (pass-if (eq? #f (typed-array? byte 's16)))
100 (pass-if (eq? #t (typed-array? short 's16)))
101 (pass-if (eq? #f (typed-array? ulong 's16)))
102 (pass-if (eq? #f (typed-array? long 's16)))
103 (pass-if (eq? #f (typed-array? longlong 's16)))
104 (pass-if (eq? #f (typed-array? float 's16)))
105 (pass-if (eq? #f (typed-array? double 's16)))
106 (pass-if (eq? #f (typed-array? complex 's16)))
107 (pass-if (eq? #f (typed-array? scm 's16))))
109 (with-test-prefix "is ulong"
110 (pass-if (eq? #f (typed-array? bool 'u32)))
111 (pass-if (eq? #f (typed-array? char 'u32)))
112 (pass-if (eq? #f (typed-array? byte 'u32)))
113 (pass-if (eq? #f (typed-array? short 'u32)))
114 (pass-if (eq? #t (typed-array? ulong 'u32)))
115 (pass-if (eq? #f (typed-array? long 'u32)))
116 (pass-if (eq? #f (typed-array? longlong 'u32)))
117 (pass-if (eq? #f (typed-array? float 'u32)))
118 (pass-if (eq? #f (typed-array? double 'u32)))
119 (pass-if (eq? #f (typed-array? complex 'u32)))
120 (pass-if (eq? #f (typed-array? scm 'u32))))
122 (with-test-prefix "is long"
123 (pass-if (eq? #f (typed-array? bool 's32)))
124 (pass-if (eq? #f (typed-array? char 's32)))
125 (pass-if (eq? #f (typed-array? byte 's32)))
126 (pass-if (eq? #f (typed-array? short 's32)))
127 (pass-if (eq? #f (typed-array? ulong 's32)))
128 (pass-if (eq? #t (typed-array? long 's32)))
129 (pass-if (eq? #f (typed-array? longlong 's32)))
130 (pass-if (eq? #f (typed-array? float 's32)))
131 (pass-if (eq? #f (typed-array? double 's32)))
132 (pass-if (eq? #f (typed-array? complex 's32)))
133 (pass-if (eq? #f (typed-array? scm 's32))))
135 (with-test-prefix "is long long"
136 (pass-if (eq? #f (typed-array? bool 's64)))
137 (pass-if (eq? #f (typed-array? char 's64)))
138 (pass-if (eq? #f (typed-array? byte 's64)))
139 (pass-if (eq? #f (typed-array? short 's64)))
140 (pass-if (eq? #f (typed-array? ulong 's64)))
141 (pass-if (eq? #f (typed-array? long 's64)))
142 (pass-if (eq? #t (typed-array? longlong 's64)))
143 (pass-if (eq? #f (typed-array? float 's64)))
144 (pass-if (eq? #f (typed-array? double 's64)))
145 (pass-if (eq? #f (typed-array? complex 's64)))
146 (pass-if (eq? #f (typed-array? scm 's64))))
148 (with-test-prefix "is float"
149 (pass-if (eq? #f (typed-array? bool 'f32)))
150 (pass-if (eq? #f (typed-array? char 'f32)))
151 (pass-if (eq? #f (typed-array? byte 'f32)))
152 (pass-if (eq? #f (typed-array? short 'f32)))
153 (pass-if (eq? #f (typed-array? ulong 'f32)))
154 (pass-if (eq? #f (typed-array? long 'f32)))
155 (pass-if (eq? #f (typed-array? longlong 'f32)))
156 (pass-if (eq? #t (typed-array? float 'f32)))
157 (pass-if (eq? #f (typed-array? double 'f32)))
158 (pass-if (eq? #f (typed-array? complex 'f32)))
159 (pass-if (eq? #f (typed-array? scm 'f32))))
161 (with-test-prefix "is double"
162 (pass-if (eq? #f (typed-array? bool 'f64)))
163 (pass-if (eq? #f (typed-array? char 'f64)))
164 (pass-if (eq? #f (typed-array? byte 'f64)))
165 (pass-if (eq? #f (typed-array? short 'f64)))
166 (pass-if (eq? #f (typed-array? ulong 'f64)))
167 (pass-if (eq? #f (typed-array? long 'f64)))
168 (pass-if (eq? #f (typed-array? longlong 'f64)))
169 (pass-if (eq? #f (typed-array? float 'f64)))
170 (pass-if (eq? #t (typed-array? double 'f64)))
171 (pass-if (eq? #f (typed-array? complex 'f64)))
172 (pass-if (eq? #f (typed-array? scm 'f64))))
174 (with-test-prefix "is complex"
175 (pass-if (eq? #f (typed-array? bool 'c64)))
176 (pass-if (eq? #f (typed-array? char 'c64)))
177 (pass-if (eq? #f (typed-array? byte 'c64)))
178 (pass-if (eq? #f (typed-array? short 'c64)))
179 (pass-if (eq? #f (typed-array? ulong 'c64)))
180 (pass-if (eq? #f (typed-array? long 'c64)))
181 (pass-if (eq? #f (typed-array? longlong 'c64)))
182 (pass-if (eq? #f (typed-array? float 'c64)))
183 (pass-if (eq? #f (typed-array? double 'c64)))
184 (pass-if (eq? #t (typed-array? complex 'c64)))
185 (pass-if (eq? #f (typed-array? scm 'c64))))
187 (with-test-prefix "is scm"
188 (pass-if (eq? #f (typed-array? bool #t)))
189 (pass-if (eq? #f (typed-array? char #t)))
190 (pass-if (eq? #f (typed-array? byte #t)))
191 (pass-if (eq? #f (typed-array? short #t)))
192 (pass-if (eq? #f (typed-array? ulong #t)))
193 (pass-if (eq? #f (typed-array? long #t)))
194 (pass-if (eq? #f (typed-array? longlong #t)))
195 (pass-if (eq? #f (typed-array? float #t)))
196 (pass-if (eq? #f (typed-array? double #t)))
197 (pass-if (eq? #f (typed-array? complex #t)))
198 (pass-if (eq? #t (typed-array? scm #t))))))
204 (with-test-prefix "array-equal?"
207 (array-equal? #s16(1 2 3) #s16(1 2 3))))
210 ;;; make-shared-array
213 (define exception:mapping-out-of-range
214 (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
216 (with-test-prefix "make-shared-array"
218 ;; this failed in guile 1.8.0
219 (pass-if "vector unchanged"
220 (let* ((a (make-array #f '(0 7)))
221 (s (make-shared-array a list '(0 7))))
224 (pass-if-exception "vector, high too big" exception:mapping-out-of-range
225 (let* ((a (make-array #f '(0 7))))
226 (make-shared-array a list '(0 8))))
228 (pass-if-exception "vector, low too big" exception:out-of-range
229 (let* ((a (make-array #f '(0 7))))
230 (make-shared-array a list '(-1 7))))
232 (pass-if "truncate columns"
233 (array-equal? (make-shared-array #2((a b c) (d e f) (g h i)) list 3 2)
234 #2((a b) (d e) (g h))))
236 (pass-if "pick one column"
237 (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
238 (lambda (i) (list i 2))
243 (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
244 (lambda (i) (list i i))
248 ;; this failed in guile 1.8.0
249 (pass-if "2 dims from 1 dim"
250 (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
251 (lambda (i j) (list (+ (* i 3) j)))
253 #2((a b c) (d e f) (g h i) (j k l))))
255 (pass-if "reverse columns"
256 (array-equal? (make-shared-array #2((a b c) (d e f) (g h i))
257 (lambda (i j) (list i (- 2 j)))
259 #2((c b a) (f e d) (i h g))))
261 (pass-if "fixed offset, 0 based becomes 1 based"
262 (let* ((x #2((a b c) (d e f) (g h i)))
263 (y (make-shared-array x
264 (lambda (i j) (list (1- i) (1- j)))
266 (and (eq? (array-ref x 0 0) 'a)
267 (eq? (array-ref y 1 1) 'a))))
269 ;; this failed in guile 1.8.0
270 (pass-if "stride every third element"
271 (array-equal? (make-shared-array #1(a b c d e f g h i j k l)
272 (lambda (i) (list (* i 3)))
276 (pass-if "shared of shared"
277 (let* ((a #2((1 2 3) (4 5 6) (7 8 9)))
278 (s1 (make-shared-array a (lambda (i) (list i 1)) 3))
279 (s2 (make-shared-array s1 list '(1 2))))
280 (and (eqv? 5 (array-ref s2 1))
281 (eqv? 8 (array-ref s2 2))))))
284 ;;; shared-array-root
287 (with-test-prefix "shared-array-root"
289 (define amap1 (lambda (i) (list (* 2 i))))
290 (define amap2 (lambda (i j) (list (+ 1 (* 2 i)) (+ 1 (* 2 j)))))
292 (pass-if "plain vector"
293 (let* ((a (make-vector 4 0))
294 (b (make-shared-array a amap1 2)))
295 (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
297 (pass-if "plain array rank 2"
298 (let* ((a (make-array 0 4 4))
299 (b (make-shared-array a amap2 2 2)))
300 (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
302 (pass-if "uniform array rank 2"
303 (let* ((a (make-typed-array 'c64 0 4 4))
304 (b (make-shared-array a amap2 2 2)))
305 (eq? (shared-array-root a) (shared-array-root b) (array-contents a))))
307 (pass-if "bit array rank 2"
308 (let* ((a (make-typed-array 'b #f 4 4))
309 (b (make-shared-array a amap2 2 2)))
310 (eq? (shared-array-root a) (shared-array-root b) (array-contents a)))))
317 (define exception:wrong-type-arg
318 (cons #t "Wrong type"))
320 (with-test-prefix "transpose-array"
322 (pass-if-exception "non array argument" exception:wrong-type-arg
323 (transpose-array 99))
327 (b (transpose-array a)))
328 (and (array-equal? a b)
329 (eq? (shared-array-root a) (shared-array-root b)))))
333 (b (transpose-array a 0)))
334 (and (array-equal? a b)
335 (eq? (shared-array-root a) (shared-array-root b)))))
338 (let* ((a #2((1 2 3) (4 5 6)))
339 (b (transpose-array a 1 0))
340 (c (transpose-array a 0 1)))
341 (and (array-equal? b #2((1 4) (2 5) (3 6)))
343 (eq? (shared-array-root a)
344 (shared-array-root b)
345 (shared-array-root c)))))
347 ; rank > 2 is needed to check against the inverted axis index logic.
349 (let* ((a #3(((0 1 2 3) (4 5 6 7) (8 9 10 11))
350 ((12 13 14 15) (16 17 18 19) (20 21 22 23))))
351 (b (transpose-array a 1 2 0)))
352 (and (array-equal? b #3(((0 4 8) (12 16 20)) ((1 5 9) (13 17 21))
353 ((2 6 10) (14 18 22)) ((3 7 11) (15 19 23))))
354 (eq? (shared-array-root a)
355 (shared-array-root b))))))
361 (with-test-prefix "array->list"
362 (pass-if-equal '(1 2 3) (array->list #s16(1 2 3)))
363 (pass-if-equal '(1 2 3) (array->list #(1 2 3)))
364 (pass-if-equal '((1 2) (3 4) (5 6)) (array->list #2((1 2) (3 4) (5 6))))
365 (pass-if-equal '() (array->list #()))
367 (pass-if-equal "http://bugs.gnu.org/12465 - ok"
369 (let* ((a #2((1 2) (3 4)))
370 (b (make-shared-array a (lambda (j) (list 1 j)) 2)))
372 (pass-if-equal "http://bugs.gnu.org/12465 - bad"
374 (let* ((a #2((1 2) (3 4)))
375 (b (make-shared-array a (lambda (i) (list i 1)) 2)))
382 (with-test-prefix "array-fill!"
384 (with-test-prefix "bool"
385 (let ((a (make-bitvector 1 #t)))
386 (pass-if "#f" (array-fill! a #f) #t)
387 (pass-if "#t" (array-fill! a #t) #t)))
389 (with-test-prefix "char"
390 (let ((a (make-string 1 #\a)))
391 (pass-if "x" (array-fill! a #\x) #t)))
393 (with-test-prefix "byte"
394 (let ((a (make-s8vector 1 0)))
395 (pass-if "0" (array-fill! a 0) #t)
396 (pass-if "127" (array-fill! a 127) #t)
397 (pass-if "-128" (array-fill! a -128) #t)
398 (pass-if-exception "128" exception:out-of-range
400 (pass-if-exception "-129" exception:out-of-range
401 (array-fill! a -129))
402 (pass-if-exception "symbol" exception:wrong-type-arg
403 (array-fill! a 'symbol))))
405 (with-test-prefix "short"
406 (let ((a (make-s16vector 1 0)))
407 (pass-if "0" (array-fill! a 0) #t)
408 (pass-if "123" (array-fill! a 123) #t)
409 (pass-if "-123" (array-fill! a -123) #t)))
411 (with-test-prefix "ulong"
412 (let ((a (make-u32vector 1 1)))
413 (pass-if "0" (array-fill! a 0) #t)
414 (pass-if "123" (array-fill! a 123) #t)
415 (pass-if-exception "-123" exception:out-of-range
416 (array-fill! a -123) #t)))
418 (with-test-prefix "long"
419 (let ((a (make-s32vector 1 -1)))
420 (pass-if "0" (array-fill! a 0) #t)
421 (pass-if "123" (array-fill! a 123) #t)
422 (pass-if "-123" (array-fill! a -123) #t)))
424 (with-test-prefix "float"
425 (let ((a (make-f32vector 1 1.0)))
426 (pass-if "0.0" (array-fill! a 0) #t)
427 (pass-if "123.0" (array-fill! a 123.0) #t)
428 (pass-if "-123.0" (array-fill! a -123.0) #t)
429 (pass-if "0" (array-fill! a 0) #t)
430 (pass-if "123" (array-fill! a 123) #t)
431 (pass-if "-123" (array-fill! a -123) #t)
432 (pass-if "5/8" (array-fill! a 5/8) #t)))
434 (with-test-prefix "double"
435 (let ((a (make-f64vector 1 1/3)))
436 (pass-if "0.0" (array-fill! a 0) #t)
437 (pass-if "123.0" (array-fill! a 123.0) #t)
438 (pass-if "-123.0" (array-fill! a -123.0) #t)
439 (pass-if "0" (array-fill! a 0) #t)
440 (pass-if "123" (array-fill! a 123) #t)
441 (pass-if "-123" (array-fill! a -123) #t)
442 (pass-if "5/8" (array-fill! a 5/8) #t)))
444 (with-test-prefix "noncompact"
445 (let* ((a (make-array 0 3 3))
446 (b (make-shared-array a (lambda (i) (list i i)) 3)))
449 (and (equal? b #(9 9 9))
450 (equal? a #2((9 0 0) (0 9 0) (0 0 9))))))))
456 (with-test-prefix "array-copy!"
459 (let ((a #2((1 2) (3 4)))
460 (b (make-array 0 2 2))
461 (c (make-array 0 2 2))
462 (d (make-array 0 2 2))
463 (e (make-array 0 2 2)))
465 (array-copy! a (transpose-array c 1 0))
466 (array-copy! (transpose-array a 1 0) d)
467 (array-copy! (transpose-array a 1 0) (transpose-array e 1 0))
468 (and (equal? a #2((1 2) (3 4)))
469 (equal? b #2((1 2) (3 4)))
470 (equal? c #2((1 3) (2 4)))
471 (equal? d #2((1 3) (2 4)))
472 (equal? e #2((1 2) (3 4))))))
475 (let* ((a #2((1 2) (3 4)))
476 (b (make-shared-array a (lambda (j) (list 1 j)) 2))
477 (c (make-shared-array a (lambda (i) (list (- 1 i) 1)) 2))
479 (e (make-array 0 2)))
482 (and (equal? d #(3 4))
496 (with-test-prefix "array-in-bounds?"
498 (pass-if (let ((a (make-array #f '(425 425))))
499 (eq? #f (array-in-bounds? a 0)))))
505 (with-test-prefix "array-type"
507 (with-test-prefix "on make-foo-vector"
510 (eq? 'b (array-type (make-bitvector 1))))
513 (eq? 'a (array-type (make-string 1))))
516 (eq? 'u8 (array-type (make-u8vector 1))))
519 (eq? 's16 (array-type (make-s16vector 1))))
522 (eq? 'u32 (array-type (make-u32vector 1))))
525 (eq? 's32 (array-type (make-s32vector 1))))
528 (eq? 's64 (array-type (make-s64vector 1))))
531 (eq? 'f32 (array-type (make-f32vector 1))))
534 (eq? 'f64 (array-type (make-f64vector 1))))
537 (eq? 'c64 (array-type (make-c64vector 1))))
540 (eq? #t (array-type (make-vector 1)))))
542 (with-test-prefix "on make-typed-array"
544 (let ((types '(b a u8 s8 u16 s16 u32 s32 u64 u64 f32 f64 c32 c64)))
545 (for-each (lambda (type)
546 (pass-if (symbol->string type)
548 (array-type (make-typed-array type
557 (with-test-prefix "array-set!"
559 (with-test-prefix "bitvector"
561 ;; in Guile 1.8.0 a bug in bitvector_set() caused a segv in array-set!
562 ;; on a bitvector like the following
563 (let ((a (make-bitvector 1)))
564 (pass-if "one elem set #t"
567 (eq? #t (array-ref a 0))))
568 (pass-if "one elem set #f"
571 (eq? #f (array-ref a 0))))))
573 (with-test-prefix "byte"
575 (let ((a (make-s8vector 1)))
578 (begin (array-set! a -128 0) #t))
580 (begin (array-set! a 0 0) #t))
582 (begin (array-set! a 127 0) #t))
583 (pass-if-exception "-129" exception:out-of-range
584 (begin (array-set! a -129 0) #t))
585 (pass-if-exception "128" exception:out-of-range
586 (begin (array-set! a 128 0) #t))))
588 (with-test-prefix "short"
590 (let ((a (make-s16vector 1)))
591 ;; true if n can be array-set! into a
593 (false-if-exception (begin (array-set! a n 0) #t)))
595 (with-test-prefix "store/fetch"
596 ;; Check array-ref gives back what was put with array-set!.
597 ;; In Guile 1.6.4 and earlier, array-set! only demanded an inum and
598 ;; would silently truncate to a short.
600 (do ((n 1 (1+ (* 2 n)))) ;; n=2^k-1
604 (= n (array-ref a 0))))
606 (do ((n -1 (* 2 n))) ;; -n=2^k
610 (= n (array-ref a 0))))))))
616 (with-test-prefix "array-set!"
618 (with-test-prefix "one dim"
619 (let ((a (make-array #f '(3 5))))
626 (pass-if-exception "start-1" exception:out-of-range
628 (pass-if-exception "end+1" exception:out-of-range
630 (pass-if-exception "two indexes" exception:wrong-num-indices
631 (array-set! a 'y 6 7))))
633 (with-test-prefix "two dim"
634 (let ((a (make-array #f '(3 5) '(7 9))))
636 (array-set! a 'y 3 7)
639 (array-set! a 'y 5 9)
641 (pass-if-exception "start i-1" exception:out-of-range
642 (array-set! a 'y 2 7))
643 (pass-if-exception "end i+1" exception:out-of-range
644 (array-set! a 'y 6 9))
645 (pass-if-exception "one index" exception:wrong-num-indices
647 (pass-if-exception "three indexes" exception:wrong-num-indices
648 (array-set! a 'y 4 8 0)))))
654 (with-test-prefix "uniform-vector"
656 (with-test-prefix "uniform-vector-ref byte"
658 (let ((a (make-s8vector 1)))
663 (= 0 (uniform-vector-ref a 0))))
667 (= 127 (uniform-vector-ref a 0))))
670 (array-set! a -128 0)
671 (= -128 (uniform-vector-ref a 0))))))
673 (with-test-prefix "shared with rank 1 remain uniform vectors"
675 (let ((a #f64(1 2 3 4)))
677 (pass-if "change offset"
678 (let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
679 (and (uniform-vector? b)
680 (= 3 (uniform-vector-length b))
681 (array-equal? b #f64(2 3 4)))))
683 (pass-if "change stride"
684 (let ((c (make-shared-array a (lambda (i) (list (* i 2))) 2)))
685 (and (uniform-vector? c)
686 (= 2 (uniform-vector-length c))
687 (array-equal? c #f64(1 3))))))))
693 (with-test-prefix "syntax"
695 (pass-if "rank and lower bounds"
696 ;; uniform u32 array of rank 2 with index ranges 2..3 and 7..8.
697 (let ((a '#2u32@2@7((1 2) (3 4))))
699 (typed-array? a 'u32)
701 (let loop ((bounds '((2 7) (2 8) (3 7) (3 8)))
707 (apply array-in-bounds? a (car bounds)))))))))
709 (pass-if "negative lower bound"
710 (let ((a '#1@-3(a b)))
713 (array-in-bounds? a -3) (array-in-bounds? a -2)
714 (eq? 'a (array-ref a -3))
715 (eq? 'b (array-ref a -2)))))
717 (pass-if-exception "negative length" exception:length-non-negative
718 (with-input-from-string "'#1:-3(#t #t)" read))
720 (pass-if "bitvector is self-evaluating"
721 (equal? (compile (bitvector)) (bitvector))))
724 ;;; equal? with vector and one-dimensional array
727 (with-test-prefix "equal?"
728 (pass-if "array and non-array"
729 (not (equal? #2f64((0 1) (2 3)) 100)))
731 (pass-if "empty vectors of different types"
732 (not (equal? #s32() #f64())))
734 (pass-if "empty arrays of different types"
735 (not (equal? #2s32() #2f64())))
737 (pass-if "empty arrays of the same type"
738 (equal? #s32() #s32()))
740 (pass-if "identical uniform vectors of the same type"
741 (equal? #s32(1) #s32(1)))
743 (pass-if "nonidentical uniform vectors of the same type"
744 (not (equal? #s32(1) #s32(-1))))
746 (pass-if "identical uniform vectors of different types"
747 (not (equal? #s32(1) #s64(1))))
749 (pass-if "nonidentical uniform vectors of different types"
750 (not (equal? #s32(1) #s64(-1))))
752 (pass-if "vector and one-dimensional array"
753 (equal? (make-shared-array #2((a b c) (d e f) (g h i))
754 (lambda (i) (list i i))
759 ;;; slices as generalized vectors
762 (let ((array #2u32((0 1) (2 3))))
763 (define (array-row a i)
764 (make-shared-array a (lambda (j) (list i j))
765 (cadr (array-dimensions a))))
766 (with-test-prefix "generalized vector slices"
767 (pass-if (equal? (array-row array 1)
769 (pass-if (equal? (array-ref (array-row array 1) 0)