This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, libfortran] Bounds checking for spread
- From: Thomas Koenig <tkoenig at netcologne dot de>
- To: fortran at gcc dot gnu dot org
- Cc: gcc-patches at gcc dot gnu dot org
- Date: Tue, 14 Oct 2008 19:43:24 +0200
- Subject: [patch, libfortran] Bounds checking for spread
Hello world,
this patch completes bounds checking for spread. Regression-tested
on i686-pc-linux-gnu. Regression-testing actually found a bug in the
reshape_order_*.f90 test cases, so there :-)
I won't have time to fix all array bounds issues with the array
intrinsics for 4.4 as I had originally planned, but at least things are
better than they were with 4.3.
OK for trunk?
Thomas
2008-10-12 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/34670
* intrinsics/reshape_generic.c: Add bounds checking.
* m4/reshape.m4: Likewise.
* generated/reshape_c10.c: Regenerated.
* generated/reshape_c16.c: Regenerated.
* generated/reshape_c4.c: Regenerated.
* generated/reshape_c8.c: Regenerated.
* generated/reshape_i16.c: Regenerated.
* generated/reshape_i4.c: Regenerated.
* generated/reshape_i8.c: Regenerated.
* generated/reshape_r10.c: Regenerated.
* generated/reshape_r16.c: Regenerated.
* generated/reshape_r4.c: Regenerated.
* generated/reshape_r8.c: Regenerated.
* generated/spread_r4.c: Regenerated.
2008-10-12 Thomas Koenig <tkoenig@gcc.gnu.org>
PR libfortran/34670
* gfortran.dg/reshape_3.f90: New test.
* gfortran.dg/reshape_4.f90: New test.
* gfortran.dg/reshape_order_1.f90: Use correct shape.
* gfortran.dg/reshape_order_2.f90: Likewise.
* gfortran.dg/reshape_order_3.f90: Likewise.
* gfortran.dg/reshape_order_4.f90: Likewise.
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Incorrect size in SOURCE argument to RESHAPE intrinsic" }
program main
integer(kind=1), allocatable :: a(:)
integer(kind=1), allocatable :: b(:,:)
allocate(a(4))
allocate(b(3,2))
b = reshape(a,(/3,2/))
end program main
! { dg-output "Fortran runtime error: Incorrect size in SOURCE argument to RESHAPE intrinsic: is 4, should be 6" }
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Incorrect extent in return value of RESHAPE intrinsic in dimension 1" }
program main
real, allocatable :: a(:)
real, allocatable :: b(:,:)
allocate(a(4))
allocate(b(3,2))
b = reshape(a,(/2,2/))
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return value of RESHAPE intrinsic in dimension 1: is 3, should be 2" }
Index: libgfortran/intrinsics/reshape_generic.c
===================================================================
--- libgfortran/intrinsics/reshape_generic.c (revision 141047)
+++ libgfortran/intrinsics/reshape_generic.c (working copy)
@@ -110,6 +110,27 @@ reshape_internal (parray *ret, parray *s
if (unlikely (compile_options.bounds_check))
{
+ index_type ret_extent, source_extent;
+
+ rs = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ rs *= shape_data[n];
+ ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ if (ret_extent != shape_data[n])
+ runtime_error("Incorrect extent in return value of RESHAPE"
+ " intrinsic in dimension %ld: is %ld,"
+ " should be %ld", (long int) n+1,
+ (long int) ret_extent, (long int) shape_data[n]);
+ }
+
+ source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+ if (rs != source_extent)
+ runtime_error("Incorrect size in SOURCE argument to RESHAPE"
+ " intrinsic: is %ld, should be %ld",
+ (long int) source_extent, (long int) rs);
+
if (order)
{
int seen[GFC_MAX_DIMENSIONS];
Index: libgfortran/m4/reshape.m4
===================================================================
--- libgfortran/m4/reshape.m4 (revision 141047)
+++ libgfortran/m4/reshape.m4 (working copy)
@@ -125,6 +125,27 @@ reshape_'rtype_ccode` ('rtype` * const r
if (unlikely (compile_options.bounds_check))
{
+ index_type ret_extent, source_extent;
+
+ rs = 1;
+ for (n = 0; n < rdim; n++)
+ {
+ rs *= shape_data[n];
+ ret_extent = ret->dim[n].ubound + 1 - ret->dim[n].lbound;
+ if (ret_extent != shape_data[n])
+ runtime_error("Incorrect extent in return value of RESHAPE"
+ " intrinsic in dimension %ld: is %ld,"
+ " should be %ld", (long int) n+1,
+ (long int) ret_extent, (long int) shape_data[n]);
+ }
+
+ source_extent = source->dim[0].ubound + 1 - source->dim[0].lbound;
+
+ if (rs != source_extent)
+ runtime_error("Incorrect size in SOURCE argument to RESHAPE"
+ " intrinsic: is %ld, should be %ld",
+ (long int) source_extent, (long int) rs);
+
if (order)
{
int seen[GFC_MAX_DIMENSIONS];
Index: gcc/testsuite/gfortran.dg/reshape_order_2.f90
===================================================================
--- gcc/testsuite/gfortran.dg/reshape_order_2.f90 (revision 141047)
+++ gcc/testsuite/gfortran.dg/reshape_order_2.f90 (working copy)
@@ -4,7 +4,7 @@
program main
implicit none
integer(kind=1), dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
- integer, dimension(2) :: shape1 = (/ 2, 5/)
+ integer, dimension(2) :: shape1 = (/ 2, 3/)
integer(kind=1), dimension(2) :: pad1 = (/ 0, 0/)
character(len=200) :: l1, l2
integer :: i1, i2
Index: gcc/testsuite/gfortran.dg/reshape_order_4.f90
===================================================================
--- gcc/testsuite/gfortran.dg/reshape_order_4.f90 (revision 141047)
+++ gcc/testsuite/gfortran.dg/reshape_order_4.f90 (working copy)
@@ -4,7 +4,7 @@
program main
implicit none
integer(kind=4), dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
- integer, dimension(2) :: shape1 = (/ 2, 5/)
+ integer, dimension(2) :: shape1 = (/ 2, 3/)
integer(kind=4), dimension(2) :: pad1 = (/ 0, 0/)
character(len=200) :: l1, l2
integer :: i1, i2
Index: gcc/testsuite/gfortran.dg/reshape_order_1.f90
===================================================================
--- gcc/testsuite/gfortran.dg/reshape_order_1.f90 (revision 141047)
+++ gcc/testsuite/gfortran.dg/reshape_order_1.f90 (working copy)
@@ -4,7 +4,7 @@
program main
implicit none
integer(kind=1), dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
- integer, dimension(2) :: shape1 = (/ 2, 5/)
+ integer, dimension(2) :: shape1 = (/ 2, 3/)
integer(kind=1), dimension(2) :: pad1 = (/ 0, 0/)
character(len=200) :: l1, l2
integer :: i1, i2
Index: gcc/testsuite/gfortran.dg/reshape_order_3.f90
===================================================================
--- gcc/testsuite/gfortran.dg/reshape_order_3.f90 (revision 141047)
+++ gcc/testsuite/gfortran.dg/reshape_order_3.f90 (working copy)
@@ -4,7 +4,7 @@
program main
implicit none
integer(kind=4), dimension(6) :: source1 = (/ 1, 2, 3, 4, 5, 6 /)
- integer, dimension(2) :: shape1 = (/ 2, 5/)
+ integer, dimension(2) :: shape1 = (/ 2, 3/)
integer(kind=4), dimension(2) :: pad1 = (/ 0, 0/)
character(len=200) :: l1, l2
integer :: i1, i2