[multiple changes]

2009-07-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34670
	PR libfortran/36874
	* Makefile.am:  Add bounds.c
	* libgfortran.h (bounds_equal_extents):  Add prototype.
	(bounds_iforeach_return):  Likewise.
	(bounds_ifunction_return):  Likewise.
	(bounds_reduced_extents):  Likewise.
	* runtime/bounds.c:  New file.
	(bounds_iforeach_return):  New function; correct typo in
	error message.
	(bounds_ifunction_return):  New function.
	(bounds_equal_extents):  New function.
	(bounds_reduced_extents):  Likewise.
	* intrinsics/cshift0.c (cshift0):  Use new functions
	for bounds checking.
	* intrinsics/eoshift0.c (eoshift0):  Likewise.
	* intrinsics/eoshift2.c (eoshift2):  Likewise.
	* m4/iforeach.m4:  Likewise.
	* m4/eoshift1.m4:  Likewise.
	* m4/eoshift3.m4:  Likewise.
	* m4/cshift1.m4:  Likewise.
	* m4/ifunction.m4:  Likewise.
	* Makefile.in:  Regenerated.
	* generated/cshift1_16.c: Regenerated.
	* generated/cshift1_4.c: Regenerated.
	* generated/cshift1_8.c: Regenerated.
	* generated/eoshift1_16.c: Regenerated.
	* generated/eoshift1_4.c: Regenerated.
	* generated/eoshift1_8.c: Regenerated.
	* generated/eoshift3_16.c: Regenerated.
	* generated/eoshift3_4.c: Regenerated.
	* generated/eoshift3_8.c: Regenerated.
	* generated/maxloc0_16_i1.c: Regenerated.
	* generated/maxloc0_16_i16.c: Regenerated.
	* generated/maxloc0_16_i2.c: Regenerated.
	* generated/maxloc0_16_i4.c: Regenerated.
	* generated/maxloc0_16_i8.c: Regenerated.
	* generated/maxloc0_16_r10.c: Regenerated.
	* generated/maxloc0_16_r16.c: Regenerated.
	* generated/maxloc0_16_r4.c: Regenerated.
	* generated/maxloc0_16_r8.c: Regenerated.
	* generated/maxloc0_4_i1.c: Regenerated.
	* generated/maxloc0_4_i16.c: Regenerated.
	* generated/maxloc0_4_i2.c: Regenerated.
	* generated/maxloc0_4_i4.c: Regenerated.
	* generated/maxloc0_4_i8.c: Regenerated.
	* generated/maxloc0_4_r10.c: Regenerated.
	* generated/maxloc0_4_r16.c: Regenerated.
	* generated/maxloc0_4_r4.c: Regenerated.
	* generated/maxloc0_4_r8.c: Regenerated.
	* generated/maxloc0_8_i1.c: Regenerated.
	* generated/maxloc0_8_i16.c: Regenerated.
	* generated/maxloc0_8_i2.c: Regenerated.
	* generated/maxloc0_8_i4.c: Regenerated.
	* generated/maxloc0_8_i8.c: Regenerated.
	* generated/maxloc0_8_r10.c: Regenerated.
	* generated/maxloc0_8_r16.c: Regenerated.
	* generated/maxloc0_8_r4.c: Regenerated.
	* generated/maxloc0_8_r8.c: Regenerated.
	* generated/maxloc1_16_i1.c: Regenerated.
	* generated/maxloc1_16_i16.c: Regenerated.
	* generated/maxloc1_16_i2.c: Regenerated.
	* generated/maxloc1_16_i4.c: Regenerated.
	* generated/maxloc1_16_i8.c: Regenerated.
	* generated/maxloc1_16_r10.c: Regenerated.
	* generated/maxloc1_16_r16.c: Regenerated.
	* generated/maxloc1_16_r4.c: Regenerated.
	* generated/maxloc1_16_r8.c: Regenerated.
	* generated/maxloc1_4_i1.c: Regenerated.
	* generated/maxloc1_4_i16.c: Regenerated.
	* generated/maxloc1_4_i2.c: Regenerated.
	* generated/maxloc1_4_i4.c: Regenerated.
	* generated/maxloc1_4_i8.c: Regenerated.
	* generated/maxloc1_4_r10.c: Regenerated.
	* generated/maxloc1_4_r16.c: Regenerated.
	* generated/maxloc1_4_r4.c: Regenerated.
	* generated/maxloc1_4_r8.c: Regenerated.
	* generated/maxloc1_8_i1.c: Regenerated.
	* generated/maxloc1_8_i16.c: Regenerated.
	* generated/maxloc1_8_i2.c: Regenerated.
	* generated/maxloc1_8_i4.c: Regenerated.
	* generated/maxloc1_8_i8.c: Regenerated.
	* generated/maxloc1_8_r10.c: Regenerated.
	* generated/maxloc1_8_r16.c: Regenerated.
	* generated/maxloc1_8_r4.c: Regenerated.
	* generated/maxloc1_8_r8.c: Regenerated.
	* generated/maxval_i1.c: Regenerated.
	* generated/maxval_i16.c: Regenerated.
	* generated/maxval_i2.c: Regenerated.
	* generated/maxval_i4.c: Regenerated.
	* generated/maxval_i8.c: Regenerated.
	* generated/maxval_r10.c: Regenerated.
	* generated/maxval_r16.c: Regenerated.
	* generated/maxval_r4.c: Regenerated.
	* generated/maxval_r8.c: Regenerated.
	* generated/minloc0_16_i1.c: Regenerated.
	* generated/minloc0_16_i16.c: Regenerated.
	* generated/minloc0_16_i2.c: Regenerated.
	* generated/minloc0_16_i4.c: Regenerated.
	* generated/minloc0_16_i8.c: Regenerated.
	* generated/minloc0_16_r10.c: Regenerated.
	* generated/minloc0_16_r16.c: Regenerated.
	* generated/minloc0_16_r4.c: Regenerated.
	* generated/minloc0_16_r8.c: Regenerated.
	* generated/minloc0_4_i1.c: Regenerated.
	* generated/minloc0_4_i16.c: Regenerated.
	* generated/minloc0_4_i2.c: Regenerated.
	* generated/minloc0_4_i4.c: Regenerated.
	* generated/minloc0_4_i8.c: Regenerated.
	* generated/minloc0_4_r10.c: Regenerated.
	* generated/minloc0_4_r16.c: Regenerated.
	* generated/minloc0_4_r4.c: Regenerated.
	* generated/minloc0_4_r8.c: Regenerated.
	* generated/minloc0_8_i1.c: Regenerated.
	* generated/minloc0_8_i16.c: Regenerated.
	* generated/minloc0_8_i2.c: Regenerated.
	* generated/minloc0_8_i4.c: Regenerated.
	* generated/minloc0_8_i8.c: Regenerated.
	* generated/minloc0_8_r10.c: Regenerated.
	* generated/minloc0_8_r16.c: Regenerated.
	* generated/minloc0_8_r4.c: Regenerated.
	* generated/minloc0_8_r8.c: Regenerated.
	* generated/minloc1_16_i1.c: Regenerated.
	* generated/minloc1_16_i16.c: Regenerated.
	* generated/minloc1_16_i2.c: Regenerated.
	* generated/minloc1_16_i4.c: Regenerated.
	* generated/minloc1_16_i8.c: Regenerated.
	* generated/minloc1_16_r10.c: Regenerated.
	* generated/minloc1_16_r16.c: Regenerated.
	* generated/minloc1_16_r4.c: Regenerated.
	* generated/minloc1_16_r8.c: Regenerated.
	* generated/minloc1_4_i1.c: Regenerated.
	* generated/minloc1_4_i16.c: Regenerated.
	* generated/minloc1_4_i2.c: Regenerated.
	* generated/minloc1_4_i4.c: Regenerated.
	* generated/minloc1_4_i8.c: Regenerated.
	* generated/minloc1_4_r10.c: Regenerated.
	* generated/minloc1_4_r16.c: Regenerated.
	* generated/minloc1_4_r4.c: Regenerated.
	* generated/minloc1_4_r8.c: Regenerated.
	* generated/minloc1_8_i1.c: Regenerated.
	* generated/minloc1_8_i16.c: Regenerated.
	* generated/minloc1_8_i2.c: Regenerated.
	* generated/minloc1_8_i4.c: Regenerated.
	* generated/minloc1_8_i8.c: Regenerated.
	* generated/minloc1_8_r10.c: Regenerated.
	* generated/minloc1_8_r16.c: Regenerated.
	* generated/minloc1_8_r4.c: Regenerated.
	* generated/minloc1_8_r8.c: Regenerated.
	* generated/minval_i1.c: Regenerated.
	* generated/minval_i16.c: Regenerated.
	* generated/minval_i2.c: Regenerated.
	* generated/minval_i4.c: Regenerated.
	* generated/minval_i8.c: Regenerated.
	* generated/minval_r10.c: Regenerated.
	* generated/minval_r16.c: Regenerated.
	* generated/minval_r4.c: Regenerated.
	* generated/minval_r8.c: Regenerated.
	* generated/product_c10.c: Regenerated.
	* generated/product_c16.c: Regenerated.
	* generated/product_c4.c: Regenerated.
	* generated/product_c8.c: Regenerated.
	* generated/product_i1.c: Regenerated.
	* generated/product_i16.c: Regenerated.
	* generated/product_i2.c: Regenerated.
	* generated/product_i4.c: Regenerated.
	* generated/product_i8.c: Regenerated.
	* generated/product_r10.c: Regenerated.
	* generated/product_r16.c: Regenerated.
	* generated/product_r4.c: Regenerated.
	* generated/product_r8.c: Regenerated.
	* generated/sum_c10.c: Regenerated.
	* generated/sum_c16.c: Regenerated.
	* generated/sum_c4.c: Regenerated.
	* generated/sum_c8.c: Regenerated.
	* generated/sum_i1.c: Regenerated.
	* generated/sum_i16.c: Regenerated.
	* generated/sum_i2.c: Regenerated.
	* generated/sum_i4.c: Regenerated.
	* generated/sum_i8.c: Regenerated.
	* generated/sum_r10.c: Regenerated.
	* generated/sum_r16.c: Regenerated.
	* generated/sum_r4.c: Regenerated.
	* generated/sum_r8.c: Regenerated.

