re PR libfortran/19106 ([4.0 only] segfault in executable for print *,sum(a,dim=2,mask=a>0))

2005-04-09  Thomas Koenig  <Thomas.Koenig@online.de>

        PR libfortran/19106
        PR libfortran/19014
        * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): ditto.
        If retarray->data is NULL (i.e. the front end does not
        know the rank and dimenson of the array), fill in its
        properties and allocate memory.
        Change the assertions about rank and dimension of retarray into
        runtime errors and only check them for retarray->data != NULL.
        Do the same for correcting the stride from 0 to 1 in retarray.
        (`m'name`'rtype_qual`_'atype_code): Likewise.
        * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise.
        Change assertion about rank of array to runtime error.
        (`m'name`'rtype_qual`_'atype_code): Likewise.
        * generated/all_l4.c: Regenerated.
        * generated/all_l8.c: Regenerated.
        * generated/any_l4.c: Regenerated.
        * generated/any_l8.c: Regenerated.
        * generated/count_4_l4.c: Regenerated.
        * generated/count_4_l8.c: Regenerated.
        * generated/count_8_l4.c: Regenerated.
        * generated/count_8_l8.c: Regenerated.
        * generated/maxloc0_4_i4.c: Regenerated.
        * generated/maxloc0_4_i8.c: Regenerated.
        * generated/maxloc0_4_r4.c: Regenerated.
        * generated/maxloc0_4_r8.c: Regenerated.
        * generated/maxloc0_8_i4.c: Regenerated.
        * generated/maxloc0_8_i8.c: Regenerated.
        * generated/maxloc0_8_r4.c: Regenerated.
        * generated/maxloc0_8_r8.c: Regenerated.
        * generated/maxloc1_4_i4.c: Regenerated.
        * generated/maxloc1_4_i8.c: Regenerated.
        * generated/maxloc1_4_r4.c: Regenerated.
        * generated/maxloc1_4_r8.c: Regenerated.
        * generated/maxloc1_8_i4.c: Regenerated.
        * generated/maxloc1_8_i8.c: Regenerated.
        * generated/maxloc1_8_r4.c: Regenerated.
        * generated/maxloc1_8_r8.c: Regenerated.
        * generated/maxval_i4.c: Regenerated.
        * generated/maxval_i8.c: Regenerated.
        * generated/maxval_r4.c: Regenerated.
        * generated/maxval_r8.c: Regenerated.
        * generated/minloc0_4_i4.c: Regenerated.
        * generated/minloc0_4_i8.c: Regenerated.
        * generated/minloc0_4_r4.c: Regenerated.
        * generated/minloc0_4_r8.c: Regenerated.
        * generated/minloc0_8_i4.c: Regenerated.
        * generated/minloc0_8_i8.c: Regenerated.
        * generated/minloc0_8_r4.c: Regenerated.
        * generated/minloc0_8_r8.c: Regenerated.
        * generated/minloc1_4_i4.c: Regenerated.
        * generated/minloc1_4_i8.c: Regenerated.
        * generated/minloc1_4_r4.c: Regenerated.
        * generated/minloc1_4_r8.c: Regenerated.
        * generated/minloc1_8_i4.c: Regenerated.
        * generated/minloc1_8_i8.c: Regenerated.
        * generated/minloc1_8_r4.c: Regenerated.
        * generated/minloc1_8_r8.c: Regenerated.
        * generated/minval_i4.c: Regenerated.
        * generated/minval_i8.c: Regenerated.
        * generated/minval_r4.c: Regenerated.
        * generated/minval_r8.c: Regenerated.
        * generated/product_c4.c: Regenerated.
        * generated/product_c8.c: Regenerated.
        * generated/product_i4.c: Regenerated.
        * generated/product_i8.c: Regenerated.
        * generated/product_r4.c: Regenerated.
        * generated/product_r8.c: Regenerated.
        * generated/sum_c4.c: Regenerated.
        * generated/sum_c8.c: Regenerated.
        * generated/sum_i4.c: Regenerated.
        * generated/sum_i8.c: Regenerated.
        * generated/sum_r4.c: Regenerated.
        * generated/sum_r8.c: Regenerated.

