2007-09-06 Thomas Koenig <tkoenig@gcc.gnu.org>

	PR fortran/33298
	* intrinsics/spread_generic.c(spread_internal): Enable
	bounds checking by comparing extents if the bounds_check
	option has been set.  If any extent is <=0, return early.

2007-09-06  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/33298
	* spread_zerosize_1.f90:  New test case.
	* spread_bounds_1.f90:  New test case.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@128206 138bc75d-0d04-0410-961f-82ee72b054a4

1 files changed, 59 insertions, 10 deletions

diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c
index 4f34e84cd1c..3752717aa8e 100644
--- a/libgfortran/intrinsics/spread_generic.c
+++ b/libgfortran/intrinsics/spread_generic.c
@@ -110,26 +110,75 @@ spread_internal (gfc_array_char *ret, const gfc_array_char *source,
     }
   else
     {
+      int zero_sized;
+
+      zero_sized = 0;
+
       dim = 0;
       if (GFC_DESCRIPTOR_RANK(ret) != rrank)
 	runtime_error ("rank mismatch in spread()");
 
-      for (n = 0; n < rrank; n++)
+      if (compile_options.bounds_check)
 	{
-	  if (n == *along - 1)
+	  for (n = 0; n < rrank; n++)
 	    {
-	      rdelta = ret->dim[n].stride * size;
+	      index_type ret_extent;
+
+	      ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+	      if (n == *along - 1)
+		{
+		  rdelta = ret->dim[n].stride * size;
+
+		  if (ret_extent != ncopies)
+		    runtime_error("Incorrect extent in return value of SPREAD"
+				  " intrinsic in dimension %d: is %ld,"
+				  " should be %ld", n+1, (long int) ret_extent,
+				  (long int) ncopies);
+		}
+	      else
+		{
+		  count[dim] = 0;
+		  extent[dim] = source->dim[dim].ubound + 1
+		    - source->dim[dim].lbound;
+		  if (ret_extent != extent[dim])
+		    runtime_error("Incorrect extent in return value of SPREAD"
+				  " intrinsic in dimension %d: is %ld,"
+				  " should be %ld", n+1, (long int) ret_extent,
+				  (long int) extent[dim]);
+		    
+		  if (extent[dim] <= 0)
+		    zero_sized = 1;
+		  sstride[dim] = source->dim[dim].stride * size;
+		  rstride[dim] = ret->dim[n].stride * size;
+		  dim++;
+		}
 	    }
-	  else
+	}
+      else
+	{
+	  for (n = 0; n < rrank; n++)
 	    {
-	      count[dim] = 0;
-	      extent[dim] = source->dim[dim].ubound + 1
-		- source->dim[dim].lbound;
-	      sstride[dim] = source->dim[dim].stride * size;
-	      rstride[dim] = ret->dim[n].stride * size;
-	      dim++;
+	      if (n == *along - 1)
+		{
+		  rdelta = ret->dim[n].stride * size;
+		}
+	      else
+		{
+		  count[dim] = 0;
+		  extent[dim] = source->dim[dim].ubound + 1
+		    - source->dim[dim].lbound;
+		  if (extent[dim] <= 0)
+		    zero_sized = 1;
+		  sstride[dim] = source->dim[dim].stride * size;
+		  rstride[dim] = ret->dim[n].stride * size;
+		  dim++;
+		}
 	    }
 	}
+
+      if (zero_sized)
+	return;
+
       if (sstride[0] == 0)
 	sstride[0] = size;
     }