2009-07-19   Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34670
	PR libfortran/36874
	* gfortran.dg/cshift_bounds_1.f90:  New test.
	* gfortran.dg/cshift_bounds_2.f90:  New test.
	* gfortran.dg/cshift_bounds_3.f90:  New test.
	* gfortran.dg/cshift_bounds_4.f90:  New test.
	* gfortran.dg/eoshift_bounds_1.f90:  New test.
	* gfortran.dg/maxloc_bounds_4.f90:  Correct typo in error message.
	* gfortran.dg/maxloc_bounds_5.f90:  Correct typo in error message.
	* gfortran.dg/maxloc_bounds_7.f90:  Correct typo in error message.

From-SVN: r149792

5 files changed, 65 insertions, 105 deletions

diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4
index 22b6185..49a4f73 100644
--- a/libgfortran/m4/cshift1.m4
+++ b/libgfortran/m4/cshift1.m4
@@ -99,6 +99,17 @@ cshift1 (gfc_array_char * const restrict ret,
 	  GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
         }
     }
+  else if (unlikely (compile_options.bounds_check))
+    {
+      bounds_equal_extents ((array_t *) ret, (array_t *) array,
+				 "return value", "CSHIFT");
+    }
+
+  if (unlikely (compile_options.bounds_check))
+    {
+      bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
+      			      "SHIFT argument", "CSHIFT");
+    }
 
   if (arraysize == 0)
     return;
