This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]