procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Thomas Koenig 2007-09-06 19:25:30 +00:00
parent 6f6cc094a0
commit 3cc50edcc0
5 changed files with 94 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
gcc/testsuite/ChangeLog
View file

@ -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

12
gcc/testsuite/gfortran.dg/spread_bounds_1.f90 Normal file
View file

@ -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"

8
gcc/testsuite/gfortran.dg/spread_zerosize_1.f90 Normal file
View file

@ -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

7
libgfortran/ChangeLog
View file

@ -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.

73
libgfortran/intrinsics/spread_generic.c
View file

@ -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;
}
else
{
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++;
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
{
for (n = 0; n < rrank; n++)
{
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;
}