aboutsummaryrefslogtreecommitdiff
path: root/libgfortran/generated
diff options
context:
space:
mode:
authorThomas Koenig <tkoenig@gcc.gnu.org>2008-01-11 20:21:05 +0000
committerThomas Koenig <tkoenig@gcc.gnu.org>2008-01-11 20:21:05 +0000
commitfd6590f8c8ca86225f6154636029937cd424dbec (patch)
treeae68d60081c905e627e5ae07599bc9c994f7a5fc /libgfortran/generated
parent15af420d4e77e10803ccf00045a6105e9e55e96d (diff)
downloadgcc-fd6590f8c8ca86225f6154636029937cd424dbec.zip
gcc-fd6590f8c8ca86225f6154636029937cd424dbec.tar.gz
gcc-fd6590f8c8ca86225f6154636029937cd424dbec.tar.bz2
re PR libfortran/34670 (bounds checking for array intrinsics)
2008-01-11 Thomas Koenig <tkoenig@gcc.gnu.org> PR libfortran/34670 * m4/iparm.m4 (upcase): New macro (copied from the m4 manual). (u_name): New macro for the upper case name of the intrinsic. * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Add bounds checking and rank check, depending on compile_options.bounds_check. (`m'name`'rtype_qual`_'atype_code): Likewise. (`s'name`'rtype_qual`_'atype_code): Likewise. * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): Add bounds checking and rank check, depending on compile_options.bounds_check. (`m'name`'rtype_qual`_'atype_code): Likewise. (`s'name`'rtype_qual`_'atype_code): Likewise. * generated/all_l16.c: Regenerated. * generated/all_l4.c: Regenerated. * generated/all_l8.c: Regenerated. * generated/any_l16.c: Regenerated. * generated/any_l4.c: Regenerated. * generated/any_l8.c: Regenerated. * generated/count_16_l16.c: Regenerated. * generated/count_16_l4.c: Regenerated. * generated/count_16_l8.c: Regenerated. * generated/count_4_l16.c: Regenerated. * generated/count_4_l4.c: Regenerated. * generated/count_4_l8.c: Regenerated. * generated/count_8_l16.c: Regenerated. * generated/count_8_l4.c: Regenerated. * generated/count_8_l8.c: Regenerated. * generated/maxloc0_16_i1.c: Regenerated. * generated/maxloc0_16_i16.c: Regenerated. * generated/maxloc0_16_i2.c: Regenerated. * generated/maxloc0_16_i4.c: Regenerated. * generated/maxloc0_16_i8.c: Regenerated. * generated/maxloc0_16_r10.c: Regenerated. * generated/maxloc0_16_r16.c: Regenerated. * generated/maxloc0_16_r4.c: Regenerated. * generated/maxloc0_16_r8.c: Regenerated. * generated/maxloc0_4_i1.c: Regenerated. * generated/maxloc0_4_i16.c: Regenerated. * generated/maxloc0_4_i2.c: Regenerated. * generated/maxloc0_4_i4.c: Regenerated. * generated/maxloc0_4_i8.c: Regenerated. * generated/maxloc0_4_r10.c: Regenerated. * generated/maxloc0_4_r16.c: Regenerated. * generated/maxloc0_4_r4.c: Regenerated. * generated/maxloc0_4_r8.c: Regenerated. * generated/maxloc0_8_i1.c: Regenerated. * generated/maxloc0_8_i16.c: Regenerated. * generated/maxloc0_8_i2.c: Regenerated. * generated/maxloc0_8_i4.c: Regenerated. * generated/maxloc0_8_i8.c: Regenerated. * generated/maxloc0_8_r10.c: Regenerated. * generated/maxloc0_8_r16.c: Regenerated. * generated/maxloc0_8_r4.c: Regenerated. * generated/maxloc0_8_r8.c: Regenerated. * generated/maxloc1_16_i1.c: Regenerated. * generated/maxloc1_16_i16.c: Regenerated. * generated/maxloc1_16_i2.c: Regenerated. * generated/maxloc1_16_i4.c: Regenerated. * generated/maxloc1_16_i8.c: Regenerated. * generated/maxloc1_16_r10.c: Regenerated. * generated/maxloc1_16_r16.c: Regenerated. * generated/maxloc1_16_r4.c: Regenerated. * generated/maxloc1_16_r8.c: Regenerated. * generated/maxloc1_4_i1.c: Regenerated. * generated/maxloc1_4_i16.c: Regenerated. * generated/maxloc1_4_i2.c: Regenerated. * generated/maxloc1_4_i4.c: Regenerated. * generated/maxloc1_4_i8.c: Regenerated. * generated/maxloc1_4_r10.c: Regenerated. * generated/maxloc1_4_r16.c: Regenerated. * generated/maxloc1_4_r4.c: Regenerated. * generated/maxloc1_4_r8.c: Regenerated. * generated/maxloc1_8_i1.c: Regenerated. * generated/maxloc1_8_i16.c: Regenerated. * generated/maxloc1_8_i2.c: Regenerated. * generated/maxloc1_8_i4.c: Regenerated. * generated/maxloc1_8_i8.c: Regenerated. * generated/maxloc1_8_r10.c: Regenerated. * generated/maxloc1_8_r16.c: Regenerated. * generated/maxloc1_8_r4.c: Regenerated. * generated/maxloc1_8_r8.c: Regenerated. * generated/maxval_i1.c: Regenerated. * generated/maxval_i16.c: Regenerated. * generated/maxval_i2.c: Regenerated. * generated/maxval_i4.c: Regenerated. * generated/maxval_i8.c: Regenerated. * generated/maxval_r10.c: Regenerated. * generated/maxval_r16.c: Regenerated. * generated/maxval_r4.c: Regenerated. * generated/maxval_r8.c: Regenerated. * generated/minloc0_16_i1.c: Regenerated. * generated/minloc0_16_i16.c: Regenerated. * generated/minloc0_16_i2.c: Regenerated. * generated/minloc0_16_i4.c: Regenerated. * generated/minloc0_16_i8.c: Regenerated. * generated/minloc0_16_r10.c: Regenerated. * generated/minloc0_16_r16.c: Regenerated. * generated/minloc0_16_r4.c: Regenerated. * generated/minloc0_16_r8.c: Regenerated. * generated/minloc0_4_i1.c: Regenerated. * generated/minloc0_4_i16.c: Regenerated. * generated/minloc0_4_i2.c: Regenerated. * generated/minloc0_4_i4.c: Regenerated. * generated/minloc0_4_i8.c: Regenerated. * generated/minloc0_4_r10.c: Regenerated. * generated/minloc0_4_r16.c: Regenerated. * generated/minloc0_4_r4.c: Regenerated. * generated/minloc0_4_r8.c: Regenerated. * generated/minloc0_8_i1.c: Regenerated. * generated/minloc0_8_i16.c: Regenerated. * generated/minloc0_8_i2.c: Regenerated. * generated/minloc0_8_i4.c: Regenerated. * generated/minloc0_8_i8.c: Regenerated. * generated/minloc0_8_r10.c: Regenerated. * generated/minloc0_8_r16.c: Regenerated. * generated/minloc0_8_r4.c: Regenerated. * generated/minloc0_8_r8.c: Regenerated. * generated/minloc1_16_i1.c: Regenerated. * generated/minloc1_16_i16.c: Regenerated. * generated/minloc1_16_i2.c: Regenerated. * generated/minloc1_16_i4.c: Regenerated. * generated/minloc1_16_i8.c: Regenerated. * generated/minloc1_16_r10.c: Regenerated. * generated/minloc1_16_r16.c: Regenerated. * generated/minloc1_16_r4.c: Regenerated. * generated/minloc1_16_r8.c: Regenerated. * generated/minloc1_4_i1.c: Regenerated. * generated/minloc1_4_i16.c: Regenerated. * generated/minloc1_4_i2.c: Regenerated. * generated/minloc1_4_i4.c: Regenerated. * generated/minloc1_4_i8.c: Regenerated. * generated/minloc1_4_r10.c: Regenerated. * generated/minloc1_4_r16.c: Regenerated. * generated/minloc1_4_r4.c: Regenerated. * generated/minloc1_4_r8.c: Regenerated. * generated/minloc1_8_i1.c: Regenerated. * generated/minloc1_8_i16.c: Regenerated. * generated/minloc1_8_i2.c: Regenerated. * generated/minloc1_8_i4.c: Regenerated. * generated/minloc1_8_i8.c: Regenerated. * generated/minloc1_8_r10.c: Regenerated. * generated/minloc1_8_r16.c: Regenerated. * generated/minloc1_8_r4.c: Regenerated. * generated/minloc1_8_r8.c: Regenerated. * generated/minval_i1.c: Regenerated. * generated/minval_i16.c: Regenerated. * generated/minval_i2.c: Regenerated. * generated/minval_i4.c: Regenerated. * generated/minval_i8.c: Regenerated. * generated/minval_r10.c: Regenerated. * generated/minval_r16.c: Regenerated. * generated/minval_r4.c: Regenerated. * generated/minval_r8.c: Regenerated. * generated/product_c10.c: Regenerated. * generated/product_c16.c: Regenerated. * generated/product_c4.c: Regenerated. * generated/product_c8.c: Regenerated. * generated/product_i1.c: Regenerated. * generated/product_i16.c: Regenerated. * generated/product_i2.c: Regenerated. * generated/product_i4.c: Regenerated. * generated/product_i8.c: Regenerated. * generated/product_r10.c: Regenerated. * generated/product_r16.c: Regenerated. * generated/product_r4.c: Regenerated. * generated/product_r8.c: Regenerated. * generated/sum_c10.c: Regenerated. * generated/sum_c16.c: Regenerated. * generated/sum_c4.c: Regenerated. * generated/sum_c8.c: Regenerated. * generated/sum_i1.c: Regenerated. * generated/sum_i16.c: Regenerated. * generated/sum_i2.c: Regenerated. * generated/sum_i4.c: Regenerated. * generated/sum_i8.c: Regenerated. * generated/sum_r10.c: Regenerated. * generated/sum_r16.c: Regenerated. * generated/sum_r4.c: Regenerated. * generated/sum_r8.c: Regenerated. 2008-01-11 Thomas Koenig <tkoenig@gcc.gnu.org> PR libfortran/34670 * all_bounds_1.f90: New test case. * maxloc_bounds_1.f90: New test case. * maxloc_bounds_2.f90: New test case. * maxloc_bounds_3.f90: New test case. * maxloc_bounds_4.f90: New test case. * maxloc_bounds_5.f90: New test case. * maxloc_bounds_6.f90: New test case. * maxloc_bounds_7.f90: New test case. * maxloc_bounds_8.f90: New test case. From-SVN: r131473
Diffstat (limited to 'libgfortran/generated')
-rw-r--r--libgfortran/generated/all_l16.c20
-rw-r--r--libgfortran/generated/all_l4.c20
-rw-r--r--libgfortran/generated/all_l8.c20
-rw-r--r--libgfortran/generated/any_l16.c20
-rw-r--r--libgfortran/generated/any_l4.c20
-rw-r--r--libgfortran/generated/any_l8.c20
-rw-r--r--libgfortran/generated/count_16_l16.c20
-rw-r--r--libgfortran/generated/count_16_l4.c20
-rw-r--r--libgfortran/generated/count_16_l8.c20
-rw-r--r--libgfortran/generated/count_4_l16.c20
-rw-r--r--libgfortran/generated/count_4_l4.c20
-rw-r--r--libgfortran/generated/count_4_l8.c20
-rw-r--r--libgfortran/generated/count_8_l16.c20
-rw-r--r--libgfortran/generated/count_8_l4.c20
-rw-r--r--libgfortran/generated/count_8_l8.c20
-rw-r--r--libgfortran/generated/maxloc0_16_i1.c77
-rw-r--r--libgfortran/generated/maxloc0_16_i16.c77
-rw-r--r--libgfortran/generated/maxloc0_16_i2.c77
-rw-r--r--libgfortran/generated/maxloc0_16_i4.c77
-rw-r--r--libgfortran/generated/maxloc0_16_i8.c77
-rw-r--r--libgfortran/generated/maxloc0_16_r10.c77
-rw-r--r--libgfortran/generated/maxloc0_16_r16.c77
-rw-r--r--libgfortran/generated/maxloc0_16_r4.c77
-rw-r--r--libgfortran/generated/maxloc0_16_r8.c77
-rw-r--r--libgfortran/generated/maxloc0_4_i1.c77
-rw-r--r--libgfortran/generated/maxloc0_4_i16.c77
-rw-r--r--libgfortran/generated/maxloc0_4_i2.c77
-rw-r--r--libgfortran/generated/maxloc0_4_i4.c77
-rw-r--r--libgfortran/generated/maxloc0_4_i8.c77
-rw-r--r--libgfortran/generated/maxloc0_4_r10.c77
-rw-r--r--libgfortran/generated/maxloc0_4_r16.c77
-rw-r--r--libgfortran/generated/maxloc0_4_r4.c77
-rw-r--r--libgfortran/generated/maxloc0_4_r8.c77
-rw-r--r--libgfortran/generated/maxloc0_8_i1.c77
-rw-r--r--libgfortran/generated/maxloc0_8_i16.c77
-rw-r--r--libgfortran/generated/maxloc0_8_i2.c77
-rw-r--r--libgfortran/generated/maxloc0_8_i4.c77
-rw-r--r--libgfortran/generated/maxloc0_8_i8.c77
-rw-r--r--libgfortran/generated/maxloc0_8_r10.c77
-rw-r--r--libgfortran/generated/maxloc0_8_r16.c77
-rw-r--r--libgfortran/generated/maxloc0_8_r4.c77
-rw-r--r--libgfortran/generated/maxloc0_8_r8.c77
-rw-r--r--libgfortran/generated/maxloc1_16_i1.c68
-rw-r--r--libgfortran/generated/maxloc1_16_i16.c68
-rw-r--r--libgfortran/generated/maxloc1_16_i2.c68
-rw-r--r--libgfortran/generated/maxloc1_16_i4.c68
-rw-r--r--libgfortran/generated/maxloc1_16_i8.c68
-rw-r--r--libgfortran/generated/maxloc1_16_r10.c68
-rw-r--r--libgfortran/generated/maxloc1_16_r16.c68
-rw-r--r--libgfortran/generated/maxloc1_16_r4.c68
-rw-r--r--libgfortran/generated/maxloc1_16_r8.c68
-rw-r--r--libgfortran/generated/maxloc1_4_i1.c68
-rw-r--r--libgfortran/generated/maxloc1_4_i16.c68
-rw-r--r--libgfortran/generated/maxloc1_4_i2.c68
-rw-r--r--libgfortran/generated/maxloc1_4_i4.c68
-rw-r--r--libgfortran/generated/maxloc1_4_i8.c68
-rw-r--r--libgfortran/generated/maxloc1_4_r10.c68
-rw-r--r--libgfortran/generated/maxloc1_4_r16.c68
-rw-r--r--libgfortran/generated/maxloc1_4_r4.c68
-rw-r--r--libgfortran/generated/maxloc1_4_r8.c68
-rw-r--r--libgfortran/generated/maxloc1_8_i1.c68
-rw-r--r--libgfortran/generated/maxloc1_8_i16.c68
-rw-r--r--libgfortran/generated/maxloc1_8_i2.c68
-rw-r--r--libgfortran/generated/maxloc1_8_i4.c68
-rw-r--r--libgfortran/generated/maxloc1_8_i8.c68
-rw-r--r--libgfortran/generated/maxloc1_8_r10.c68
-rw-r--r--libgfortran/generated/maxloc1_8_r16.c68
-rw-r--r--libgfortran/generated/maxloc1_8_r4.c68
-rw-r--r--libgfortran/generated/maxloc1_8_r8.c68
-rw-r--r--libgfortran/generated/maxval_i1.c68
-rw-r--r--libgfortran/generated/maxval_i16.c68
-rw-r--r--libgfortran/generated/maxval_i2.c68
-rw-r--r--libgfortran/generated/maxval_i4.c68
-rw-r--r--libgfortran/generated/maxval_i8.c68
-rw-r--r--libgfortran/generated/maxval_r10.c68
-rw-r--r--libgfortran/generated/maxval_r16.c68
-rw-r--r--libgfortran/generated/maxval_r4.c68
-rw-r--r--libgfortran/generated/maxval_r8.c68
-rw-r--r--libgfortran/generated/minloc0_16_i1.c77
-rw-r--r--libgfortran/generated/minloc0_16_i16.c77
-rw-r--r--libgfortran/generated/minloc0_16_i2.c77
-rw-r--r--libgfortran/generated/minloc0_16_i4.c77
-rw-r--r--libgfortran/generated/minloc0_16_i8.c77
-rw-r--r--libgfortran/generated/minloc0_16_r10.c77
-rw-r--r--libgfortran/generated/minloc0_16_r16.c77
-rw-r--r--libgfortran/generated/minloc0_16_r4.c77
-rw-r--r--libgfortran/generated/minloc0_16_r8.c77
-rw-r--r--libgfortran/generated/minloc0_4_i1.c77
-rw-r--r--libgfortran/generated/minloc0_4_i16.c77
-rw-r--r--libgfortran/generated/minloc0_4_i2.c77
-rw-r--r--libgfortran/generated/minloc0_4_i4.c77
-rw-r--r--libgfortran/generated/minloc0_4_i8.c77
-rw-r--r--libgfortran/generated/minloc0_4_r10.c77
-rw-r--r--libgfortran/generated/minloc0_4_r16.c77
-rw-r--r--libgfortran/generated/minloc0_4_r4.c77
-rw-r--r--libgfortran/generated/minloc0_4_r8.c77
-rw-r--r--libgfortran/generated/minloc0_8_i1.c77
-rw-r--r--libgfortran/generated/minloc0_8_i16.c77
-rw-r--r--libgfortran/generated/minloc0_8_i2.c77
-rw-r--r--libgfortran/generated/minloc0_8_i4.c77
-rw-r--r--libgfortran/generated/minloc0_8_i8.c77
-rw-r--r--libgfortran/generated/minloc0_8_r10.c77
-rw-r--r--libgfortran/generated/minloc0_8_r16.c77
-rw-r--r--libgfortran/generated/minloc0_8_r4.c77
-rw-r--r--libgfortran/generated/minloc0_8_r8.c77
-rw-r--r--libgfortran/generated/minloc1_16_i1.c68
-rw-r--r--libgfortran/generated/minloc1_16_i16.c68
-rw-r--r--libgfortran/generated/minloc1_16_i2.c68
-rw-r--r--libgfortran/generated/minloc1_16_i4.c68
-rw-r--r--libgfortran/generated/minloc1_16_i8.c68
-rw-r--r--libgfortran/generated/minloc1_16_r10.c68
-rw-r--r--libgfortran/generated/minloc1_16_r16.c68
-rw-r--r--libgfortran/generated/minloc1_16_r4.c68
-rw-r--r--libgfortran/generated/minloc1_16_r8.c68
-rw-r--r--libgfortran/generated/minloc1_4_i1.c68
-rw-r--r--libgfortran/generated/minloc1_4_i16.c68
-rw-r--r--libgfortran/generated/minloc1_4_i2.c68
-rw-r--r--libgfortran/generated/minloc1_4_i4.c68
-rw-r--r--libgfortran/generated/minloc1_4_i8.c68
-rw-r--r--libgfortran/generated/minloc1_4_r10.c68
-rw-r--r--libgfortran/generated/minloc1_4_r16.c68
-rw-r--r--libgfortran/generated/minloc1_4_r4.c68
-rw-r--r--libgfortran/generated/minloc1_4_r8.c68
-rw-r--r--libgfortran/generated/minloc1_8_i1.c68
-rw-r--r--libgfortran/generated/minloc1_8_i16.c68
-rw-r--r--libgfortran/generated/minloc1_8_i2.c68
-rw-r--r--libgfortran/generated/minloc1_8_i4.c68
-rw-r--r--libgfortran/generated/minloc1_8_i8.c68
-rw-r--r--libgfortran/generated/minloc1_8_r10.c68
-rw-r--r--libgfortran/generated/minloc1_8_r16.c68
-rw-r--r--libgfortran/generated/minloc1_8_r4.c68
-rw-r--r--libgfortran/generated/minloc1_8_r8.c68
-rw-r--r--libgfortran/generated/minval_i1.c68
-rw-r--r--libgfortran/generated/minval_i16.c68
-rw-r--r--libgfortran/generated/minval_i2.c68
-rw-r--r--libgfortran/generated/minval_i4.c68
-rw-r--r--libgfortran/generated/minval_i8.c68
-rw-r--r--libgfortran/generated/minval_r10.c68
-rw-r--r--libgfortran/generated/minval_r16.c68
-rw-r--r--libgfortran/generated/minval_r4.c68
-rw-r--r--libgfortran/generated/minval_r8.c68
-rw-r--r--libgfortran/generated/product_c10.c68
-rw-r--r--libgfortran/generated/product_c16.c68
-rw-r--r--libgfortran/generated/product_c4.c68
-rw-r--r--libgfortran/generated/product_c8.c68
-rw-r--r--libgfortran/generated/product_i1.c68
-rw-r--r--libgfortran/generated/product_i16.c68
-rw-r--r--libgfortran/generated/product_i2.c68
-rw-r--r--libgfortran/generated/product_i4.c68
-rw-r--r--libgfortran/generated/product_i8.c68
-rw-r--r--libgfortran/generated/product_r10.c68
-rw-r--r--libgfortran/generated/product_r16.c68
-rw-r--r--libgfortran/generated/product_r4.c68
-rw-r--r--libgfortran/generated/product_r8.c68
-rw-r--r--libgfortran/generated/sum_c10.c68
-rw-r--r--libgfortran/generated/sum_c16.c68
-rw-r--r--libgfortran/generated/sum_c4.c68
-rw-r--r--libgfortran/generated/sum_c8.c68
-rw-r--r--libgfortran/generated/sum_i1.c68
-rw-r--r--libgfortran/generated/sum_i16.c68
-rw-r--r--libgfortran/generated/sum_i2.c68
-rw-r--r--libgfortran/generated/sum_i4.c68
-rw-r--r--libgfortran/generated/sum_i8.c68
-rw-r--r--libgfortran/generated/sum_r10.c68
-rw-r--r--libgfortran/generated/sum_r16.c68
-rw-r--r--libgfortran/generated/sum_r4.c68
-rw-r--r--libgfortran/generated/sum_r8.c68
167 files changed, 9665 insertions, 1457 deletions
diff --git a/libgfortran/generated/all_l16.c b/libgfortran/generated/all_l16.c
index 1179f9c..2cc81ce 100644
--- a/libgfortran/generated/all_l16.c
+++ b/libgfortran/generated/all_l16.c
@@ -115,7 +115,25 @@ all_l16 (gfc_array_l16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " ALL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " ALL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/all_l4.c b/libgfortran/generated/all_l4.c
index 11b9b9f..12f9efb 100644
--- a/libgfortran/generated/all_l4.c
+++ b/libgfortran/generated/all_l4.c
@@ -115,7 +115,25 @@ all_l4 (gfc_array_l4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " ALL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " ALL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/all_l8.c b/libgfortran/generated/all_l8.c
index 93d00c2..c9fa809 100644
--- a/libgfortran/generated/all_l8.c
+++ b/libgfortran/generated/all_l8.c
@@ -115,7 +115,25 @@ all_l8 (gfc_array_l8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " ALL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " ALL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/any_l16.c b/libgfortran/generated/any_l16.c
index 1ca5584..1ba59ed 100644
--- a/libgfortran/generated/any_l16.c
+++ b/libgfortran/generated/any_l16.c
@@ -115,7 +115,25 @@ any_l16 (gfc_array_l16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " ANY intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " ANY intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/any_l4.c b/libgfortran/generated/any_l4.c
index b17d273..83116eb 100644
--- a/libgfortran/generated/any_l4.c
+++ b/libgfortran/generated/any_l4.c
@@ -115,7 +115,25 @@ any_l4 (gfc_array_l4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " ANY intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " ANY intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/any_l8.c b/libgfortran/generated/any_l8.c
index 6c50bef..a85e6e8 100644
--- a/libgfortran/generated/any_l8.c
+++ b/libgfortran/generated/any_l8.c
@@ -115,7 +115,25 @@ any_l8 (gfc_array_l8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " ANY intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " ANY intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/count_16_l16.c b/libgfortran/generated/count_16_l16.c
index cc9b470..351eb8a 100644
--- a/libgfortran/generated/count_16_l16.c
+++ b/libgfortran/generated/count_16_l16.c
@@ -115,7 +115,25 @@ count_16_l16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " COUNT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " COUNT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/count_16_l4.c b/libgfortran/generated/count_16_l4.c
index 72d61ae..9f849d8 100644
--- a/libgfortran/generated/count_16_l4.c
+++ b/libgfortran/generated/count_16_l4.c
@@ -115,7 +115,25 @@ count_16_l4 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " COUNT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " COUNT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/count_16_l8.c b/libgfortran/generated/count_16_l8.c
index 9275f7e..90659da 100644
--- a/libgfortran/generated/count_16_l8.c
+++ b/libgfortran/generated/count_16_l8.c
@@ -115,7 +115,25 @@ count_16_l8 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " COUNT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " COUNT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/count_4_l16.c b/libgfortran/generated/count_4_l16.c
index d111855..c3b3daa 100644
--- a/libgfortran/generated/count_4_l16.c
+++ b/libgfortran/generated/count_4_l16.c
@@ -115,7 +115,25 @@ count_4_l16 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " COUNT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " COUNT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/count_4_l4.c b/libgfortran/generated/count_4_l4.c
index de1f386..3bfcf17 100644
--- a/libgfortran/generated/count_4_l4.c
+++ b/libgfortran/generated/count_4_l4.c
@@ -115,7 +115,25 @@ count_4_l4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " COUNT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " COUNT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/count_4_l8.c b/libgfortran/generated/count_4_l8.c
index e3a80a4..7debda7 100644
--- a/libgfortran/generated/count_4_l8.c
+++ b/libgfortran/generated/count_4_l8.c
@@ -115,7 +115,25 @@ count_4_l8 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " COUNT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " COUNT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/count_8_l16.c b/libgfortran/generated/count_8_l16.c
index 9f3d245..815b79a 100644
--- a/libgfortran/generated/count_8_l16.c
+++ b/libgfortran/generated/count_8_l16.c
@@ -115,7 +115,25 @@ count_8_l16 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " COUNT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " COUNT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/count_8_l4.c b/libgfortran/generated/count_8_l4.c
index adbf309..84401de 100644
--- a/libgfortran/generated/count_8_l4.c
+++ b/libgfortran/generated/count_8_l4.c
@@ -115,7 +115,25 @@ count_8_l4 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " COUNT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " COUNT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/count_8_l8.c b/libgfortran/generated/count_8_l8.c
index 927c7ae..fd26280 100644
--- a/libgfortran/generated/count_8_l8.c
+++ b/libgfortran/generated/count_8_l8.c
@@ -115,7 +115,25 @@ count_8_l8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " COUNT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " COUNT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
diff --git a/libgfortran/generated/maxloc0_16_i1.c b/libgfortran/generated/maxloc0_16_i1.c
index dd05af10..3cd6554 100644
--- a/libgfortran/generated/maxloc0_16_i1.c
+++ b/libgfortran/generated/maxloc0_16_i1.c
@@ -69,11 +69,22 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_16_i16.c b/libgfortran/generated/maxloc0_16_i16.c
index 2a68c54..9bfec04 100644
--- a/libgfortran/generated/maxloc0_16_i16.c
+++ b/libgfortran/generated/maxloc0_16_i16.c
@@ -69,11 +69,22 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_16_i2.c b/libgfortran/generated/maxloc0_16_i2.c
index 093170a..b57e78f 100644
--- a/libgfortran/generated/maxloc0_16_i2.c
+++ b/libgfortran/generated/maxloc0_16_i2.c
@@ -69,11 +69,22 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_16_i4.c b/libgfortran/generated/maxloc0_16_i4.c
index d166829..2e123b6 100644
--- a/libgfortran/generated/maxloc0_16_i4.c
+++ b/libgfortran/generated/maxloc0_16_i4.c
@@ -69,11 +69,22 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_16_i8.c b/libgfortran/generated/maxloc0_16_i8.c
index e7cc152..cd141a6 100644
--- a/libgfortran/generated/maxloc0_16_i8.c
+++ b/libgfortran/generated/maxloc0_16_i8.c
@@ -69,11 +69,22 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_16_r10.c b/libgfortran/generated/maxloc0_16_r10.c
index 5bb8ef1..8426d3a 100644
--- a/libgfortran/generated/maxloc0_16_r10.c
+++ b/libgfortran/generated/maxloc0_16_r10.c
@@ -69,11 +69,22 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_16_r16.c b/libgfortran/generated/maxloc0_16_r16.c
index 0b30629..3244452 100644
--- a/libgfortran/generated/maxloc0_16_r16.c
+++ b/libgfortran/generated/maxloc0_16_r16.c
@@ -69,11 +69,22 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_16_r4.c b/libgfortran/generated/maxloc0_16_r4.c
index 7a0b156..8057063 100644
--- a/libgfortran/generated/maxloc0_16_r4.c
+++ b/libgfortran/generated/maxloc0_16_r4.c
@@ -69,11 +69,22 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_16_r8.c b/libgfortran/generated/maxloc0_16_r8.c
index e29f80c..6c12815 100644
--- a/libgfortran/generated/maxloc0_16_r8.c
+++ b/libgfortran/generated/maxloc0_16_r8.c
@@ -69,11 +69,22 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_4_i1.c b/libgfortran/generated/maxloc0_4_i1.c
index 673b7cf..42c865a 100644
--- a/libgfortran/generated/maxloc0_4_i1.c
+++ b/libgfortran/generated/maxloc0_4_i1.c
@@ -69,11 +69,22 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_4_i16.c b/libgfortran/generated/maxloc0_4_i16.c
index 533b682..938ceba 100644
--- a/libgfortran/generated/maxloc0_4_i16.c
+++ b/libgfortran/generated/maxloc0_4_i16.c
@@ -69,11 +69,22 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_4_i2.c b/libgfortran/generated/maxloc0_4_i2.c
index 43b6e15..809d9382 100644
--- a/libgfortran/generated/maxloc0_4_i2.c
+++ b/libgfortran/generated/maxloc0_4_i2.c
@@ -69,11 +69,22 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_4_i4.c b/libgfortran/generated/maxloc0_4_i4.c
index 57241ff..5108cbe 100644
--- a/libgfortran/generated/maxloc0_4_i4.c
+++ b/libgfortran/generated/maxloc0_4_i4.c
@@ -69,11 +69,22 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_4_i8.c b/libgfortran/generated/maxloc0_4_i8.c
index c7f7f36..987b424 100644
--- a/libgfortran/generated/maxloc0_4_i8.c
+++ b/libgfortran/generated/maxloc0_4_i8.c
@@ -69,11 +69,22 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_4_r10.c b/libgfortran/generated/maxloc0_4_r10.c
index 694b621..b3101bd 100644
--- a/libgfortran/generated/maxloc0_4_r10.c
+++ b/libgfortran/generated/maxloc0_4_r10.c
@@ -69,11 +69,22 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_4_r16.c b/libgfortran/generated/maxloc0_4_r16.c
index e3c093a..9b1e527 100644
--- a/libgfortran/generated/maxloc0_4_r16.c
+++ b/libgfortran/generated/maxloc0_4_r16.c
@@ -69,11 +69,22 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_4_r4.c b/libgfortran/generated/maxloc0_4_r4.c
index a634f31..bf4692c 100644
--- a/libgfortran/generated/maxloc0_4_r4.c
+++ b/libgfortran/generated/maxloc0_4_r4.c
@@ -69,11 +69,22 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_4_r8.c b/libgfortran/generated/maxloc0_4_r8.c
index 737de14..774a673 100644
--- a/libgfortran/generated/maxloc0_4_r8.c
+++ b/libgfortran/generated/maxloc0_4_r8.c
@@ -69,11 +69,22 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_8_i1.c b/libgfortran/generated/maxloc0_8_i1.c
index c1aa00e..38890b7 100644
--- a/libgfortran/generated/maxloc0_8_i1.c
+++ b/libgfortran/generated/maxloc0_8_i1.c
@@ -69,11 +69,22 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_8_i16.c b/libgfortran/generated/maxloc0_8_i16.c
index 2966228..be99a8c 100644
--- a/libgfortran/generated/maxloc0_8_i16.c
+++ b/libgfortran/generated/maxloc0_8_i16.c
@@ -69,11 +69,22 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_8_i2.c b/libgfortran/generated/maxloc0_8_i2.c
index 54555a9..02a5f64 100644
--- a/libgfortran/generated/maxloc0_8_i2.c
+++ b/libgfortran/generated/maxloc0_8_i2.c
@@ -69,11 +69,22 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_8_i2 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_8_i4.c b/libgfortran/generated/maxloc0_8_i4.c
index 3a22cb0..dca0b76 100644
--- a/libgfortran/generated/maxloc0_8_i4.c
+++ b/libgfortran/generated/maxloc0_8_i4.c
@@ -69,11 +69,22 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_8_i8.c b/libgfortran/generated/maxloc0_8_i8.c
index a756905..d11ba26 100644
--- a/libgfortran/generated/maxloc0_8_i8.c
+++ b/libgfortran/generated/maxloc0_8_i8.c
@@ -69,11 +69,22 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_8_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_8_r10.c b/libgfortran/generated/maxloc0_8_r10.c
index 706bd53..898f1f5 100644
--- a/libgfortran/generated/maxloc0_8_r10.c
+++ b/libgfortran/generated/maxloc0_8_r10.c
@@ -69,11 +69,22 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_8_r16.c b/libgfortran/generated/maxloc0_8_r16.c
index b849d50..6dec78a 100644
--- a/libgfortran/generated/maxloc0_8_r16.c
+++ b/libgfortran/generated/maxloc0_8_r16.c
@@ -69,11 +69,22 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_8_r16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_8_r4.c b/libgfortran/generated/maxloc0_8_r4.c
index 745f295..345dbe1 100644
--- a/libgfortran/generated/maxloc0_8_r4.c
+++ b/libgfortran/generated/maxloc0_8_r4.c
@@ -69,11 +69,22 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_8_r4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc0_8_r8.c b/libgfortran/generated/maxloc0_8_r8.c
index 4441887..bf7020e 100644
--- a/libgfortran/generated/maxloc0_8_r8.c
+++ b/libgfortran/generated/maxloc0_8_r8.c
@@ -69,11 +69,22 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MAXLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ smaxloc0_8_r8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/maxloc1_16_i1.c b/libgfortran/generated/maxloc1_16_i1.c
index 942d92e..477eb70 100644
--- a/libgfortran/generated/maxloc1_16_i1.c
+++ b/libgfortran/generated/maxloc1_16_i1.c
@@ -116,7 +116,25 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_16_i16.c b/libgfortran/generated/maxloc1_16_i16.c
index 0eca916..e4a2c1b 100644
--- a/libgfortran/generated/maxloc1_16_i16.c
+++ b/libgfortran/generated/maxloc1_16_i16.c
@@ -116,7 +116,25 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_16_i2.c b/libgfortran/generated/maxloc1_16_i2.c
index c4fa7b3..f5d7b58 100644
--- a/libgfortran/generated/maxloc1_16_i2.c
+++ b/libgfortran/generated/maxloc1_16_i2.c
@@ -116,7 +116,25 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_16_i4.c b/libgfortran/generated/maxloc1_16_i4.c
index 7747f80..1fbda54 100644
--- a/libgfortran/generated/maxloc1_16_i4.c
+++ b/libgfortran/generated/maxloc1_16_i4.c
@@ -116,7 +116,25 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_16_i8.c b/libgfortran/generated/maxloc1_16_i8.c
index 7fe4b6c..59be84c 100644
--- a/libgfortran/generated/maxloc1_16_i8.c
+++ b/libgfortran/generated/maxloc1_16_i8.c
@@ -116,7 +116,25 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_16_r10.c b/libgfortran/generated/maxloc1_16_r10.c
index 8410240..3a8c8b7 100644
--- a/libgfortran/generated/maxloc1_16_r10.c
+++ b/libgfortran/generated/maxloc1_16_r10.c
@@ -116,7 +116,25 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_16_r16.c b/libgfortran/generated/maxloc1_16_r16.c
index 92543f8..60b9724 100644
--- a/libgfortran/generated/maxloc1_16_r16.c
+++ b/libgfortran/generated/maxloc1_16_r16.c
@@ -116,7 +116,25 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_16_r4.c b/libgfortran/generated/maxloc1_16_r4.c
index be979ad..a36a9d11 100644
--- a/libgfortran/generated/maxloc1_16_r4.c
+++ b/libgfortran/generated/maxloc1_16_r4.c
@@ -116,7 +116,25 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_16_r8.c b/libgfortran/generated/maxloc1_16_r8.c
index 3af2124..9c659c0 100644
--- a/libgfortran/generated/maxloc1_16_r8.c
+++ b/libgfortran/generated/maxloc1_16_r8.c
@@ -116,7 +116,25 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_4_i1.c b/libgfortran/generated/maxloc1_4_i1.c
index b588a86..1d91328 100644
--- a/libgfortran/generated/maxloc1_4_i1.c
+++ b/libgfortran/generated/maxloc1_4_i1.c
@@ -116,7 +116,25 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_4_i16.c b/libgfortran/generated/maxloc1_4_i16.c
index 646cb48..92a08be 100644
--- a/libgfortran/generated/maxloc1_4_i16.c
+++ b/libgfortran/generated/maxloc1_4_i16.c
@@ -116,7 +116,25 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_4_i2.c b/libgfortran/generated/maxloc1_4_i2.c
index 8bc84f8..b03d90a 100644
--- a/libgfortran/generated/maxloc1_4_i2.c
+++ b/libgfortran/generated/maxloc1_4_i2.c
@@ -116,7 +116,25 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_4_i4.c b/libgfortran/generated/maxloc1_4_i4.c
index 51b6261..dc90ec2 100644
--- a/libgfortran/generated/maxloc1_4_i4.c
+++ b/libgfortran/generated/maxloc1_4_i4.c
@@ -116,7 +116,25 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_4_i8.c b/libgfortran/generated/maxloc1_4_i8.c
index 0c52075..78da944 100644
--- a/libgfortran/generated/maxloc1_4_i8.c
+++ b/libgfortran/generated/maxloc1_4_i8.c
@@ -116,7 +116,25 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_4_r10.c b/libgfortran/generated/maxloc1_4_r10.c
index 8354f71..1c83f62 100644
--- a/libgfortran/generated/maxloc1_4_r10.c
+++ b/libgfortran/generated/maxloc1_4_r10.c
@@ -116,7 +116,25 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_4_r16.c b/libgfortran/generated/maxloc1_4_r16.c
index 6ee0c0d..a31d0ac 100644
--- a/libgfortran/generated/maxloc1_4_r16.c
+++ b/libgfortran/generated/maxloc1_4_r16.c
@@ -116,7 +116,25 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_4_r4.c b/libgfortran/generated/maxloc1_4_r4.c
index c045ab5..49d9cd5 100644
--- a/libgfortran/generated/maxloc1_4_r4.c
+++ b/libgfortran/generated/maxloc1_4_r4.c
@@ -116,7 +116,25 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_4_r8.c b/libgfortran/generated/maxloc1_4_r8.c
index baae300..822680a 100644
--- a/libgfortran/generated/maxloc1_4_r8.c
+++ b/libgfortran/generated/maxloc1_4_r8.c
@@ -116,7 +116,25 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_8_i1.c b/libgfortran/generated/maxloc1_8_i1.c
index f09e54a..5c60753 100644
--- a/libgfortran/generated/maxloc1_8_i1.c
+++ b/libgfortran/generated/maxloc1_8_i1.c
@@ -116,7 +116,25 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_8_i16.c b/libgfortran/generated/maxloc1_8_i16.c
index 8a8e9c6..feefc08 100644
--- a/libgfortran/generated/maxloc1_8_i16.c
+++ b/libgfortran/generated/maxloc1_8_i16.c
@@ -116,7 +116,25 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_8_i2.c b/libgfortran/generated/maxloc1_8_i2.c
index 5defc33..8e4868d 100644
--- a/libgfortran/generated/maxloc1_8_i2.c
+++ b/libgfortran/generated/maxloc1_8_i2.c
@@ -116,7 +116,25 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_8_i4.c b/libgfortran/generated/maxloc1_8_i4.c
index 0bd38f1b..cb9d14d 100644
--- a/libgfortran/generated/maxloc1_8_i4.c
+++ b/libgfortran/generated/maxloc1_8_i4.c
@@ -116,7 +116,25 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c
index 56ed65f..8b8f2a9 100644
--- a/libgfortran/generated/maxloc1_8_i8.c
+++ b/libgfortran/generated/maxloc1_8_i8.c
@@ -116,7 +116,25 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_8_r10.c b/libgfortran/generated/maxloc1_8_r10.c
index 0270184..6aa6ec1 100644
--- a/libgfortran/generated/maxloc1_8_r10.c
+++ b/libgfortran/generated/maxloc1_8_r10.c
@@ -116,7 +116,25 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_8_r16.c b/libgfortran/generated/maxloc1_8_r16.c
index 93b0c72..59db207 100644
--- a/libgfortran/generated/maxloc1_8_r16.c
+++ b/libgfortran/generated/maxloc1_8_r16.c
@@ -116,7 +116,25 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_8_r4.c b/libgfortran/generated/maxloc1_8_r4.c
index 3c9104e..3640a5d 100644
--- a/libgfortran/generated/maxloc1_8_r4.c
+++ b/libgfortran/generated/maxloc1_8_r4.c
@@ -116,7 +116,25 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxloc1_8_r8.c b/libgfortran/generated/maxloc1_8_r8.c
index abb2767..93c7c78 100644
--- a/libgfortran/generated/maxloc1_8_r8.c
+++ b/libgfortran/generated/maxloc1_8_r8.c
@@ -116,7 +116,25 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxval_i1.c b/libgfortran/generated/maxval_i1.c
index 163e200..5158e2a 100644
--- a/libgfortran/generated/maxval_i1.c
+++ b/libgfortran/generated/maxval_i1.c
@@ -115,7 +115,25 @@ maxval_i1 (gfc_array_i1 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxval_i16.c b/libgfortran/generated/maxval_i16.c
index f48efb8..a10c8fa 100644
--- a/libgfortran/generated/maxval_i16.c
+++ b/libgfortran/generated/maxval_i16.c
@@ -115,7 +115,25 @@ maxval_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxval_i2.c b/libgfortran/generated/maxval_i2.c
index 9515b99..3819e0e 100644
--- a/libgfortran/generated/maxval_i2.c
+++ b/libgfortran/generated/maxval_i2.c
@@ -115,7 +115,25 @@ maxval_i2 (gfc_array_i2 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxval_i4.c b/libgfortran/generated/maxval_i4.c
index 95ccb1f..1076336 100644
--- a/libgfortran/generated/maxval_i4.c
+++ b/libgfortran/generated/maxval_i4.c
@@ -115,7 +115,25 @@ maxval_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxval_i8.c b/libgfortran/generated/maxval_i8.c
index 7d361a8..f527983 100644
--- a/libgfortran/generated/maxval_i8.c
+++ b/libgfortran/generated/maxval_i8.c
@@ -115,7 +115,25 @@ maxval_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxval_r10.c b/libgfortran/generated/maxval_r10.c
index 3a423ff..fd775c0 100644
--- a/libgfortran/generated/maxval_r10.c
+++ b/libgfortran/generated/maxval_r10.c
@@ -115,7 +115,25 @@ maxval_r10 (gfc_array_r10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxval_r16.c b/libgfortran/generated/maxval_r16.c
index 7ea30a0..671ce14 100644
--- a/libgfortran/generated/maxval_r16.c
+++ b/libgfortran/generated/maxval_r16.c
@@ -115,7 +115,25 @@ maxval_r16 (gfc_array_r16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxval_r4.c b/libgfortran/generated/maxval_r4.c
index 75d6a06..6741422 100644
--- a/libgfortran/generated/maxval_r4.c
+++ b/libgfortran/generated/maxval_r4.c
@@ -115,7 +115,25 @@ maxval_r4 (gfc_array_r4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/maxval_r8.c b/libgfortran/generated/maxval_r8.c
index 54e4209..136ef207 100644
--- a/libgfortran/generated/maxval_r8.c
+++ b/libgfortran/generated/maxval_r8.c
@@ -115,7 +115,25 @@ maxval_r8 (gfc_array_r8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MAXVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MAXVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MAXVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MAXVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc0_16_i1.c b/libgfortran/generated/minloc0_16_i1.c
index bb0fdd9..9529997 100644
--- a/libgfortran/generated/minloc0_16_i1.c
+++ b/libgfortran/generated/minloc0_16_i1.c
@@ -69,11 +69,22 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_16_i1 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_16_i16.c b/libgfortran/generated/minloc0_16_i16.c
index 428340c..667bfd8 100644
--- a/libgfortran/generated/minloc0_16_i16.c
+++ b/libgfortran/generated/minloc0_16_i16.c
@@ -69,11 +69,22 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_16_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_16_i2.c b/libgfortran/generated/minloc0_16_i2.c
index 523b980..a5c4994 100644
--- a/libgfortran/generated/minloc0_16_i2.c
+++ b/libgfortran/generated/minloc0_16_i2.c
@@ -69,11 +69,22 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_16_i2 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_16_i4.c b/libgfortran/generated/minloc0_16_i4.c
index 67062d3..7c9292cd 100644
--- a/libgfortran/generated/minloc0_16_i4.c
+++ b/libgfortran/generated/minloc0_16_i4.c
@@ -69,11 +69,22 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_16_i4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_16_i8.c b/libgfortran/generated/minloc0_16_i8.c
index 2b62a67..022e49c 100644
--- a/libgfortran/generated/minloc0_16_i8.c
+++ b/libgfortran/generated/minloc0_16_i8.c
@@ -69,11 +69,22 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_16_i8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_16_r10.c b/libgfortran/generated/minloc0_16_r10.c
index 1329d30..a99c530 100644
--- a/libgfortran/generated/minloc0_16_r10.c
+++ b/libgfortran/generated/minloc0_16_r10.c
@@ -69,11 +69,22 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_16_r10 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_16_r16.c b/libgfortran/generated/minloc0_16_r16.c
index a50b028..2b2dcaa 100644
--- a/libgfortran/generated/minloc0_16_r16.c
+++ b/libgfortran/generated/minloc0_16_r16.c
@@ -69,11 +69,22 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_16_r16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_16_r4.c b/libgfortran/generated/minloc0_16_r4.c
index d33368f..f265ae4 100644
--- a/libgfortran/generated/minloc0_16_r4.c
+++ b/libgfortran/generated/minloc0_16_r4.c
@@ -69,11 +69,22 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_16_r4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_16_r8.c b/libgfortran/generated/minloc0_16_r8.c
index 37e0b58..59429f2 100644
--- a/libgfortran/generated/minloc0_16_r8.c
+++ b/libgfortran/generated/minloc0_16_r8.c
@@ -69,11 +69,22 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_16_r8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_4_i1.c b/libgfortran/generated/minloc0_4_i1.c
index 18ae10b..24463ea 100644
--- a/libgfortran/generated/minloc0_4_i1.c
+++ b/libgfortran/generated/minloc0_4_i1.c
@@ -69,11 +69,22 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_4_i1 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_4_i16.c b/libgfortran/generated/minloc0_4_i16.c
index 7ca79b1..ddcbc60 100644
--- a/libgfortran/generated/minloc0_4_i16.c
+++ b/libgfortran/generated/minloc0_4_i16.c
@@ -69,11 +69,22 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_4_i16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_4_i2.c b/libgfortran/generated/minloc0_4_i2.c
index c6789d9..60b2c3f 100644
--- a/libgfortran/generated/minloc0_4_i2.c
+++ b/libgfortran/generated/minloc0_4_i2.c
@@ -69,11 +69,22 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_4_i2 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_4_i4.c b/libgfortran/generated/minloc0_4_i4.c
index 13524f1..6431f38 100644
--- a/libgfortran/generated/minloc0_4_i4.c
+++ b/libgfortran/generated/minloc0_4_i4.c
@@ -69,11 +69,22 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_4_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_4_i8.c b/libgfortran/generated/minloc0_4_i8.c
index 9d80fd3..6ffeac5 100644
--- a/libgfortran/generated/minloc0_4_i8.c
+++ b/libgfortran/generated/minloc0_4_i8.c
@@ -69,11 +69,22 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_4_i8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_4_r10.c b/libgfortran/generated/minloc0_4_r10.c
index 58f1805..e4f1002 100644
--- a/libgfortran/generated/minloc0_4_r10.c
+++ b/libgfortran/generated/minloc0_4_r10.c
@@ -69,11 +69,22 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_4_r10 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_4_r16.c b/libgfortran/generated/minloc0_4_r16.c
index 1a1bc03..0f9fb98 100644
--- a/libgfortran/generated/minloc0_4_r16.c
+++ b/libgfortran/generated/minloc0_4_r16.c
@@ -69,11 +69,22 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_4_r16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_4_r4.c b/libgfortran/generated/minloc0_4_r4.c
index 3c312c6..14c63b3 100644
--- a/libgfortran/generated/minloc0_4_r4.c
+++ b/libgfortran/generated/minloc0_4_r4.c
@@ -69,11 +69,22 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_4_r4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_4_r8.c b/libgfortran/generated/minloc0_4_r8.c
index ad3b534..168d0ad 100644
--- a/libgfortran/generated/minloc0_4_r8.c
+++ b/libgfortran/generated/minloc0_4_r8.c
@@ -69,11 +69,22 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_4_r8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_8_i1.c b/libgfortran/generated/minloc0_8_i1.c
index 4aa5f18..6dcafba 100644
--- a/libgfortran/generated/minloc0_8_i1.c
+++ b/libgfortran/generated/minloc0_8_i1.c
@@ -69,11 +69,22 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_8_i1 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_8_i16.c b/libgfortran/generated/minloc0_8_i16.c
index 88adc44..f2afae1 100644
--- a/libgfortran/generated/minloc0_8_i16.c
+++ b/libgfortran/generated/minloc0_8_i16.c
@@ -69,11 +69,22 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_8_i16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_8_i2.c b/libgfortran/generated/minloc0_8_i2.c
index c7e5f13..d0dd137 100644
--- a/libgfortran/generated/minloc0_8_i2.c
+++ b/libgfortran/generated/minloc0_8_i2.c
@@ -69,11 +69,22 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_8_i2 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_8_i4.c b/libgfortran/generated/minloc0_8_i4.c
index 401349e..a4c921a 100644
--- a/libgfortran/generated/minloc0_8_i4.c
+++ b/libgfortran/generated/minloc0_8_i4.c
@@ -69,11 +69,22 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_8_i4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_8_i8.c b/libgfortran/generated/minloc0_8_i8.c
index bc3abca..26aa947 100644
--- a/libgfortran/generated/minloc0_8_i8.c
+++ b/libgfortran/generated/minloc0_8_i8.c
@@ -69,11 +69,22 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_8_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_8_r10.c b/libgfortran/generated/minloc0_8_r10.c
index 90f652e..b1705eb 100644
--- a/libgfortran/generated/minloc0_8_r10.c
+++ b/libgfortran/generated/minloc0_8_r10.c
@@ -69,11 +69,22 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_8_r10 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_8_r16.c b/libgfortran/generated/minloc0_8_r16.c
index 67d5e0c..84b95ba 100644
--- a/libgfortran/generated/minloc0_8_r16.c
+++ b/libgfortran/generated/minloc0_8_r16.c
@@ -69,11 +69,22 @@ minloc0_8_r16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_8_r16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_8_r4.c b/libgfortran/generated/minloc0_8_r4.c
index a542e9d..d7b8d54 100644
--- a/libgfortran/generated/minloc0_8_r4.c
+++ b/libgfortran/generated/minloc0_8_r4.c
@@ -69,11 +69,22 @@ minloc0_8_r4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_8_r4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc0_8_r8.c b/libgfortran/generated/minloc0_8_r8.c
index 98d6a8e..6ac0bfe 100644
--- a/libgfortran/generated/minloc0_8_r8.c
+++ b/libgfortran/generated/minloc0_8_r8.c
@@ -69,11 +69,22 @@ minloc0_8_r8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+ }
}
dstride = retarray->dim[0].stride;
@@ -182,11 +193,40 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
-
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank, mask_rank;
+ index_type ret_extent;
+ int n;
+ index_type array_extent, mask_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrnisic: is %ld, should be %d",
+ (long int) ret_extent, rank);
+
+ mask_rank = GFC_DESCRIPTOR_RANK (mask);
+ if (rank != mask_rank)
+ runtime_error ("rank of MASK argument in MINLOC intrnisic"
+ "should be %d, is %d", rank, mask_rank);
+
+ for (n=0; n<rank; n++)
+ {
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
mask_kind = GFC_DESCRIPTOR_SIZE (mask);
@@ -312,11 +352,20 @@ sminloc0_8_r8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
}
dstride = retarray->dim[0].stride;
diff --git a/libgfortran/generated/minloc1_16_i1.c b/libgfortran/generated/minloc1_16_i1.c
index c029050..c1baf54 100644
--- a/libgfortran/generated/minloc1_16_i1.c
+++ b/libgfortran/generated/minloc1_16_i1.c
@@ -116,7 +116,25 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_16_i1 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_16_i16.c b/libgfortran/generated/minloc1_16_i16.c
index 88f7e0c..db992cb 100644
--- a/libgfortran/generated/minloc1_16_i16.c
+++ b/libgfortran/generated/minloc1_16_i16.c
@@ -116,7 +116,25 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_16_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_16_i2.c b/libgfortran/generated/minloc1_16_i2.c
index 2268b2e..523a4af 100644
--- a/libgfortran/generated/minloc1_16_i2.c
+++ b/libgfortran/generated/minloc1_16_i2.c
@@ -116,7 +116,25 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_16_i2 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_16_i4.c b/libgfortran/generated/minloc1_16_i4.c
index e4a60ac..e8d5fc3 100644
--- a/libgfortran/generated/minloc1_16_i4.c
+++ b/libgfortran/generated/minloc1_16_i4.c
@@ -116,7 +116,25 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_16_i4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_16_i8.c b/libgfortran/generated/minloc1_16_i8.c
index b822298..8c3e4e4 100644
--- a/libgfortran/generated/minloc1_16_i8.c
+++ b/libgfortran/generated/minloc1_16_i8.c
@@ -116,7 +116,25 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_16_i8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_16_r10.c b/libgfortran/generated/minloc1_16_r10.c
index 982a048..7aa89a9 100644
--- a/libgfortran/generated/minloc1_16_r10.c
+++ b/libgfortran/generated/minloc1_16_r10.c
@@ -116,7 +116,25 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_16_r10 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_16_r16.c b/libgfortran/generated/minloc1_16_r16.c
index 1e43b24..5b81445 100644
--- a/libgfortran/generated/minloc1_16_r16.c
+++ b/libgfortran/generated/minloc1_16_r16.c
@@ -116,7 +116,25 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_16_r16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_16_r4.c b/libgfortran/generated/minloc1_16_r4.c
index 7f93dd0..b3c6155 100644
--- a/libgfortran/generated/minloc1_16_r4.c
+++ b/libgfortran/generated/minloc1_16_r4.c
@@ -116,7 +116,25 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_16_r4 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_16_r8.c b/libgfortran/generated/minloc1_16_r8.c
index 96eaa9c..0a4b1b5 100644
--- a/libgfortran/generated/minloc1_16_r8.c
+++ b/libgfortran/generated/minloc1_16_r8.c
@@ -116,7 +116,25 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_16_r8 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_4_i1.c b/libgfortran/generated/minloc1_4_i1.c
index deb70a1..9cebebe 100644
--- a/libgfortran/generated/minloc1_4_i1.c
+++ b/libgfortran/generated/minloc1_4_i1.c
@@ -116,7 +116,25 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_4_i1 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_4_i16.c b/libgfortran/generated/minloc1_4_i16.c
index 8252d18..a984a15 100644
--- a/libgfortran/generated/minloc1_4_i16.c
+++ b/libgfortran/generated/minloc1_4_i16.c
@@ -116,7 +116,25 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_4_i16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_4_i2.c b/libgfortran/generated/minloc1_4_i2.c
index 27768fb..685f979 100644
--- a/libgfortran/generated/minloc1_4_i2.c
+++ b/libgfortran/generated/minloc1_4_i2.c
@@ -116,7 +116,25 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_4_i2 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_4_i4.c b/libgfortran/generated/minloc1_4_i4.c
index 11579c3..f44a631 100644
--- a/libgfortran/generated/minloc1_4_i4.c
+++ b/libgfortran/generated/minloc1_4_i4.c
@@ -116,7 +116,25 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_4_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_4_i8.c b/libgfortran/generated/minloc1_4_i8.c
index cf54b1a..f6858c0 100644
--- a/libgfortran/generated/minloc1_4_i8.c
+++ b/libgfortran/generated/minloc1_4_i8.c
@@ -116,7 +116,25 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_4_i8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_4_r10.c b/libgfortran/generated/minloc1_4_r10.c
index 990d7ea..8e359fe 100644
--- a/libgfortran/generated/minloc1_4_r10.c
+++ b/libgfortran/generated/minloc1_4_r10.c
@@ -116,7 +116,25 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_4_r10 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_4_r16.c b/libgfortran/generated/minloc1_4_r16.c
index a380df2..11cb9c8 100644
--- a/libgfortran/generated/minloc1_4_r16.c
+++ b/libgfortran/generated/minloc1_4_r16.c
@@ -116,7 +116,25 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_4_r16 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_4_r4.c b/libgfortran/generated/minloc1_4_r4.c
index 62e0b2c..31aa1f7 100644
--- a/libgfortran/generated/minloc1_4_r4.c
+++ b/libgfortran/generated/minloc1_4_r4.c
@@ -116,7 +116,25 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_4_r4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_4_r8.c b/libgfortran/generated/minloc1_4_r8.c
index 16b210ff..a7a56b6 100644
--- a/libgfortran/generated/minloc1_4_r8.c
+++ b/libgfortran/generated/minloc1_4_r8.c
@@ -116,7 +116,25 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_4_r8 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_8_i1.c b/libgfortran/generated/minloc1_8_i1.c
index e50acae..1fae32b 100644
--- a/libgfortran/generated/minloc1_8_i1.c
+++ b/libgfortran/generated/minloc1_8_i1.c
@@ -116,7 +116,25 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_8_i1 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_8_i16.c b/libgfortran/generated/minloc1_8_i16.c
index ed20ec7..0d31c94 100644
--- a/libgfortran/generated/minloc1_8_i16.c
+++ b/libgfortran/generated/minloc1_8_i16.c
@@ -116,7 +116,25 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_8_i16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_8_i2.c b/libgfortran/generated/minloc1_8_i2.c
index 743c584..8865575 100644
--- a/libgfortran/generated/minloc1_8_i2.c
+++ b/libgfortran/generated/minloc1_8_i2.c
@@ -116,7 +116,25 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_8_i2 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_8_i4.c b/libgfortran/generated/minloc1_8_i4.c
index 1d64d2c..31ee238 100644
--- a/libgfortran/generated/minloc1_8_i4.c
+++ b/libgfortran/generated/minloc1_8_i4.c
@@ -116,7 +116,25 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_8_i4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_8_i8.c b/libgfortran/generated/minloc1_8_i8.c
index d658451..13577ab 100644
--- a/libgfortran/generated/minloc1_8_i8.c
+++ b/libgfortran/generated/minloc1_8_i8.c
@@ -116,7 +116,25 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_8_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_8_r10.c b/libgfortran/generated/minloc1_8_r10.c
index 1b6888e..726aa1c 100644
--- a/libgfortran/generated/minloc1_8_r10.c
+++ b/libgfortran/generated/minloc1_8_r10.c
@@ -116,7 +116,25 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_8_r10 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_8_r16.c b/libgfortran/generated/minloc1_8_r16.c
index e59b187..aaf9797 100644
--- a/libgfortran/generated/minloc1_8_r16.c
+++ b/libgfortran/generated/minloc1_8_r16.c
@@ -116,7 +116,25 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_8_r16 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_8_r4.c b/libgfortran/generated/minloc1_8_r4.c
index d7d69e5..6b0bcec 100644
--- a/libgfortran/generated/minloc1_8_r4.c
+++ b/libgfortran/generated/minloc1_8_r4.c
@@ -116,7 +116,25 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_8_r4 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minloc1_8_r8.c b/libgfortran/generated/minloc1_8_r8.c
index 03f88bd..8a8d266 100644
--- a/libgfortran/generated/minloc1_8_r8.c
+++ b/libgfortran/generated/minloc1_8_r8.c
@@ -116,7 +116,25 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINLOC intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -293,7 +311,35 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINLOC intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINLOC intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -406,13 +452,21 @@ sminloc1_8_r8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINLOC intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minval_i1.c b/libgfortran/generated/minval_i1.c
index 37e0b16..ef31ba0 100644
--- a/libgfortran/generated/minval_i1.c
+++ b/libgfortran/generated/minval_i1.c
@@ -115,7 +115,25 @@ minval_i1 (gfc_array_i1 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mminval_i1 (gfc_array_i1 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ sminval_i1 (gfc_array_i1 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minval_i16.c b/libgfortran/generated/minval_i16.c
index fdac287..8d7bf50 100644
--- a/libgfortran/generated/minval_i16.c
+++ b/libgfortran/generated/minval_i16.c
@@ -115,7 +115,25 @@ minval_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mminval_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ sminval_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minval_i2.c b/libgfortran/generated/minval_i2.c
index 5934973..c3d63f6 100644
--- a/libgfortran/generated/minval_i2.c
+++ b/libgfortran/generated/minval_i2.c
@@ -115,7 +115,25 @@ minval_i2 (gfc_array_i2 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mminval_i2 (gfc_array_i2 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ sminval_i2 (gfc_array_i2 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minval_i4.c b/libgfortran/generated/minval_i4.c
index 660f0e7..48ea446 100644
--- a/libgfortran/generated/minval_i4.c
+++ b/libgfortran/generated/minval_i4.c
@@ -115,7 +115,25 @@ minval_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mminval_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ sminval_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minval_i8.c b/libgfortran/generated/minval_i8.c
index d7d4c09..cd2100a 100644
--- a/libgfortran/generated/minval_i8.c
+++ b/libgfortran/generated/minval_i8.c
@@ -115,7 +115,25 @@ minval_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mminval_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ sminval_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minval_r10.c b/libgfortran/generated/minval_r10.c
index 4769f0c..10d0302 100644
--- a/libgfortran/generated/minval_r10.c
+++ b/libgfortran/generated/minval_r10.c
@@ -115,7 +115,25 @@ minval_r10 (gfc_array_r10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mminval_r10 (gfc_array_r10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ sminval_r10 (gfc_array_r10 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minval_r16.c b/libgfortran/generated/minval_r16.c
index 6754072..da6e796 100644
--- a/libgfortran/generated/minval_r16.c
+++ b/libgfortran/generated/minval_r16.c
@@ -115,7 +115,25 @@ minval_r16 (gfc_array_r16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mminval_r16 (gfc_array_r16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ sminval_r16 (gfc_array_r16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minval_r4.c b/libgfortran/generated/minval_r4.c
index ab7d909..745889a 100644
--- a/libgfortran/generated/minval_r4.c
+++ b/libgfortran/generated/minval_r4.c
@@ -115,7 +115,25 @@ minval_r4 (gfc_array_r4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mminval_r4 (gfc_array_r4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ sminval_r4 (gfc_array_r4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/minval_r8.c b/libgfortran/generated/minval_r8.c
index 53c7e44..1b0fec0 100644
--- a/libgfortran/generated/minval_r8.c
+++ b/libgfortran/generated/minval_r8.c
@@ -115,7 +115,25 @@ minval_r8 (gfc_array_r8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " MINVAL intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -287,7 +305,35 @@ mminval_r8 (gfc_array_r8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in MINVAL intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " MINVAL intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -395,13 +441,21 @@ sminval_r8 (gfc_array_r8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in MINVAL intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_c10.c b/libgfortran/generated/product_c10.c
index 34d4e94..701835f 100644
--- a/libgfortran/generated/product_c10.c
+++ b/libgfortran/generated/product_c10.c
@@ -115,7 +115,25 @@ product_c10 (gfc_array_c10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_c10 (gfc_array_c10 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_c16.c b/libgfortran/generated/product_c16.c
index e95dbac..1d58a76 100644
--- a/libgfortran/generated/product_c16.c
+++ b/libgfortran/generated/product_c16.c
@@ -115,7 +115,25 @@ product_c16 (gfc_array_c16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_c16 (gfc_array_c16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c
index 6c17247..3754fcb 100644
--- a/libgfortran/generated/product_c4.c
+++ b/libgfortran/generated/product_c4.c
@@ -115,7 +115,25 @@ product_c4 (gfc_array_c4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_c4 (gfc_array_c4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_c8.c b/libgfortran/generated/product_c8.c
index 5d26d3e..6312451 100644
--- a/libgfortran/generated/product_c8.c
+++ b/libgfortran/generated/product_c8.c
@@ -115,7 +115,25 @@ product_c8 (gfc_array_c8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_c8 (gfc_array_c8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_i1.c b/libgfortran/generated/product_i1.c
index 9926bdc..7003129 100644
--- a/libgfortran/generated/product_i1.c
+++ b/libgfortran/generated/product_i1.c
@@ -115,7 +115,25 @@ product_i1 (gfc_array_i1 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_i1 (gfc_array_i1 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_i16.c b/libgfortran/generated/product_i16.c
index f667a65..3c44808 100644
--- a/libgfortran/generated/product_i16.c
+++ b/libgfortran/generated/product_i16.c
@@ -115,7 +115,25 @@ product_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_i2.c b/libgfortran/generated/product_i2.c
index a862404..ca57d29 100644
--- a/libgfortran/generated/product_i2.c
+++ b/libgfortran/generated/product_i2.c
@@ -115,7 +115,25 @@ product_i2 (gfc_array_i2 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_i2 (gfc_array_i2 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_i4.c b/libgfortran/generated/product_i4.c
index 5a8a337..d31eb6e 100644
--- a/libgfortran/generated/product_i4.c
+++ b/libgfortran/generated/product_i4.c
@@ -115,7 +115,25 @@ product_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_i8.c b/libgfortran/generated/product_i8.c
index 29c1583..8867aae 100644
--- a/libgfortran/generated/product_i8.c
+++ b/libgfortran/generated/product_i8.c
@@ -115,7 +115,25 @@ product_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_r10.c b/libgfortran/generated/product_r10.c
index 63ef48a..235b8a6 100644
--- a/libgfortran/generated/product_r10.c
+++ b/libgfortran/generated/product_r10.c
@@ -115,7 +115,25 @@ product_r10 (gfc_array_r10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_r10 (gfc_array_r10 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_r16.c b/libgfortran/generated/product_r16.c
index bb232c5..2f837e3 100644
--- a/libgfortran/generated/product_r16.c
+++ b/libgfortran/generated/product_r16.c
@@ -115,7 +115,25 @@ product_r16 (gfc_array_r16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_r16 (gfc_array_r16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_r4.c b/libgfortran/generated/product_r4.c
index 6899f34..4e6c3d1 100644
--- a/libgfortran/generated/product_r4.c
+++ b/libgfortran/generated/product_r4.c
@@ -115,7 +115,25 @@ product_r4 (gfc_array_r4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_r4 (gfc_array_r4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/product_r8.c b/libgfortran/generated/product_r8.c
index e2d613f..849d404 100644
--- a/libgfortran/generated/product_r8.c
+++ b/libgfortran/generated/product_r8.c
@@ -115,7 +115,25 @@ product_r8 (gfc_array_r8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " PRODUCT intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in PRODUCT intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " PRODUCT intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in PRODUCT intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_c10.c b/libgfortran/generated/sum_c10.c
index 46106c9..f3da384 100644
--- a/libgfortran/generated/sum_c10.c
+++ b/libgfortran/generated/sum_c10.c
@@ -115,7 +115,25 @@ sum_c10 (gfc_array_c10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_c10 (gfc_array_c10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_c10 (gfc_array_c10 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_c16.c b/libgfortran/generated/sum_c16.c
index 53040b4..df79daf 100644
--- a/libgfortran/generated/sum_c16.c
+++ b/libgfortran/generated/sum_c16.c
@@ -115,7 +115,25 @@ sum_c16 (gfc_array_c16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_c16 (gfc_array_c16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_c16 (gfc_array_c16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c
index 89cc92b..9ef9e83 100644
--- a/libgfortran/generated/sum_c4.c
+++ b/libgfortran/generated/sum_c4.c
@@ -115,7 +115,25 @@ sum_c4 (gfc_array_c4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_c4 (gfc_array_c4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_c4 (gfc_array_c4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_c8.c b/libgfortran/generated/sum_c8.c
index f78105d..a7f7392 100644
--- a/libgfortran/generated/sum_c8.c
+++ b/libgfortran/generated/sum_c8.c
@@ -115,7 +115,25 @@ sum_c8 (gfc_array_c8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_c8 (gfc_array_c8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_c8 (gfc_array_c8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_i1.c b/libgfortran/generated/sum_i1.c
index f20bd87..8740fb7 100644
--- a/libgfortran/generated/sum_i1.c
+++ b/libgfortran/generated/sum_i1.c
@@ -115,7 +115,25 @@ sum_i1 (gfc_array_i1 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_i1 (gfc_array_i1 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_i1 (gfc_array_i1 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_i16.c b/libgfortran/generated/sum_i16.c
index 19c4a71..6500d17 100644
--- a/libgfortran/generated/sum_i16.c
+++ b/libgfortran/generated/sum_i16.c
@@ -115,7 +115,25 @@ sum_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_i16 (gfc_array_i16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_i16 (gfc_array_i16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_i2.c b/libgfortran/generated/sum_i2.c
index 984b23b..10202c3 100644
--- a/libgfortran/generated/sum_i2.c
+++ b/libgfortran/generated/sum_i2.c
@@ -115,7 +115,25 @@ sum_i2 (gfc_array_i2 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_i2 (gfc_array_i2 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_i2 (gfc_array_i2 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_i4.c b/libgfortran/generated/sum_i4.c
index 93569f4..4d0e8a4 100644
--- a/libgfortran/generated/sum_i4.c
+++ b/libgfortran/generated/sum_i4.c
@@ -115,7 +115,25 @@ sum_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_i4 (gfc_array_i4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_i4 (gfc_array_i4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_i8.c b/libgfortran/generated/sum_i8.c
index 67f303c..8b280a8 100644
--- a/libgfortran/generated/sum_i8.c
+++ b/libgfortran/generated/sum_i8.c
@@ -115,7 +115,25 @@ sum_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_i8 (gfc_array_i8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_i8 (gfc_array_i8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_r10.c b/libgfortran/generated/sum_r10.c
index aa260f0..0fd8775 100644
--- a/libgfortran/generated/sum_r10.c
+++ b/libgfortran/generated/sum_r10.c
@@ -115,7 +115,25 @@ sum_r10 (gfc_array_r10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_r10 (gfc_array_r10 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_r10 (gfc_array_r10 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_r16.c b/libgfortran/generated/sum_r16.c
index 286b986..8903b64 100644
--- a/libgfortran/generated/sum_r16.c
+++ b/libgfortran/generated/sum_r16.c
@@ -115,7 +115,25 @@ sum_r16 (gfc_array_r16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_r16 (gfc_array_r16 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_r16 (gfc_array_r16 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_r4.c b/libgfortran/generated/sum_r4.c
index d9ecfd4..1d3f2d0 100644
--- a/libgfortran/generated/sum_r4.c
+++ b/libgfortran/generated/sum_r4.c
@@ -115,7 +115,25 @@ sum_r4 (gfc_array_r4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_r4 (gfc_array_r4 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_r4 (gfc_array_r4 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;
diff --git a/libgfortran/generated/sum_r8.c b/libgfortran/generated/sum_r8.c
index ffa7b87..d049876 100644
--- a/libgfortran/generated/sum_r8.c
+++ b/libgfortran/generated/sum_r8.c
@@ -115,7 +115,25 @@ sum_r8 (gfc_array_r8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in"
+ " SUM intrinsic: is %d, should be %d",
+ GFC_DESCRIPTOR_RANK (retarray), rank);
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -286,7 +304,35 @@ msum_r8 (gfc_array_r8 * const restrict retarray,
else
{
if (rank != GFC_DESCRIPTOR_RANK (retarray))
- runtime_error ("rank of return array incorrect");
+ runtime_error ("rank of return array incorrect in SUM intrinsic");
+
+ if (compile_options.bounds_check)
+ {
+ for (n=0; n < rank; n++)
+ {
+ index_type ret_extent;
+
+ ret_extent = retarray->dim[n].ubound + 1
+ - retarray->dim[n].lbound;
+ if (extent[n] != ret_extent)
+ runtime_error ("Incorrect extent in return value of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) ret_extent, (long int) extent[n]);
+ }
+ for (n=0; n<= rank; n++)
+ {
+ index_type mask_extent, array_extent;
+
+ array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound;
+ mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound;
+ if (array_extent != mask_extent)
+ runtime_error ("Incorrect extent in MASK argument of"
+ " SUM intrinsic in dimension %d:"
+ " is %ld, should be %ld", n + 1,
+ (long int) mask_extent, (long int) array_extent);
+ }
+ }
}
for (n = 0; n < rank; n++)
@@ -394,13 +440,21 @@ ssum_r8 (gfc_array_r8 * const restrict retarray,
}
else
{
- if (GFC_DESCRIPTOR_RANK (retarray) != 1)
- runtime_error ("rank of return array does not equal 1");
+ if (compile_options.bounds_check)
+ {
+ int ret_rank;
+ index_type ret_extent;
- if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+ if (ret_rank != 1)
+ runtime_error ("rank of return array in SUM intrinsic"
+ " should be 1, is %d", ret_rank);
+ ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound;
+ if (ret_extent != rank)
+ runtime_error ("dimension of return array incorrect");
+ }
+ }
dstride = retarray->dim[0].stride;
dest = retarray->data;