From 9ad13e91692eec408fb030c65f947a4065afc7df Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Mon, 7 Jul 2008 19:43:33 +0000 Subject: [PATCH] re PR fortran/36341 (MATMUL: Bounds check missing) 2008-07-07 Thomas Koenig 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 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 --- gcc/testsuite/ChangeLog | 9 ++++ gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 | 16 ++++++++ gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 | 16 ++++++++ gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 | 16 ++++++++ gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 | 16 ++++++++ libgfortran/ChangeLog | 23 +++++++++++ libgfortran/generated/matmul_c10.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_c16.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_c4.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_c8.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_i1.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_i16.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_i2.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_i4.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_i8.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_l16.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_l4.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_l8.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_r10.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_r16.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_r4.c | 41 +++++++++++++++++++ libgfortran/generated/matmul_r8.c | 41 +++++++++++++++++++ libgfortran/m4/matmul.m4 | 41 +++++++++++++++++++ libgfortran/m4/matmull.m4 | 41 +++++++++++++++++++ 24 files changed, 834 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index b212e44c398..143f75db13d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2008-07-07 Thomas Koenig + + 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 * gcc.dg/torture/pta-ptrarith-1.c: New testcase. diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 new file mode 100644 index 00000000000..429b28c3016 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/matmul_bounds_2.f90 @@ -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" } diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 new file mode 100644 index 00000000000..c5830ded729 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/matmul_bounds_3.f90 @@ -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" } diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 new file mode 100644 index 00000000000..a61bacc1d2b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/matmul_bounds_4.f90 @@ -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" } diff --git a/gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 b/gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 new file mode 100644 index 00000000000..4b20098f50f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/matmul_bounds_5.f90 @@ -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" } diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 18bd7b1189a..c845606c803 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,26 @@ +2008-07-07 Thomas Koenig + + 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 * acinclude.m4 (LIBGFOR_CHECK_GTHR_DEFAULT): Fix configure cache diff --git a/libgfortran/generated/matmul_c10.c b/libgfortran/generated/matmul_c10.c index 08c2044dd8b..0e378626f96 100644 --- a/libgfortran/generated/matmul_c10.c +++ b/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) diff --git a/libgfortran/generated/matmul_c16.c b/libgfortran/generated/matmul_c16.c index 6a2a6390967..34cc51dbd78 100644 --- a/libgfortran/generated/matmul_c16.c +++ b/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) diff --git a/libgfortran/generated/matmul_c4.c b/libgfortran/generated/matmul_c4.c index 6dcf6fea56a..fdfea1df955 100644 --- a/libgfortran/generated/matmul_c4.c +++ b/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) diff --git a/libgfortran/generated/matmul_c8.c b/libgfortran/generated/matmul_c8.c index 8bc619d879f..9d6694922f1 100644 --- a/libgfortran/generated/matmul_c8.c +++ b/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) diff --git a/libgfortran/generated/matmul_i1.c b/libgfortran/generated/matmul_i1.c index ca16ed40b2f..34fd7c51b78 100644 --- a/libgfortran/generated/matmul_i1.c +++ b/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) diff --git a/libgfortran/generated/matmul_i16.c b/libgfortran/generated/matmul_i16.c index 33c62ae4152..0c7c5d8f396 100644 --- a/libgfortran/generated/matmul_i16.c +++ b/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) diff --git a/libgfortran/generated/matmul_i2.c b/libgfortran/generated/matmul_i2.c index e3119acbd41..5d55847edce 100644 --- a/libgfortran/generated/matmul_i2.c +++ b/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) diff --git a/libgfortran/generated/matmul_i4.c b/libgfortran/generated/matmul_i4.c index a1b8c50f051..a80f14940c8 100644 --- a/libgfortran/generated/matmul_i4.c +++ b/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) diff --git a/libgfortran/generated/matmul_i8.c b/libgfortran/generated/matmul_i8.c index eee73ac88f0..91499c793e6 100644 --- a/libgfortran/generated/matmul_i8.c +++ b/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) diff --git a/libgfortran/generated/matmul_l16.c b/libgfortran/generated/matmul_l16.c index b2b86ecfed1..b604edfb2ca 100644 --- a/libgfortran/generated/matmul_l16.c +++ b/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); diff --git a/libgfortran/generated/matmul_l4.c b/libgfortran/generated/matmul_l4.c index 9a6cb1d357d..5aed0fe2ba0 100644 --- a/libgfortran/generated/matmul_l4.c +++ b/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); diff --git a/libgfortran/generated/matmul_l8.c b/libgfortran/generated/matmul_l8.c index 7d4e35e82e3..26baad32136 100644 --- a/libgfortran/generated/matmul_l8.c +++ b/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); diff --git a/libgfortran/generated/matmul_r10.c b/libgfortran/generated/matmul_r10.c index 58dfe75814f..931e2bdc0f0 100644 --- a/libgfortran/generated/matmul_r10.c +++ b/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) diff --git a/libgfortran/generated/matmul_r16.c b/libgfortran/generated/matmul_r16.c index a6a93be91fb..16ec175be0c 100644 --- a/libgfortran/generated/matmul_r16.c +++ b/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) diff --git a/libgfortran/generated/matmul_r4.c b/libgfortran/generated/matmul_r4.c index 1154d41a33f..47d976415d0 100644 --- a/libgfortran/generated/matmul_r4.c +++ b/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) diff --git a/libgfortran/generated/matmul_r8.c b/libgfortran/generated/matmul_r8.c index 7bce2533b41..a359ffd8fd3 100644 --- a/libgfortran/generated/matmul_r8.c +++ b/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) diff --git a/libgfortran/m4/matmul.m4 b/libgfortran/m4/matmul.m4 index 181efa3b654..a43b430c2e3 100644 --- a/libgfortran/m4/matmul.m4 +++ b/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 ` diff --git a/libgfortran/m4/matmull.m4 b/libgfortran/m4/matmull.m4 index 54afa8a238e..800444564f7 100644 --- a/libgfortran/m4/matmull.m4 +++ b/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); -- 2.30.2