2005-04-09  Thomas Koenig  <Thomas.Koenig@online.de>

        * gfortran.fortran-torture/execute/intrinsic_anyall.f90:
        Added test for callee-allocated arrays with write statements.
        * gfortran.fortran-torture/execute/intrinsic_count.f90: Likewise.
        * gfortran.fortran-torture/execute/intrinsic_mmloc.f90: Likewise.
        * gfortran.fortran-torture/execute/intrinsic_mmval.f90: Likewise.
        * gfortran.fortran-torture/execute/intrinsic_product.f90: Likewise.
        * gfortran.fortran-torture/execute/intrinsic_sum.f90: Likewise.

From-SVN: r97929

2 files changed, 84 insertions, 20 deletions

diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4
index 105ca97..616caf9 100644
--- a/libgfortran/m4/iforeach.m4
+++ b/libgfortran/m4/iforeach.m4
@@ -20,13 +20,31 @@ name`'rtype_qual`_'atype_code (rtype * retarray, atype *array)
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 0;
+      retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+	runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+	retarray->dim[0].stride = 1;
+    }
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
@@ -109,17 +127,32 @@ void
   index_type n;
 
   rank = GFC_DESCRIPTOR_RANK (array);
-  assert (rank > 0);
-  assert (GFC_DESCRIPTOR_RANK (retarray) == 1);
-  assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank);
-  assert (GFC_DESCRIPTOR_RANK (mask) == rank);
+  if (rank <= 0)
+    runtime_error ("Rank of array needs to be > 0");
+
+  if (retarray->data == NULL)
+    {
+      retarray->dim[0].lbound = 0;
+      retarray->dim[0].ubound = rank-1;
+      retarray->dim[0].stride = 1;
+      retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1;
+      retarray->base = 0;
+      retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
+    }
+  else
+    {
+      if (GFC_DESCRIPTOR_RANK (retarray) != 1)
+	runtime_error ("rank of return array does not equal 1");
+
+      if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
+        runtime_error ("dimension of return array incorrect");
+
+      if (retarray->dim[0].stride == 0)
+	retarray->dim[0].stride = 1;
+    }
 
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   dstride = retarray->dim[0].stride;
   dest = retarray->data;
diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4
index 6c4dfbe..b377677 100644
--- a/libgfortran/m4/ifunction.m4
+++ b/libgfortran/m4/ifunction.m4
@@ -40,11 +40,8 @@ name`'rtype_qual`_'atype_code (rtype *retarray, atype *array, index_type *pdim)
   /* Make dim zero based to avoid confusion.  */
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   delta = array->dim[dim].stride;
@@ -78,8 +75,17 @@ name`'rtype_qual`_'atype_code (rtype *retarray, atype *array, index_type *pdim)
 		 		 * retarray->dim[rank-1].stride
 				 * extent[rank-1]);
       retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
     }
-          
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+	retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+	runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;
@@ -168,11 +174,8 @@ void
 
   dim = (*pdim) - 1;
   rank = GFC_DESCRIPTOR_RANK (array) - 1;
-  assert (rank == GFC_DESCRIPTOR_RANK (retarray));
   if (array->dim[0].stride == 0)
     array->dim[0].stride = 1;
-  if (retarray->dim[0].stride == 0)
-    retarray->dim[0].stride = 1;
 
   len = array->dim[dim].ubound + 1 - array->dim[dim].lbound;
   if (len <= 0)
@@ -194,6 +197,34 @@ void
         array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound;
     }
 
+  if (retarray->data == NULL)
+    {
+      for (n = 0; n < rank; n++)
+        {
+          retarray->dim[n].lbound = 0;
+          retarray->dim[n].ubound = extent[n]-1;
+          if (n == 0)
+            retarray->dim[n].stride = 1;
+          else
+            retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1];
+        }
+
+      retarray->data
+	 = internal_malloc_size (sizeof (rtype_name)
+		 		 * retarray->dim[rank-1].stride
+				 * extent[rank-1]);
+      retarray->base = 0;
+      retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank;
+    }
+  else
+    {
+      if (retarray->dim[0].stride == 0)
+	retarray->dim[0].stride = 1;
+
+      if (rank != GFC_DESCRIPTOR_RANK (retarray))
+	runtime_error ("rank of return array incorrect");
+    }
+
   for (n = 0; n < rank; n++)
     {
       count[n] = 0;