diff --git a/libgfortran/m4/eoshift1.m4 b/libgfortran/m4/eoshift1.m4
index 831277c..be9b100 100644
--- a/libgfortran/m4/eoshift1.m4
+++ b/libgfortran/m4/eoshift1.m4
@@ -63,6 +63,7 @@ eoshift1 (gfc_array_char * const restrict ret,
   index_type len;
   index_type n;
   index_type size;
+  index_type arraysize;
   int which;
   'atype_name` sh;
   'atype_name` delta;
@@ -83,11 +84,12 @@ eoshift1 (gfc_array_char * const restrict ret,
   extent[0] = 1;
   count[0] = 0;
 
+  arraysize = size0 ((array_t *) array);
   if (ret->data == NULL)
     {
       int i;
 
-      ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+      ret->data = internal_malloc_size (size * arraysize);
       ret->offset = 0;
       ret->dtype = array->dtype;
       for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@@ -105,13 +107,27 @@ eoshift1 (gfc_array_char * const restrict ret,
 	  GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
 
         }
+      if (arraysize > 0)
+	ret->data = internal_malloc_size (size * arraysize);
+      else
+	ret->data = internal_malloc_size (1);
+
     }
-  else
+  else if (unlikely (compile_options.bounds_check))
     {
-      if (size0 ((array_t *) ret) == 0)
-	return;
+      bounds_equal_extents ((array_t *) ret, (array_t *) array,
+				 "return value", "EOSHIFT");
     }
 
+  if (unlikely (compile_options.bounds_check))
+    {
+      bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
+      			      "SHIFT argument", "EOSHIFT");
+    }
+
+  if (arraysize == 0)
+    return;
+
   n = 0;
   for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++)
     {
diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4
index e6b2959..6fa3bd2 100644
--- a/libgfortran/m4/eoshift3.m4
+++ b/libgfortran/m4/eoshift3.m4
@@ -67,6 +67,7 @@ eoshift3 (gfc_array_char * const restrict ret,
   index_type len;
   index_type n;
   index_type size;
+  index_type arraysize;
   int which;
   'atype_name` sh;
   'atype_name` delta;
@@ -77,6 +78,7 @@ eoshift3 (gfc_array_char * const restrict ret,
   soffset = 0;
   roffset = 0;
 
+  arraysize = size0 ((array_t *) array);
   size = GFC_DESCRIPTOR_SIZE(array);
 
   if (pwhich)
@@ -88,7 +90,7 @@ eoshift3 (gfc_array_char * const restrict ret,
     {
       int i;
 
-      ret->data = internal_malloc_size (size * size0 ((array_t *)array));
+      ret->data = internal_malloc_size (size * arraysize);
       ret->offset = 0;
       ret->dtype = array->dtype;
       for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
@@ -106,13 +108,26 @@ eoshift3 (gfc_array_char * const restrict ret,
 	  GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
 
         }
+      if (arraysize > 0)
+	ret->data = internal_malloc_size (size * arraysize);
+      else
+	ret->data = internal_malloc_size (1);
+
     }
-  else
+  else if (unlikely (compile_options.bounds_check))
+    {
+      bounds_equal_extents ((array_t *) ret, (array_t *) array,
+				 "return value", "EOSHIFT");
+    }
+
+  if (unlikely (compile_options.bounds_check))
     {
-      if (size0 ((array_t *) ret) == 0)
-	return;
+      bounds_reduced_extents ((array_t *) h, (array_t *) array, which,
+      			      "SHIFT argument", "EOSHIFT");
     }
 
+  if (arraysize == 0)
+    return;
 
   extent[0] = 1;
   count[0] = 0;
diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4
index 0960d22..d86d298 100644
--- a/libgfortran/m4/iforeach.m4
+++ b/libgfortran/m4/iforeach.m4
@@ -35,21 +35,8 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
   else
     {
       if (unlikely (compile_options.bounds_check))
-	{
-	  int ret_rank;
-	  index_type ret_extent;
-
-	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
-	  if (ret_rank != 1)
-	    runtime_error ("rank of return array in u_name intrinsic"
-			   " should be 1, is %ld", (long int) ret_rank);
-
-	  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
-	  if (ret_extent != rank)
-	    runtime_error ("Incorrect extent in return value of"
-			   " u_name intrnisic: is %ld, should be %ld",
-			   (long int) ret_extent, (long int) rank);
-	}
+        bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+	                        "u_name");
     }
 
   dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
@@ -150,38 +137,11 @@ void
     {
       if (unlikely (compile_options.bounds_check))
 	{
-	  int ret_rank, mask_rank;
-	  index_type ret_extent;
-	  int n;
-	  index_type array_extent, mask_extent;
-
-	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
-	  if (ret_rank != 1)
-	    runtime_error ("rank of return array in u_name intrinsic"
-			   " should be 1, is %ld", (long int) ret_rank);
-
-	  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
-	  if (ret_extent != rank)
-	    runtime_error ("Incorrect extent in return value of"
-			   " u_name intrnisic: is %ld, should be %ld",
-			   (long int) ret_extent, (long int) rank);
-	
-	  mask_rank = GFC_DESCRIPTOR_RANK (mask);
-	  if (rank != mask_rank)
-	    runtime_error ("rank of MASK argument in u_name intrnisic"
-	                   "should be %ld, is %ld", (long int) rank,
-			   (long int) mask_rank);
 
-	  for (n=0; n<rank; n++)
-	    {
-	      array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
-	      mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
-	      if (array_extent != mask_extent)
-		runtime_error ("Incorrect extent in MASK argument of"
-			       " u_name intrinsic in dimension %ld:"
-			       " is %ld, should be %ld", (long int) n + 1,
-			       (long int) mask_extent, (long int) array_extent);
-	    }
+	  bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+				  "u_name");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+				  "MASK argument", "u_name");
 	}
     }
 
@@ -303,22 +263,10 @@ void
       retarray->offset = 0;
       retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
     }
