summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Llorens <daniel.llorens@bluewin.ch>2013-04-19 10:42:40 +0200
committerAndy Wingo <wingo@pobox.com>2014-02-09 12:48:19 +0100
commitb0d9b0744a6bfadbf172a90ed3b5b788555ca11d (patch)
tree6a83cdc6884f8b5317dc68575ef4f536abda380b
parenta0ef1252af3204e9d86087c5752f48790575d372 (diff)
downloadguile-b0d9b0744a6bfadbf172a90ed3b5b788555ca11d.tar.gz
Fix empty array bug in array-index-map!
* libguile/array-map.c: (scm_array_index_map_x): bail out if any one of the axes is empty. * test-suite/tests/ramap.test: add tests for empty array-case of array-index-map!. The 'f64 case with not-last emtpy axis is broken in 2.0.9.
-rw-r--r--libguile/array-map.c19
-rw-r--r--test-suite/tests/ramap.test28
2 files changed, 34 insertions, 13 deletions
diff --git a/libguile/array-map.c b/libguile/array-map.c
index 83f3a9949..057a0e5af 100644
--- a/libguile/array-map.c
+++ b/libguile/array-map.c
@@ -783,9 +783,7 @@ array_index_map_1 (SCM ra, SCM proc)
scm_t_array_handle h;
ssize_t i, inc;
size_t p;
- SCM v;
scm_array_get_handle (ra, &h);
- v = h.array;
inc = h.dims[0].inc;
for (i = h.dims[0].lbnd, p = h.base; i <= h.dims[0].ubnd; ++i, p += inc)
h.vset (&h, p, scm_call_1 (proc, scm_from_ulong (i)));
@@ -806,7 +804,11 @@ array_index_map_n (SCM ra, SCM proc)
indices_gc_hint);
for (k = 0; k <= kmax; k++)
- vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
+ {
+ vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd;
+ if (vinds[k] > SCM_I_ARRAY_DIMS (ra)[k].ubnd)
+ return;
+ }
k = kmax;
do
{
@@ -822,16 +824,17 @@ array_index_map_n (SCM ra, SCM proc)
i += SCM_I_ARRAY_DIMS (ra)[k].inc;
}
k--;
- continue;
}
- if (vinds[k] < SCM_I_ARRAY_DIMS (ra)[k].ubnd)
+ else if (vinds[k] < SCM_I_ARRAY_DIMS (ra)[k].ubnd)
{
vinds[k]++;
k++;
- continue;
}
- vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd - 1;
- k--;
+ else
+ {
+ vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd - 1;
+ k--;
+ }
}
while (k >= 0);
}
diff --git a/test-suite/tests/ramap.test b/test-suite/tests/ramap.test
index 00de626a4..2ecd43b22 100644
--- a/test-suite/tests/ramap.test
+++ b/test-suite/tests/ramap.test
@@ -33,11 +33,29 @@
(with-test-prefix "array-index-map!"
- (pass-if (let ((nlst '()))
- (array-index-map! (make-array #f '(1 1))
- (lambda (n)
- (set! nlst (cons n nlst))))
- (equal? nlst '(1)))))
+ (pass-if "basic test"
+ (let ((nlst '()))
+ (array-index-map! (make-array #f '(1 1))
+ (lambda (n)
+ (set! nlst (cons n nlst))))
+ (equal? nlst '(1))))
+
+ (with-test-prefix "empty arrays"
+
+ (pass-if "all axes empty"
+ (array-index-map! (make-typed-array 'f64 0 0 0) (const 0))
+ (array-index-map! (make-typed-array 'b #t 0 0) (const #t))
+ (array-index-map! (make-typed-array #t 0 0 0) (const 0)))
+
+ (pass-if "last axis empty"
+ (array-index-map! (make-typed-array 'f64 0 2 0) (const 0))
+ (array-index-map! (make-typed-array 'b #t 2 0) (const #t))
+ (array-index-map! (make-typed-array #t 0 2 0) (const 0)))
+
+ (pass-if "axis empty, other than last"
+ (array-index-map! (make-typed-array 'f64 0 0 2) (const 0))
+ (array-index-map! (make-typed-array 'b #t 0 2) (const #t))
+ (array-index-map! (make-typed-array #t 0 0 2) (const 0)))))
;;;
;;; array-copy!