summaryrefslogtreecommitdiff
path: root/test-suite
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2013-04-25 15:18:05 +0200
committerAndy Wingo <wingo@pobox.com>2014-01-27 21:48:02 +0100
commit2bd96d9ecd73b71b3666c7d1931ec3e33e5f49fb (patch)
tree971cdeffaed8b7561cd58490fbac5205e1810a6d /test-suite
parentcdd7cc9e9b3750a759ab442249a6f004a503fba5 (diff)
downloadguile-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.test62
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)))