mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-04 08:40:21 +02:00
Code Activity

Fix empty array bug in array-index-map!

Browse source 
* 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.
This commit is contained in:
Daniel Llorens 2013-04-19 10:42:40 +02:00 • committed by Andy Wingo
parent 3e226ece5f
commit e26994b9e9
2 changed files with 38 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

15
libguile/array-map.c
View file

@ -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;
if (vinds[k] > SCM_I_ARRAY_DIMS (ra)[k].ubnd)
return SCM_UNSPECIFIED;
}
k = kmax;
do
{
@ -851,17 +857,18 @@ 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;
}
else
{
vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd - 1;
k--;
}
}
while (k >= 0);
return SCM_UNSPECIFIED;

22
test-suite/tests/ramap.test
View file

@ -33,11 +33,29 @@
(with-test-prefix "array-index-map!"
(pass-if (let ((nlst '()))
(pass-if "basic test"
(let ((nlst '()))
(array-index-map! (make-array #f '(1 1))
(lambda (n)
(set! nlst (cons n nlst))))
(equal? nlst '(1)))))
(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!