This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[patch, libfortran] Fix PR 36341, run-time part
- 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: Wed, 02 Jul 2008 14:24:02 +0200
- Subject: [patch, libfortran] Fix PR 36341, run-time part
Hello world,
this patch implements the run-time part of the array bounds checking for
matmul.
The number of test cases is a bit large because I wanted to test all
code paths, and you can only check for a single run-time error with
each test :-)
Regression-tested on i686-pc-linux-gnu.
OK for trunk?
Thomas
2008-07-02 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36341
PR fortran/34670
* m4/matmul.m4: Add bounds checking.
* m4/matmull.m4: Likewise.
* generated/matmul_c10.c: Regenerated.
* generated/matmul_c16.c: Regenerated.
* generated/matmul_c4.c: Regenerated.
* generated/matmul_c8.c: Regenerated.
* generated/matmul_i1.c: Regenerated.
* generated/matmul_i16.c: Regenerated.
* generated/matmul_i2.c: Regenerated.
* generated/matmul_i4.c: Regenerated.
* generated/matmul_i8.c: Regenerated.
* generated/matmul_l16.c: Regenerated.
* generated/matmul_l4.c: Regenerated.
* generated/matmul_l8.c: Regenerated.
* generated/matmul_r10.c: Regenerated.
* generated/matmul_r16.c: Regenerated.
* generated/matmul_r4.c: Regenerated.
* generated/matmul_r8.c: Regenerated.
2008-07-02 Thomas Koenig <tkoenig@gcc.gnu.org>
PR fortran/36341
PR fortran/34670
* gfortran.dg/matmul_bounds_2.f90: New test.
* gfortran.dg/matmul_bounds_3.f90: New test.
* gfortran.dg/matmul_bounds_4.f90: New test.
* gfortran.dg/matmul_bounds_5.f90: New test.
Index: /home/ig25/gcc/trunk/libgfortran/m4/matmull.m4
===================================================================
--- /home/ig25/gcc/trunk/libgfortran/m4/matmull.m4 (revision 137216)
+++ /home/ig25/gcc/trunk/libgfortran/m4/matmull.m4 (working copy)
@@ -100,6 +100,47 @@ matmul_'rtype_code` ('rtype` * const res
= internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
abase = a->data;
a_kind = GFC_DESCRIPTOR_SIZE (a);
Index: /home/ig25/gcc/trunk/libgfortran/m4/matmul.m4
===================================================================
--- /home/ig25/gcc/trunk/libgfortran/m4/matmul.m4 (revision 137216)
+++ /home/ig25/gcc/trunk/libgfortran/m4/matmul.m4 (working copy)
@@ -136,6 +136,47 @@ matmul_'rtype_code` ('rtype` * const res
= internal_malloc_size (sizeof ('rtype_name`) * size0 ((array_t *) retarray));
retarray->offset = 0;
}
+ else if (compile_options.bounds_check)
+ {
+ index_type ret_extent, arg_extent;
+
+ if (GFC_DESCRIPTOR_RANK (a) == 1)
+ {
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else if (GFC_DESCRIPTOR_RANK (b) == 1)
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic: is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ else
+ {
+ arg_extent = a->dim[0].ubound + 1 - a->dim[0].lbound;
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 1:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+
+ arg_extent = b->dim[1].ubound + 1 - b->dim[1].lbound;
+ ret_extent = retarray->dim[1].ubound + 1 - retarray->dim[1].lbound;
+ if (arg_extent != ret_extent)
+ runtime_error ("Incorrect extent in return array in"
+ " MATMUL intrinsic for dimension 2:"
+ " is %ld, should be %ld",
+ (long int) ret_extent, (long int) arg_extent);
+ }
+ }
'
sinclude(`matmul_asm_'rtype_code`.m4')dnl
`
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" }
program main
real, dimension(3,2) :: a
real, dimension(2,3) :: b
real, dimension(:,:), allocatable :: ret
allocate (ret(2,2))
a = 1.0
b = 2.3
ret = matmul(b,a) ! This is OK
deallocate(ret)
allocate(ret(3,2))
ret = matmul(a,b) ! This should throw an error.
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 2: is 2, should be 3" }
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 2, should be 3" }
program main
real, dimension(3,2) :: a
real, dimension(2,3) :: b
real, dimension(:,:), allocatable :: ret
allocate (ret(3,3))
a = 1.0
b = 2.3
ret = matmul(a,b) ! This is OK
deallocate(ret)
allocate(ret(2,3))
ret = matmul(a,b) ! This should throw an error.
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic for dimension 1: is 2, should be 3" }
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
program main
real, dimension(3) :: a
real, dimension(3,2) :: b
real, dimension(:), allocatable :: ret
allocate (ret(2))
a = 1.0
b = 2.3
ret = matmul(a,b) ! This is OK
deallocate(ret)
allocate(ret(3))
ret = matmul(a,b) ! This should throw an error.
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
! { dg-do run }
! { dg-options "-fbounds-check" }
! { dg-shouldfail "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }
program main
real, dimension(2,3) :: a
real, dimension(3) :: b
real, dimension(:), allocatable :: ret
allocate (ret(2))
a = 1.0
b = 2.3
ret = matmul(a,b) ! This is OK
deallocate(ret)
allocate(ret(3))
ret = matmul(a,b) ! This should throw an error.
end program main
! { dg-output "Fortran runtime error: Incorrect extent in return array in MATMUL intrinsic: is 3, should be 2" }