This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[patch, libfortran] Fix PR 33298, spread on zero-sized arrays
- From: Thomas Koenig <tkoenig at alice-dsl dot net>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Wed, 05 Sep 2007 23:06:27 +0200
- Subject: [patch, libfortran] Fix PR 33298, spread on zero-sized arrays
:ADDPATCH fortran:
Hello world,
this patch fixes PR 33298, in which zero-sized arrays were
handled incorrectly for spread. While I was at it, I also
added runtime bounds checking. For code without -fbounds-check,
the additional overhead is one if statement (which shouldn't hurt
performance too much).
Regression-tested on i686-pc-linux-gnu. OK for trunk?
Thomas
2007-09-05 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-05 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/33298
* spread_zerosize_1.f90: New test case.
* spread_bounds_1.f90: New test case.
Index: intrinsics/spread_generic.c
===================================================================
--- intrinsics/spread_generic.c (revision 128136)
+++ intrinsics/spread_generic.c (working copy)
@@ -110,26 +110,75 @@ spread_internal (gfc_array_char *ret, co
}
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;
}
! { 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"
! { 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