summaryrefslogtreecommitdiff
path: root/test-suite/tests/arrays.test
diff options
context:
space:
mode:
Diffstat (limited to 'test-suite/tests/arrays.test')
-rw-r--r--test-suite/tests/arrays.test58
1 files changed, 36 insertions, 22 deletions
diff --git a/test-suite/tests/arrays.test b/test-suite/tests/arrays.test
index 0da1a1992..8ad97f4b2 100644
--- a/test-suite/tests/arrays.test
+++ b/test-suite/tests/arrays.test
@@ -22,16 +22,22 @@
#:use-module (srfi srfi-4)
#:use-module (srfi srfi-4 gnu))
-;;;
-;;; array?
-;;;
-
(define exception:wrong-num-indices
(cons 'misc-error "^wrong number of indices.*"))
(define exception:length-non-negative
(cons 'read-error ".*array length must be non-negative.*"))
+(define exception:mapping-out-of-range
+ (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
+
+; see strings.test.
+(define exception:wrong-type-arg
+ (cons #t "Wrong type"))
+
+;;;
+;;; array?
+;;;
(with-test-prefix "sanity"
;; At the current time of writing, bignums have a tc7 that is one bit
@@ -210,9 +216,6 @@
;;; make-shared-array
;;;
-(define exception:mapping-out-of-range
- (cons 'misc-error "^mapping out of range")) ;; per scm_make_shared_array
-
(with-test-prefix "make-shared-array"
;; this failed in guile 1.8.0
@@ -313,10 +316,6 @@
;;; transpose-array
;;;
-; see strings.test.
-(define exception:wrong-type-arg
- (cons #t "Wrong type"))
-
(with-test-prefix "transpose-array"
(pass-if-exception "non array argument" exception:wrong-type-arg
@@ -670,21 +669,36 @@
(array-set! a -128 0)
(= -128 (uniform-vector-ref a 0))))))
- (with-test-prefix "shared with rank 1 remain uniform vectors"
+ (with-test-prefix "arrays with lbnd!=0 are not uniform vectors"
+
+ (pass-if "bit"
+ (and (not (uniform-vector? #1b@1(#t #t #t)))
+ (uniform-vector? #1b(#t #t #t))))
+
+ (pass-if "s8"
+ (and (not (uniform-vector? #1s8@1(0 1 2)))
+ (uniform-vector? #1s8(0 1 2)))))
+
+
+ (with-test-prefix "shared with rank 1 do not remain uniform vectors"
(let ((a #f64(1 2 3 4)))
- (pass-if "change offset"
+ (pass-if-exception "change offset -length" exception:wrong-type-arg
(let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
- (and (uniform-vector? b)
- (= 3 (uniform-vector-length b))
- (array-equal? b #f64(2 3 4)))))
-
- (pass-if "change stride"
- (let ((c (make-shared-array a (lambda (i) (list (* i 2))) 2)))
- (and (uniform-vector? c)
- (= 2 (uniform-vector-length c))
- (array-equal? c #f64(1 3))))))))
+ (= 3 (uniform-vector-length b))))
+
+ (pass-if-exception "change offset -ref" exception:wrong-type-arg
+ (let ((b (make-shared-array a (lambda (i) (list (+ i 1))) 3)))
+ (= 2 (uniform-vector-ref b 0))))
+
+ (pass-if-exception "change stride -length" exception:wrong-type-arg
+ (let ((b (make-shared-array a (lambda (i) (list (* i 2))) 2)))
+ (= 3 (uniform-vector-length b))))
+
+ (pass-if-exception "change stride -ref" exception:wrong-type-arg
+ (let ((b (make-shared-array a (lambda (i) (list (* i 2))) 2)))
+ (= 2 (uniform-vector-ref b 0)))))))
;;;
;;; syntax