diff options
author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2013-04-25 15:18:05 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-01-27 21:48:02 +0100 |
commit | 2bd96d9ecd73b71b3666c7d1931ec3e33e5f49fb (patch) | |
tree | 971cdeffaed8b7561cd58490fbac5205e1810a6d /test-suite | |
parent | cdd7cc9e9b3750a759ab442249a6f004a503fba5 (diff) | |
download | guile-2bd96d9ecd73b71b3666c7d1931ec3e33e5f49fb.tar.gz |
Fix corner cases of scm_ramapc
* libguile/array-map.c
- (scm_ramapc): mismatched axes limit unrollk (kroll). Reorganize
the function to do all checking as we go.
- (scm_ra_matchp): unused; remove.
- (find_unrollk): inlined in scm_ramapc; remove.
- (klen): inlined in scm_ramapc; remove.
- (rafill): n is size_t.
- (racp): n is size_t. Use n and not i0end to bound the loop.
- (ramap): Use n and not i0end to bound the loop. This is needed for the rank
0 case to work with the new scm_ramapc, as inc may be set to 0 in that case.
- (rafe): idem.
* test-suite/tests/ramap.test
- check that size mismatch prevents unrolling (matching behavior III) with
both array-copy! and array-map!.
- check that non-contiguous stride in non-ref args prevents unrolling
(rank 2, discontinuous) with both array-copy! and array-map!.
- check rank 0 cases with array-for-each, array-map!.
Diffstat (limited to 'test-suite')
-rw-r--r-- | test-suite/tests/ramap.test | 62 |
1 files changed, 60 insertions, 2 deletions
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test index 037850582..db9d4e145 100644 --- a/test-suite/tests/ramap.test +++ b/test-suite/tests/ramap.test @@ -103,6 +103,15 @@ (array-copy! a b) (equal? b #(1 2)))) + ;; here both a & b are are unrollable down to the first axis, but the + ;; size mismatch limits unrolling to the last axis only. + + (pass-if "matching behavior III" + (let ((a #3(((1 2) (3 4)) ((5 6) (7 8)))) + (b (make-array 0 2 3 2))) + (array-copy! a b) + (array-equal? b #3(((1 2) (3 4) (0 0)) ((5 6) (7 8) (0 0)))))) + (pass-if "rank 2" (let ((a #2((1 2) (3 4))) (b (make-array 0 2 2)) @@ -119,6 +128,19 @@ (equal? d #2((1 3) (2 4))) (equal? e #2((1 2) (3 4)))))) + (pass-if "rank 2, discontinuous" + (let ((A #2((0 1) (2 3) (4 5))) + (B #2((10 11) (12 13) (14 15))) + (C #2((20) (21) (22))) + (X (make-array 0 3 5)) + (piece (lambda (X w s) + (make-shared-array + X (lambda (i j) (list i (+ j s))) 3 w)))) + (array-map! A (piece X 2 0)) + (array-map! B (piece X 2 2)) + (array-map! C (piece X 1 4)) + (and (array-equal? X #2((0 1 10 11 20) (2 3 12 13 21) (4 5 14 15 22)))))) + (pass-if "rank 1" (let* ((a #2((1 2) (3 4))) (b (make-shared-array a (lambda (j) (list 1 j)) 2)) @@ -235,7 +257,26 @@ (pass-if "1+" (let ((a (make-array #f 5))) (array-map! a 1+ (make-array 123 5)) - (equal? a (make-array 124 5))))) + (equal? a (make-array 124 5)))) + + (pass-if "rank 0" + (let ((a #0(99)) + (b (make-array 0))) + (array-map! b values a) + (equal? b #0(99)))) + + (pass-if "rank 2, discontinuous" + (let ((A #2((0 1) (2 3) (4 5))) + (B #2((10 11) (12 13) (14 15))) + (C #2((20) (21) (22))) + (X (make-array 0 3 5)) + (piece (lambda (X w s) + (make-shared-array + X (lambda (i j) (list i (+ j s))) 3 w)))) + (array-map! (piece X 2 0) values A) + (array-map! (piece X 2 2) values B) + (array-map! (piece X 1 4) values C) + (and (array-equal? X #2((0 1 10 11 20) (2 3 12 13 21) (4 5 14 15 22))))))) (with-test-prefix "two sources" @@ -337,7 +378,16 @@ (let ((a #(1 2 3)) (b (make-array 0 2))) (array-map! b values a) - (equal? b #(1 2))))) + (equal? b #(1 2)))) + + ;; here both a & b are are unrollable down to the first axis, but the + ;; size mismatch limits unrolling to the last axis only. + + (pass-if "matching behavior III" + (let ((a #3(((1 2) (3 4) (5 6)) ((7 8) (9 10) (11 12)))) + (b (make-array 0 2 2 2))) + (array-map! b values a) + (array-equal? b #3(((1 2) (3 4)) ((7 8) (9 10))))))) ;;; ;;; array-for-each @@ -346,6 +396,14 @@ (with-test-prefix "array-for-each" (with-test-prefix "1 source" + (pass-if-equal "rank 0" + '(99) + (let* ((a #0(99)) + (l '()) + (p (lambda (x) (set! l (cons x l))))) + (array-for-each p a) + l)) + (pass-if-equal "noncompact array" '(3 2 1 0) (let* ((a #2((0 1) (2 3))) |