diff options
author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2013-04-11 13:10:08 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-01-27 21:45:17 +0100 |
commit | 413c7156795cedb453ebf68c3dd6fd376a64a12b (patch) | |
tree | 043e5b542b4dd161e610832978849d7e2b43af36 /test-suite | |
parent | 943f690a308f917fbac994fc1dd14d339879d6d4 (diff) | |
download | guile-413c7156795cedb453ebf68c3dd6fd376a64a12b.tar.gz |
For uniform vectors SCM_I_ARRAYP can't be true
This fixes an inconsistency where uniform-vector? of a shared array could
be true but -ref operations failed to account correctly for lbnd.
* libguile/uniform.c
- scm_is_uniform_vector: SCM_I_ARRAYP disqualifies obj as uniform vector.
- scm_c_uniform_vector_length: lbnd is known 0, so don't use it.
- scm_c_uniform_vector_ref: lbnd/base/inc are known to be 0/0/1.
- scm_c_uniform_vector_set_x!: idem.
- scm_uniform_vector_writable_elements: check uvec's type.
* test-suite/tests/arrays.test
- group the exception types at the top.
- check that uniform-vector functions do not accept general arrays.
Diffstat (limited to 'test-suite')
-rw-r--r-- | test-suite/tests/arrays.test | 58 |
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 |