diff options
author | Daniel Llorens <daniel.llorens@bluewin.ch> | 2013-04-19 10:42:40 +0200 |
---|---|---|
committer | Andy Wingo <wingo@pobox.com> | 2014-01-27 21:45:18 +0100 |
commit | e26994b9e9ab075e357d71d4e06fc2a09f7f243b (patch) | |
tree | 69d1b81e4a448e61d194256323e34b1391f9a17d | |
parent | 3e226ece5fc6f87cac2d02948177cafe61977bc4 (diff) | |
download | guile-e26994b9e9ab075e357d71d4e06fc2a09f7f243b.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.c | 23 | ||||
-rw-r--r-- | test-suite/tests/ramap.test | 28 |
2 files changed, 38 insertions, 13 deletions
diff --git a/libguile/array-map.c b/libguile/array-map.c index 43ef046fd..e2bf7ae96 100644 --- a/libguile/array-map.c +++ b/libguile/array-map.c @@ -47,7 +47,9 @@ /* The WHAT argument for `scm_gc_malloc ()' et al. */ static const char indices_gc_hint[] = "array-indices"; -/* FIXME Versions of array_handle_ref/set in arrays.c */ +/* FIXME Versions of array_handle_ref/set in arrays.c. This is called + sometimes with SCM_I_ARRAY_V, sometimes with the array itself. Should + make up our mind. */ static SCM AREF (SCM v, size_t pos) { @@ -835,7 +837,11 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, 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 SCM_UNSPECIFIED; + } k = kmax; do { @@ -851,16 +857,17 @@ SCM_DEFINE (scm_array_index_map_x, "array-index-map!", 2, 0, 0, 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! |