mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00
Code Activity

* unif.c (scm_shap2ra): tighten the checking of the array dimension

Browse source 
specifier, since (2) or (2 . 3) would cause SEGV.
(scm_transpose_array): more argument checking fixes.
This commit is contained in:
Gary Houston 1997-08-30 19:28:38 +00:00
parent cb1c84cfc8
commit 20a54673cd
3 changed files with 21 additions and 15 deletions
Download patch file Download diff file Expand all files Collapse all files

6
libguile/ChangeLog
View file

@ -1,3 +1,9 @@
Sat Aug 30 18:56:19 1997 Gary Houston <ghouston@actrix.gen.nz>
* unif.c (scm_shap2ra): tighten the checking of the array dimension
specifier, since (2) or (2 . 3) would cause SEGV.
(scm_transpose_array): more argument checking fixes.
Wed Aug 27 17:44:44 1997 Jim Blandy <jimb@totoro.red-bean.com>
* Makefile.in: Regenerated, so it uses "tar", not "gtar".

7
libguile/strop.c
View file

@ -128,16 +128,11 @@ scm_string_rindex (str, chr, frm, to)
frm = SCM_BOOL_F;
if (to == SCM_UNDEFINED)
to = SCM_BOOL_F;
pos = scm_i_index (&str, chr, -1, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_index);
pos = scm_i_index (&str, chr, -1, frm, to, SCM_ARG1, SCM_ARG2, SCM_ARG3, SCM_ARG4, s_string_rindex);
return (pos < 0
? SCM_BOOL_F
: SCM_MAKINUM (pos));
}
SCM_PROC(s_substring_move_left_x, "substring-move-left!", 2, 0, 1, scm_substring_move_left_x);

23
libguile/unif.c
View file

@ -536,18 +536,21 @@ scm_shap2ra (args, what)
if (SCM_IMP (spec))
{
SCM_ASSERT (SCM_INUMP (spec) && SCM_INUM (spec) >= 0, spec, s_bad_spec, what);
SCM_ASSERT (SCM_INUMP (spec) && SCM_INUM (spec) >= 0, spec,
s_bad_spec, what);
s->lbnd = 0;
s->ubnd = SCM_INUM (spec) - 1;
s->inc = 1;
}
else
{
SCM_ASSERT (SCM_CONSP (spec) && SCM_INUMP (SCM_CAR (spec)), spec, s_bad_spec, what);
SCM_ASSERT (SCM_CONSP (spec) && SCM_INUMP (SCM_CAR (spec)), spec,
s_bad_spec, what);
s->lbnd = SCM_INUM (SCM_CAR (spec));
sp = SCM_CDR (spec);
SCM_ASSERT (SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)),
spec, s_bad_spec, what);
SCM_ASSERT (SCM_NIMP (sp) && SCM_CONSP (sp)
&& SCM_INUMP (SCM_CAR (sp)) && SCM_NULLP (SCM_CDR (sp)),
spec, s_bad_spec, what);
s->ubnd = SCM_INUM (SCM_CAR (sp));
s->inc = 1;
}
@ -802,7 +805,7 @@ scm_transpose_array (args)
switch (SCM_TYP7 (ra))
{
default:
badarg:scm_wta (ra, (char *) SCM_ARGn, s_transpose_array);
badarg:scm_wta (ra, (char *) SCM_ARG1, s_transpose_array);
case scm_tc7_bvect:
case scm_tc7_string:
case scm_tc7_byvect:
@ -831,9 +834,11 @@ scm_transpose_array (args)
ndim = 0;
for (k = 0; k < SCM_ARRAY_NDIM (ra); k++)
{
SCM_ASSERT (SCM_INUMP (ve[k]), ve[k], (SCM_ARG2 + k),
s_transpose_array);
i = SCM_INUM (ve[k]);
SCM_ASSERT (SCM_INUMP (ve[k]) && i >= 0 && i < SCM_ARRAY_NDIM (ra),
ve[k], SCM_ARG2, s_transpose_array);
SCM_ASSERT (i >= 0 && i < SCM_ARRAY_NDIM (ra), ve[k],
SCM_OUTOFRANGE, s_transpose_array);
if (ndim < i)
ndim = i;
}
@ -870,7 +875,7 @@ scm_transpose_array (args)
r->inc += s->inc;
}
}
SCM_ASSERT (ndim <= 0, args, "bad argument scm_list", s_transpose_array);
SCM_ASSERT (ndim <= 0, args, "bad argument list", s_transpose_array);
scm_ra_set_contp (res);
return res;
}
@ -2109,7 +2114,7 @@ scm_array_to_list (v)
}
static char s_bad_ralst[] = "Bad scm_array contents scm_list";
static char s_bad_ralst[] = "Bad scm_array contents list";
static int l2ra SCM_P ((SCM lst, SCM ra, scm_sizet base, scm_sizet k));