* 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.

diff --git a/libguile/ChangeLog b/libguile/ChangeLog
index bb03d49..5ab0264 100644 (file)
--- a/libguile/ChangeLog
+++ b/libguile/ChangeLog
@@ -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".

diff --git a/libguile/strop.c b/libguile/strop.c
index 482bf89..92d134e 100644 (file)
--- a/libguile/strop.c
+++ b/libguile/strop.c
@@ -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);
 

diff --git a/libguile/unif.c b/libguile/unif.c
index 1650e46..10f9f65 100644 (file)
--- a/libguile/unif.c
+++ b/libguile/unif.c
@@ -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));