Fixed problem in scm_array_index_map_x: looped endlessly with zero-rank

argument.

1 files changed, 66 insertions, 60 deletions

diff --git a/libguile/ramap.c b/libguile/ramap.c
index 5677b894c..ad2637822 100644
--- a/libguile/ramap.c
+++ b/libguile/ramap.c
@@ -1822,70 +1822,76 @@ 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);
+    case scm_tc7_vector:
+    case scm_tc7_wvect:
       {
-      default:
-      badarg:scm_wta (ra, (char *) SCM_ARG1, s_array_index_map_x);
-      case scm_tc7_vector:
-      case scm_tc7_wvect:
-	{
-	  SCM *ve = SCM_VELTS (ra);
-	  for (i = 0; i < SCM_LENGTH (ra); i++)
-	    ve[i] = scm_apply (proc, SCM_MAKINUM (i), scm_listofnull);
-	  return SCM_UNSPECIFIED;
-	}
-      case scm_tc7_string:
-      case scm_tc7_byvect:
-      case scm_tc7_bvect:
-      case scm_tc7_uvect:
-      case scm_tc7_ivect:
-      case scm_tc7_fvect:
-      case scm_tc7_dvect:
-      case scm_tc7_cvect:
+	SCM *ve = SCM_VELTS (ra);
 	for (i = 0; i < SCM_LENGTH (ra); i++)
-	  scm_array_set_x (ra, scm_apply (proc, SCM_MAKINUM (i), scm_listofnull), SCM_MAKINUM (i));
+	  ve[i] = scm_apply (proc, SCM_MAKINUM (i), scm_listofnull);
+	return SCM_UNSPECIFIED;
+      }
+    case scm_tc7_string:
+    case scm_tc7_byvect:
+    case scm_tc7_bvect:
+    case scm_tc7_uvect:
+    case scm_tc7_ivect:
+    case scm_tc7_fvect:
+    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));
+      return SCM_UNSPECIFIED;
+    case scm_tc7_smob:
+      SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
+      {
+	SCM args = SCM_EOL;
+	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;
+	do
+	  {
+	    if (k == kmax)
+	      {
+		vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd;
+		i = cind (ra, inds);
+		for (; vinds[k] <= SCM_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++)
+		  {
+		    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));
+		    i += SCM_ARRAY_DIMS (ra)[k].inc;
+		  }
+		k--;
+		continue;
+	      }
+	    if (vinds[k] < SCM_ARRAY_DIMS (ra)[k].ubnd)
+	      {
+		vinds[k]++;
+		k++;
+		continue;
+	      }
+	    vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd - 1;
+	    k--;
+	  }
+	while (k >= 0);
 	return SCM_UNSPECIFIED;
-      case scm_tc7_smob:
-	SCM_ASRTGO (SCM_ARRAYP (ra), badarg);
-	{
-	  SCM args = SCM_EOL;
-	  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;
-	  for (k = 0; k <= kmax; k++)
-	    vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd;
-	  k = kmax;
-	  do
-	    {
-	      if (k == kmax)
-		{
-		  vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd;
-		  i = cind (ra, inds);
-		  for (; vinds[k] <= SCM_ARRAY_DIMS (ra)[k].ubnd; vinds[k]++)
-		    {
-		      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));
-		      i += SCM_ARRAY_DIMS (ra)[k].inc;
-		    }
-		  k--;
-		  continue;
-		}
-	      if (vinds[k] < SCM_ARRAY_DIMS (ra)[k].ubnd)
-		{
-		  vinds[k]++;
-		  k++;
-		  continue;
-		}
-	      vinds[k] = SCM_ARRAY_DIMS (ra)[k].lbnd - 1;
-	      k--;
-	    }
-	  while (k >= 0);
-	  return SCM_UNSPECIFIED;
-	}
       }
+    }
 }