mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-01 12:20:26 +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 a0ef1252af
commit b0d9b0744a
2 changed files with 34 additions and 13 deletions
Download patch file Download diff file Expand all files Collapse all files

19
libguile/array-map.c
View file

@ -783,9 +783,7 @@ array_index_map_1 (SCM ra, SCM proc)
scm_t_array_handle h; scm_t_array_handle h;
ssize_t i, inc; ssize_t i, inc;
size_t p; size_t p;
SCM v;
scm_array_get_handle (ra, &h); scm_array_get_handle (ra, &h);
v = h.array;
inc = h.dims[0].inc; inc = h.dims[0].inc;
for (i = h.dims[0].lbnd, p = h.base; i <= h.dims[0].ubnd; ++i, p += 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))); 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); indices_gc_hint);
for (k = 0; k <= kmax; k++) 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; k = kmax;
do do
{ {
@ -822,16 +824,17 @@ array_index_map_n (SCM ra, SCM proc)
i += SCM_I_ARRAY_DIMS (ra)[k].inc; i += SCM_I_ARRAY_DIMS (ra)[k].inc;
} }
k--; 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]++; vinds[k]++;
k++; k++;
continue;
} }
vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd - 1; else
k--; {
vinds[k] = SCM_I_ARRAY_DIMS (ra)[k].lbnd - 1;
k--;
}
} }
while (k >= 0); while (k >= 0);
} }

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

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