mirror/gcc
2
0
Fork 0
mirror of git://gcc.gnu.org/git/gcc.git synced 2025-03-22 18:50:55 +08:00
Code Issues Packages Projects Releases Wiki Activity

re PR fortran/36341 (MATMUL: Bounds check missing)

Browse Source 
2008-07-07  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-07  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.

From-SVN: r137594
This commit is contained in:
Thomas Koenig 2008-07-07 19:43:33 +00:00
parent 8432ea8505
commit 9ad13e9169
24 changed files with 834 additions and 0 deletions

9
gcc/testsuite/ChangeLog

@ -1,3 +1,12 @@
2008-07-07 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.
2008-07-07 Richard Guenther <rguenther@suse.de>
* gcc.dg/torture/pta-ptrarith-1.c: New testcase.

16
gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 Normal file

@ -0,0 +1,16 @@
! { 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" }

16
gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 Normal file

@ -0,0 +1,16 @@
! { 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" }

16
gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 Normal file

@ -0,0 +1,16 @@
! { 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" }

16
gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 Normal file

@ -0,0 +1,16 @@
! { 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" }

23
libgfortran/ChangeLog

@ -1,3 +1,26 @@
2008-07-07 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-07 Ralf Wildenhues <Ralf.Wildenhues@gmx.de>
* acinclude.m4 (LIBGFOR_CHECK_GTHR_DEFAULT): Fix configure cache

41
libgfortran/generated/matmul_c10.c

@ -135,6 +135,47 @@ matmul_c10 (gfc_array_c10 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_COMPLEX_10) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_c16.c

@ -135,6 +135,47 @@ matmul_c16 (gfc_array_c16 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_COMPLEX_16) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_c4.c

@ -135,6 +135,47 @@ matmul_c4 (gfc_array_c4 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_COMPLEX_4) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_c8.c

@ -135,6 +135,47 @@ matmul_c8 (gfc_array_c8 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_COMPLEX_8) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_i1.c

@ -135,6 +135,47 @@ matmul_i1 (gfc_array_i1 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_INTEGER_1) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_i16.c

@ -135,6 +135,47 @@ matmul_i16 (gfc_array_i16 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_INTEGER_16) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_i2.c

@ -135,6 +135,47 @@ matmul_i2 (gfc_array_i2 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_INTEGER_2) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_i4.c

@ -135,6 +135,47 @@ matmul_i4 (gfc_array_i4 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_INTEGER_4) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_i8.c

@ -135,6 +135,47 @@ matmul_i8 (gfc_array_i8 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_INTEGER_8) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_l16.c

@ -99,6 +99,47 @@ matmul_l16 (gfc_array_l16 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_LOGICAL_16) * 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);

41
libgfortran/generated/matmul_l4.c

@ -99,6 +99,47 @@ matmul_l4 (gfc_array_l4 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_LOGICAL_4) * 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);

41
libgfortran/generated/matmul_l8.c

@ -99,6 +99,47 @@ matmul_l8 (gfc_array_l8 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_LOGICAL_8) * 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);

41
libgfortran/generated/matmul_r10.c

@ -135,6 +135,47 @@ matmul_r10 (gfc_array_r10 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_REAL_10) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_r16.c

@ -135,6 +135,47 @@ matmul_r16 (gfc_array_r16 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_REAL_16) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_r4.c

@ -135,6 +135,47 @@ matmul_r4 (gfc_array_r4 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_REAL_4) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/generated/matmul_r8.c

@ -135,6 +135,47 @@ matmul_r8 (gfc_array_r8 * const restrict retarray,
= internal_malloc_size (sizeof (GFC_REAL_8) * 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);
}
}
if (GFC_DESCRIPTOR_RANK (retarray) == 1)

41
libgfortran/m4/matmul.m4

@ -136,6 +136,47 @@ matmul_'rtype_code` ('rtype` * const restrict retarray,
= 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
`

41
libgfortran/m4/matmull.m4

@ -100,6 +100,47 @@ matmul_'rtype_code` ('rtype` * const restrict retarray,
= 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);