mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-29 16:30:19 +02:00
Code Activity

Fixed problem in scm_array_index_map_x: looped endlessly with zero-rank

Browse source 
argument.
This commit is contained in:
Radey Shouman 1997-09-29 03:29:27 +00:00
parent d1005e3cbb
commit e42c09cc6f
1 changed files with 66 additions and 60 deletions
Download patch file Download diff file Expand all files Collapse all files

16
libguile/ramap.c
View file

@ -1822,9 +1822,9 @@ scm_array_index_map_x (ra, proc)
{
scm_sizet i;
SCM_ASSERT (SCM_NIMP (ra), ra, SCM_ARG1, s_array_index_map_x);
SCM_ASSERT (SCM_BOOL_T == scm_procedure_p (proc), proc, SCM_ARG2, s_array_index_map_x);
switch SCM_TYP7
(ra)
SCM_ASSERT (SCM_BOOL_T == scm_procedure_p (proc), proc, SCM_ARG2,
s_array_index_map_x);
switch (SCM_TYP7(ra))
{
default:
badarg:scm_wta (ra, (char *) SCM_ARG1, s_array_index_map_x);
@ -1845,7 +1845,8 @@ scm_array_index_map_x (ra, proc)
case scm_tc7_dvect:
case scm_tc7_cvect:
for (i = 0; i < SCM_LENGTH (ra); i++)
scm_array_set_x (ra, scm_apply (proc, SCM_MAKINUM (i), scm_listofnull), SCM_MAKINUM (i));
scm_array_set_x (ra, scm_apply (proc, SCM_MAKINUM (i), scm_listofnull),
SCM_MAKINUM (i));
return SCM_UNSPECIFIED;
case scm_tc7_smob:
SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
@ -1854,6 +1855,9 @@ scm_array_index_map_x (ra, proc)
SCM inds = scm_make_uve (SCM_ARRAY_NDIM (ra), SCM_MAKINUM (-1L));
long *vinds = SCM_VELTS (inds);
int j, k, kmax = SCM_ARRAY_NDIM (ra) - 1;
if (kmax < 0)
return scm_array_set_x (ra, scm_apply(proc, SCM_EOL, SCM_EOL),
SCM_EOL);
for (k = 0; k <= kmax; k++)
vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd;
k = kmax;
@ -1867,7 +1871,9 @@ scm_array_index_map_x (ra, proc)
{
for (j = kmax + 1, args = SCM_EOL; j--;)
args = scm_cons (SCM_MAKINUM (vinds[j]), args);
scm_array_set_x (SCM_ARRAY_V (ra), scm_apply (proc, args, SCM_EOL), SCM_MAKINUM (i));
scm_array_set_x (SCM_ARRAY_V (ra),
scm_apply (proc, args, SCM_EOL),
SCM_MAKINUM (i));
i += SCM_ARRAY_DIMS (ra)[k].inc;
}
k--;