re PR libfortran/33298 (Wrong code for SPREAD on zero-sized arrays)

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.

From-SVN: r128206

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index de450f6..8771b42 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+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.
+
 2007-09-06  Paolo Carlini  <pcarlini@suse.de>
 
        PR c++/32674

diff --git a/gcc/testsuite/gfortran.dg/spread_bounds_1.f90 b/gcc/testsuite/gfortran.dg/spread_bounds_1.f90
new file mode 100644 (file)
index 0000000..7e5bc65
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spread_bounds_1.f90
@@ -0,0 +1,12 @@
+! { dg-do run }
+! { dg-options "-fbounds-check" }
+! { dg-shouldfail "Incorrect extent in return value of SPREAD intrinsic in dimension 2: is 3, should be 2" }
+program main
+  integer :: source(2), target(2,3)
+  data source /1,2/
+  integer :: times
+  times = 2
+  target = spread(source,2,times)
+end program main
+! { dg-output "Fortran runtime error:  Incorrect extent in return value of SPREAD intrinsic in dimension 2: is 3, should be 2"
+

diff --git a/gcc/testsuite/gfortran.dg/spread_zerosize_1.f90 b/gcc/testsuite/gfortran.dg/spread_zerosize_1.f90
new file mode 100644 (file)
index 0000000..98a2848
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/spread_zerosize_1.f90
@@ -0,0 +1,8 @@
+! { dg-do run }
+! PR 33298 - zero-sized arrays for spread were handled
+!            incorrectly.
+
+program main
+  real :: x(0,3), y(0)
+  x = spread(y,2,3)
+end

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index bc3ed64..9fc369e 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+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  David Edelsohn  <edelsohn@gnu.org>
 
        * libgfortran.h: Include config.h first.

diff --git a/libgfortran/intrinsics/spread_generic.c b/libgfortran/intrinsics/spread_generic.c
index 4f34e84..3752717 100644 (file)
--- 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;
     }