-  else
+  else if (unlikely (compile_options.bounds_check))
     {
-      if (unlikely (compile_options.bounds_check))
-	{
-	  int ret_rank;
-	  index_type ret_extent;
-
-	  ret_rank = GFC_DESCRIPTOR_RANK (retarray);
-	  if (ret_rank != 1)
-	    runtime_error ("rank of return array in u_name intrinsic"
-			   " should be 1, is %ld", (long int) ret_rank);
-
-	  ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
-	    if (ret_extent != rank)
-	      runtime_error ("dimension of return array incorrect");
-	}
+       bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+			       "u_name");
     }
 
   dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4
index 6785eb3..66b1d98 100644
--- a/libgfortran/m4/ifunction.m4
+++ b/libgfortran/m4/ifunction.m4
@@ -107,19 +107,8 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray,
 		       (long int) rank);
 
       if (unlikely (compile_options.bounds_check))
-	{
-	  for (n=0; n < rank; n++)
-	    {
-	      index_type ret_extent;
-
-	      ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
-	      if (extent[n] != ret_extent)
-		runtime_error ("Incorrect extent in return value of"
-			       " u_name intrinsic in dimension %ld:"
-			       " is %ld, should be %ld", (long int) n + 1,
-			       (long int) ret_extent, (long int) extent[n]);
-	    }
-	}
+	bounds_ifunction_return ((array_t *) retarray, extent,
+				 "return value", "u_name");
     }
 
   for (n = 0; n < rank; n++)
@@ -294,29 +283,10 @@ void
 
       if (unlikely (compile_options.bounds_check))
 	{
-	  for (n=0; n < rank; n++)
-	    {
-	      index_type ret_extent;
-
-	      ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
-	      if (extent[n] != ret_extent)
-		runtime_error ("Incorrect extent in return value of"
-			       " u_name intrinsic in dimension %ld:"
-			       " is %ld, should be %ld", (long int) n + 1,
-			       (long int) ret_extent, (long int) extent[n]);
-	    }
-          for (n=0; n<= rank; n++)
-            {
-              index_type mask_extent, array_extent;
-
-	      array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
-	      mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
-	      if (array_extent != mask_extent)
-		runtime_error ("Incorrect extent in MASK argument of"
-			       " u_name intrinsic in dimension %ld:"
-			       " is %ld, should be %ld", (long int) n + 1,
-			       (long int) mask_extent, (long int) array_extent);
-	    }
+	  bounds_ifunction_return ((array_t *) retarray, extent,
+				   "return value", "u_name");
+	  bounds_equal_extents ((array_t *) mask, (array_t *) array,
+	  			"MASK argument", "u_name");
 	}
     }