diff options
Diffstat (limited to 'libgfortran')
| -rw-r--r-- | libgfortran/ChangeLog | 23 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_c10.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_c16.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_c4.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_c8.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_i1.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_i16.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_i2.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_i4.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_i8.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_l16.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_l4.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_l8.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_r10.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_r16.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_r4.c | 41 | ||||
| -rw-r--r-- | libgfortran/generated/matmul_r8.c | 41 | ||||
| -rw-r--r-- | libgfortran/m4/matmul.m4 | 41 | ||||
| -rw-r--r-- | libgfortran/m4/matmull.m4 | 41 |
19 files changed, 761 insertions, 0 deletions
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 <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 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); |
