From fd6590f8c8ca86225f6154636029937cd424dbec Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Fri, 11 Jan 2008 20:21:05 +0000 Subject: [PATCH] re PR libfortran/34670 (bounds checking for array intrinsics) 2008-01-11 Thomas Koenig 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 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 --- gcc/testsuite/ChangeLog | 13 ++ gcc/testsuite/gfortran.dg/all_bounds_1.f90 | 17 ++ gcc/testsuite/gfortran.dg/maxloc_bounds_1.f90 | 14 ++ gcc/testsuite/gfortran.dg/maxloc_bounds_2.f90 | 16 ++ gcc/testsuite/gfortran.dg/maxloc_bounds_3.f90 | 16 ++ gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 | 23 +++ gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 | 22 +++ gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 | 16 ++ gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 | 22 +++ gcc/testsuite/gfortran.dg/maxloc_bounds_8.f90 | 16 ++ libgfortran/ChangeLog | 183 ++++++++++++++++++ libgfortran/generated/all_l16.c | 20 +- libgfortran/generated/all_l4.c | 20 +- libgfortran/generated/all_l8.c | 20 +- libgfortran/generated/any_l16.c | 20 +- libgfortran/generated/any_l4.c | 20 +- libgfortran/generated/any_l8.c | 20 +- libgfortran/generated/count_16_l16.c | 20 +- libgfortran/generated/count_16_l4.c | 20 +- libgfortran/generated/count_16_l8.c | 20 +- libgfortran/generated/count_4_l16.c | 20 +- libgfortran/generated/count_4_l4.c | 20 +- libgfortran/generated/count_4_l8.c | 20 +- libgfortran/generated/count_8_l16.c | 20 +- libgfortran/generated/count_8_l4.c | 20 +- libgfortran/generated/count_8_l8.c | 20 +- libgfortran/generated/maxloc0_16_i1.c | 77 ++++++-- libgfortran/generated/maxloc0_16_i16.c | 77 ++++++-- libgfortran/generated/maxloc0_16_i2.c | 77 ++++++-- libgfortran/generated/maxloc0_16_i4.c | 77 ++++++-- libgfortran/generated/maxloc0_16_i8.c | 77 ++++++-- libgfortran/generated/maxloc0_16_r10.c | 77 ++++++-- libgfortran/generated/maxloc0_16_r16.c | 77 ++++++-- libgfortran/generated/maxloc0_16_r4.c | 77 ++++++-- libgfortran/generated/maxloc0_16_r8.c | 77 ++++++-- libgfortran/generated/maxloc0_4_i1.c | 77 ++++++-- libgfortran/generated/maxloc0_4_i16.c | 77 ++++++-- libgfortran/generated/maxloc0_4_i2.c | 77 ++++++-- libgfortran/generated/maxloc0_4_i4.c | 77 ++++++-- libgfortran/generated/maxloc0_4_i8.c | 77 ++++++-- libgfortran/generated/maxloc0_4_r10.c | 77 ++++++-- libgfortran/generated/maxloc0_4_r16.c | 77 ++++++-- libgfortran/generated/maxloc0_4_r4.c | 77 ++++++-- libgfortran/generated/maxloc0_4_r8.c | 77 ++++++-- libgfortran/generated/maxloc0_8_i1.c | 77 ++++++-- libgfortran/generated/maxloc0_8_i16.c | 77 ++++++-- libgfortran/generated/maxloc0_8_i2.c | 77 ++++++-- libgfortran/generated/maxloc0_8_i4.c | 77 ++++++-- libgfortran/generated/maxloc0_8_i8.c | 77 ++++++-- libgfortran/generated/maxloc0_8_r10.c | 77 ++++++-- libgfortran/generated/maxloc0_8_r16.c | 77 ++++++-- libgfortran/generated/maxloc0_8_r4.c | 77 ++++++-- libgfortran/generated/maxloc0_8_r8.c | 77 ++++++-- libgfortran/generated/maxloc1_16_i1.c | 68 ++++++- libgfortran/generated/maxloc1_16_i16.c | 68 ++++++- libgfortran/generated/maxloc1_16_i2.c | 68 ++++++- libgfortran/generated/maxloc1_16_i4.c | 68 ++++++- libgfortran/generated/maxloc1_16_i8.c | 68 ++++++- libgfortran/generated/maxloc1_16_r10.c | 68 ++++++- libgfortran/generated/maxloc1_16_r16.c | 68 ++++++- libgfortran/generated/maxloc1_16_r4.c | 68 ++++++- libgfortran/generated/maxloc1_16_r8.c | 68 ++++++- libgfortran/generated/maxloc1_4_i1.c | 68 ++++++- libgfortran/generated/maxloc1_4_i16.c | 68 ++++++- libgfortran/generated/maxloc1_4_i2.c | 68 ++++++- libgfortran/generated/maxloc1_4_i4.c | 68 ++++++- libgfortran/generated/maxloc1_4_i8.c | 68 ++++++- libgfortran/generated/maxloc1_4_r10.c | 68 ++++++- libgfortran/generated/maxloc1_4_r16.c | 68 ++++++- libgfortran/generated/maxloc1_4_r4.c | 68 ++++++- libgfortran/generated/maxloc1_4_r8.c | 68 ++++++- libgfortran/generated/maxloc1_8_i1.c | 68 ++++++- libgfortran/generated/maxloc1_8_i16.c | 68 ++++++- libgfortran/generated/maxloc1_8_i2.c | 68 ++++++- libgfortran/generated/maxloc1_8_i4.c | 68 ++++++- libgfortran/generated/maxloc1_8_i8.c | 68 ++++++- libgfortran/generated/maxloc1_8_r10.c | 68 ++++++- libgfortran/generated/maxloc1_8_r16.c | 68 ++++++- libgfortran/generated/maxloc1_8_r4.c | 68 ++++++- libgfortran/generated/maxloc1_8_r8.c | 68 ++++++- libgfortran/generated/maxval_i1.c | 68 ++++++- libgfortran/generated/maxval_i16.c | 68 ++++++- libgfortran/generated/maxval_i2.c | 68 ++++++- libgfortran/generated/maxval_i4.c | 68 ++++++- libgfortran/generated/maxval_i8.c | 68 ++++++- libgfortran/generated/maxval_r10.c | 68 ++++++- libgfortran/generated/maxval_r16.c | 68 ++++++- libgfortran/generated/maxval_r4.c | 68 ++++++- libgfortran/generated/maxval_r8.c | 68 ++++++- libgfortran/generated/minloc0_16_i1.c | 77 ++++++-- libgfortran/generated/minloc0_16_i16.c | 77 ++++++-- libgfortran/generated/minloc0_16_i2.c | 77 ++++++-- libgfortran/generated/minloc0_16_i4.c | 77 ++++++-- libgfortran/generated/minloc0_16_i8.c | 77 ++++++-- libgfortran/generated/minloc0_16_r10.c | 77 ++++++-- libgfortran/generated/minloc0_16_r16.c | 77 ++++++-- libgfortran/generated/minloc0_16_r4.c | 77 ++++++-- libgfortran/generated/minloc0_16_r8.c | 77 ++++++-- libgfortran/generated/minloc0_4_i1.c | 77 ++++++-- libgfortran/generated/minloc0_4_i16.c | 77 ++++++-- libgfortran/generated/minloc0_4_i2.c | 77 ++++++-- libgfortran/generated/minloc0_4_i4.c | 77 ++++++-- libgfortran/generated/minloc0_4_i8.c | 77 ++++++-- libgfortran/generated/minloc0_4_r10.c | 77 ++++++-- libgfortran/generated/minloc0_4_r16.c | 77 ++++++-- libgfortran/generated/minloc0_4_r4.c | 77 ++++++-- libgfortran/generated/minloc0_4_r8.c | 77 ++++++-- libgfortran/generated/minloc0_8_i1.c | 77 ++++++-- libgfortran/generated/minloc0_8_i16.c | 77 ++++++-- libgfortran/generated/minloc0_8_i2.c | 77 ++++++-- libgfortran/generated/minloc0_8_i4.c | 77 ++++++-- libgfortran/generated/minloc0_8_i8.c | 77 ++++++-- libgfortran/generated/minloc0_8_r10.c | 77 ++++++-- libgfortran/generated/minloc0_8_r16.c | 77 ++++++-- libgfortran/generated/minloc0_8_r4.c | 77 ++++++-- libgfortran/generated/minloc0_8_r8.c | 77 ++++++-- libgfortran/generated/minloc1_16_i1.c | 68 ++++++- libgfortran/generated/minloc1_16_i16.c | 68 ++++++- libgfortran/generated/minloc1_16_i2.c | 68 ++++++- libgfortran/generated/minloc1_16_i4.c | 68 ++++++- libgfortran/generated/minloc1_16_i8.c | 68 ++++++- libgfortran/generated/minloc1_16_r10.c | 68 ++++++- libgfortran/generated/minloc1_16_r16.c | 68 ++++++- libgfortran/generated/minloc1_16_r4.c | 68 ++++++- libgfortran/generated/minloc1_16_r8.c | 68 ++++++- libgfortran/generated/minloc1_4_i1.c | 68 ++++++- libgfortran/generated/minloc1_4_i16.c | 68 ++++++- libgfortran/generated/minloc1_4_i2.c | 68 ++++++- libgfortran/generated/minloc1_4_i4.c | 68 ++++++- libgfortran/generated/minloc1_4_i8.c | 68 ++++++- libgfortran/generated/minloc1_4_r10.c | 68 ++++++- libgfortran/generated/minloc1_4_r16.c | 68 ++++++- libgfortran/generated/minloc1_4_r4.c | 68 ++++++- libgfortran/generated/minloc1_4_r8.c | 68 ++++++- libgfortran/generated/minloc1_8_i1.c | 68 ++++++- libgfortran/generated/minloc1_8_i16.c | 68 ++++++- libgfortran/generated/minloc1_8_i2.c | 68 ++++++- libgfortran/generated/minloc1_8_i4.c | 68 ++++++- libgfortran/generated/minloc1_8_i8.c | 68 ++++++- libgfortran/generated/minloc1_8_r10.c | 68 ++++++- libgfortran/generated/minloc1_8_r16.c | 68 ++++++- libgfortran/generated/minloc1_8_r4.c | 68 ++++++- libgfortran/generated/minloc1_8_r8.c | 68 ++++++- libgfortran/generated/minval_i1.c | 68 ++++++- libgfortran/generated/minval_i16.c | 68 ++++++- libgfortran/generated/minval_i2.c | 68 ++++++- libgfortran/generated/minval_i4.c | 68 ++++++- libgfortran/generated/minval_i8.c | 68 ++++++- libgfortran/generated/minval_r10.c | 68 ++++++- libgfortran/generated/minval_r16.c | 68 ++++++- libgfortran/generated/minval_r4.c | 68 ++++++- libgfortran/generated/minval_r8.c | 68 ++++++- libgfortran/generated/product_c10.c | 68 ++++++- libgfortran/generated/product_c16.c | 68 ++++++- libgfortran/generated/product_c4.c | 68 ++++++- libgfortran/generated/product_c8.c | 68 ++++++- libgfortran/generated/product_i1.c | 68 ++++++- libgfortran/generated/product_i16.c | 68 ++++++- libgfortran/generated/product_i2.c | 68 ++++++- libgfortran/generated/product_i4.c | 68 ++++++- libgfortran/generated/product_i8.c | 68 ++++++- libgfortran/generated/product_r10.c | 68 ++++++- libgfortran/generated/product_r16.c | 68 ++++++- libgfortran/generated/product_r4.c | 68 ++++++- libgfortran/generated/product_r8.c | 68 ++++++- libgfortran/generated/sum_c10.c | 68 ++++++- libgfortran/generated/sum_c16.c | 68 ++++++- libgfortran/generated/sum_c4.c | 68 ++++++- libgfortran/generated/sum_c8.c | 68 ++++++- libgfortran/generated/sum_i1.c | 68 ++++++- libgfortran/generated/sum_i16.c | 68 ++++++- libgfortran/generated/sum_i2.c | 68 ++++++- libgfortran/generated/sum_i4.c | 68 ++++++- libgfortran/generated/sum_i8.c | 68 ++++++- libgfortran/generated/sum_r10.c | 68 ++++++- libgfortran/generated/sum_r16.c | 68 ++++++- libgfortran/generated/sum_r4.c | 68 ++++++- libgfortran/generated/sum_r8.c | 68 ++++++- libgfortran/m4/iforeach.m4 | 73 +++++-- libgfortran/m4/ifunction.m4 | 68 ++++++- libgfortran/m4/iparm.m4 | 2 + 181 files changed, 10147 insertions(+), 1476 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/all_bounds_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_bounds_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_bounds_2.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_bounds_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 create mode 100644 gcc/testsuite/gfortran.dg/maxloc_bounds_8.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fd208664ef52..85060acfa8b5 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2008-01-11 Thomas Koenig + + 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. + 2008-01-11 Eric Botcazou * gcc.dg/struct-ret-3.c: New test. diff --git a/gcc/testsuite/gfortran.dg/all_bounds_1.f90 b/gcc/testsuite/gfortran.dg/all_bounds_1.f90 new file mode 100644 index 000000000000..d8cb07bf0c61 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/all_bounds_1.f90 @@ -0,0 +1,17 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in return value of ALL intrinsic" } +program main + logical(kind=4), allocatable :: f(:,:) + logical(kind=4) :: res(3) + character(len=80) line + allocate (f(2,2)) + f = .false. + f(1,1) = .true. + f(2,1) = .true. + res = all(f,dim=1) + write(line,fmt='(80L1)') res +end program main +! { dg-output "Fortran runtime error: Incorrect extent in return value of ALL intrinsic in dimension 1: is 3, should be 2" } + + diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_1.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_1.f90 new file mode 100644 index 000000000000..a107db2017a4 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_1.f90 @@ -0,0 +1,14 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" } +program main + integer(kind=4), allocatable :: f(:,:) + integer(kind=4) :: res(3) + character(len=80) line + allocate (f(2,2)) + f = 3 + res = maxloc(f,dim=1) + write(line,fmt='(80I1)') res +end program main +! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" } + diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_2.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_2.f90 new file mode 100644 index 000000000000..39af3cb9fded --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_2.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" } +program main + integer(kind=4), allocatable :: f(:,:) + logical, allocatable :: m(:,:) + integer(kind=4) :: res(3) + character(len=80) line + allocate (f(2,2),m(2,2)) + f = 3 + m = .true. + res = maxloc(f,dim=1,mask=m) + write(line,fmt='(80I1)') res +end program main +! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" } + diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_3.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_3.f90 new file mode 100644 index 000000000000..41df6a8d093e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_3.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in MASK argument of MAXLOC intrinsic in dimension 2: is 3, should be 2" } +program main + integer(kind=4), allocatable :: f(:,:) + logical, allocatable :: m(:,:) + integer(kind=4) :: res(2) + character(len=80) line + allocate (f(2,2),m(2,3)) + f = 3 + m = .true. + res = maxloc(f,dim=1,mask=m) + write(line,fmt='(80I1)') res +end program main +! { dg-output "Fortran runtime error: Incorrect extent in MASK argument of MAXLOC intrinsic in dimension 2: is 3, should be 2" } + diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 new file mode 100644 index 000000000000..22e5bf0af7aa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" } +module tst +contains + subroutine foo(res) + integer(kind=4), allocatable :: f(:,:) + integer, dimension(:) :: res + allocate (f(2,5)) + f = 3 + res = maxloc(f) + end subroutine foo + +end module tst +program main + use tst + implicit none + integer(kind=4) :: res(3) + call foo(res) +end program main +! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" } +! { dg-final { cleanup-modules "tst" } } + diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 new file mode 100644 index 000000000000..cbc029211535 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" } +module tst +contains + subroutine foo(res) + integer(kind=4), allocatable :: f(:,:) + integer, dimension(:) :: res + allocate (f(2,5)) + f = 3 + res = maxloc(f,mask=f>2) + end subroutine foo + +end module tst +program main + use tst + implicit none + integer(kind=4) :: res(3) + call foo(res) +end program main +! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" } +! { dg-final { cleanup-modules "tst" } } diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 new file mode 100644 index 000000000000..74a78ff4727d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_6.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in MASK argument of MAXLOC intrinsic in dimension 2: is 3, should be 2" } +program main + integer(kind=4), allocatable :: f(:,:) + logical, allocatable :: m(:,:) + integer(kind=4) :: res(2) + character(len=80) line + allocate (f(2,2),m(2,3)) + f = 3 + m = .true. + res = maxloc(f,mask=m) + write(line,fmt='(80I1)') res +end program main +! { dg-output "Fortran runtime error: Incorrect extent in MASK argument of MAXLOC intrinsic in dimension 2: is 3, should be 2" } +! { dg-final { cleanup-modules "tst" } } diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 new file mode 100644 index 000000000000..491a044ea070 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 @@ -0,0 +1,22 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" } +module tst +contains + subroutine foo(res) + integer(kind=4), allocatable :: f(:,:) + integer, dimension(:) :: res + allocate (f(2,5)) + f = 3 + res = maxloc(f,mask=.true.) + end subroutine foo + +end module tst +program main + use tst + implicit none + integer(kind=4) :: res(3) + call foo(res) +end program main +! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" } +! { dg-final { cleanup-modules "tst" } } diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_8.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_8.f90 new file mode 100644 index 000000000000..4ec113716953 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_8.f90 @@ -0,0 +1,16 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" } +program main + integer(kind=4), allocatable :: f(:,:) + logical, allocatable :: m(:,:) + integer(kind=4) :: res(3) + character(len=80) line + allocate (f(2,2),m(2,2)) + f = 3 + m = .true. + res = maxloc(f,dim=1,mask=.true.) + write(line,fmt='(80I1)') res +end program main +! { dg-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic in dimension 1: is 3, should be 2" } + diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2d276f63a2c7..34b730795e15 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,186 @@ +2008-01-11 Thomas Koenig + + 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-05 Jerry DeLisle PR libfortran/34676 diff --git a/libgfortran/generated/all_l16.c b/libgfortran/generated/all_l16.c index 1179f9cf9719..2cc81ce423a0 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 11b9b9fe8aca..12f9efb2b915 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 93d00c274bb7..c9fa80935ae8 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 1ca5584b25db..1ba59edbadd1 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 b17d27310431..83116ebe9cac 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 6c50befa85e4..a85e6e89ca0d 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 cc9b4702e82f..351eb8a1e656 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 72d61aeabc2f..9f849d8b7256 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 9275f7e22658..90659da0a177 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 d111855c942e..c3b3daad85a5 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 de1f386d82c4..3bfcf179c75a 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 e3a80a409c56..7debda799bbd 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 9f3d2458e8e7..815b79ab65cb 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 adbf30932ac3..84401ded1e15 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 927c7ae8bd51..fd26280a550c 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 dd05af10a84b..3cd6554a3460 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; ndim[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 2a68c549694c..9bfec0430131 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; ndim[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 093170ac8c46..b57e78f92746 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; ndim[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 d166829a2dbd..2e123b6d2959 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; ndim[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 e7cc15236e28..cd141a692227 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; ndim[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 5bb8ef1f8515..8426d3af81e4 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; ndim[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 0b306290aae9..3244452c601e 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; ndim[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 7a0b15613bc3..8057063339c4 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; ndim[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 e29f80cb03eb..6c12815a0a11 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; ndim[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 673b7cfa7ee8..42c865a6e29b 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; ndim[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 533b6824ec35..938ceba69747 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; ndim[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 43b6e15afab4..809d93821dc5 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; ndim[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 57241ff01aaa..5108cbe13660 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; ndim[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 c7f7f360ca92..987b424d7e16 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; ndim[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 694b621cafa6..b3101bd6ac8d 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; ndim[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 e3c093a15a20..9b1e5274a3f9 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; ndim[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 a634f31532e4..bf4692c26f08 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; ndim[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 737de141b235..774a6734c2d2 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; ndim[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 c1aa00e6cb67..38890b70dcfb 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; ndim[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 2966228a9965..be99a8ca0b10 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; ndim[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 54555a945103..02a5f645e8ec 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; ndim[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 3a22cb02e951..dca0b768861c 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; ndim[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 a756905244da..d11ba2677f2b 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; ndim[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 706bd531fdaa..898f1f576736 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; ndim[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 b849d5067cb3..6dec78a49f96 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; ndim[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 745f295d7b52..345dbe1a9d16 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; ndim[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 4441887f698c..bf7020e1a101 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; ndim[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 942d92e6bbcd..477eb704a868 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 0eca91678242..e4a2c1b361b9 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 c4fa7b339fed..f5d7b587aed2 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 7747f80de712..1fbda541ae3e 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 7fe4b6c67339..59be84cd62c0 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 8410240c2539..3a8c8b7a376e 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 92543f8adc8a..60b97249adae 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 be979ad6cb02..a36a9d1133c6 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 3af2124b137f..9c659c0d3a6a 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 b588a86a4c7d..1d9132888cd1 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 646cb48f438a..92a08bef0bd2 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 8bc84f80c3d9..b03d90a95920 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 51b62618362b..dc90ec29d8da 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 0c52075aaf38..78da94438cd6 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 8354f7184aca..1c83f62f7289 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 6ee0c0d82185..a31d0ac5afaa 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 c045ab5f5cb6..49d9cd5463bb 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 baae300a03ba..822680a49411 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 f09e54a6cc1a..5c607532dbc1 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 8a8e9c60dd6c..feefc084883e 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 5defc330ea51..8e4868d73080 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 0bd38f1b25c8..cb9d14d8d1d7 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 56ed65f05fb9..8b8f2a969145 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 0270184df354..6aa6ec1941c4 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 93b0c722ea2d..59db207cfc00 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 3c9104e2c54f..3640a5dea963 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 abb27679bfbe..93c7c78aec74 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 163e20044d81..5158e2a60cc5 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 f48efb861435..a10c8fa57c9e 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 9515b991bcfb..3819e0e01017 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 95ccb1ff0d9c..1076336a02fb 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 7d361a8a1539..f527983097c5 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 3a423ff2008b..fd775c0e4d5a 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 7ea30a075c7f..671ce1499f93 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 75d6a06727c4..674142274e92 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 54e4209d8822..136ef20794c0 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 bb0fdd952dc4..9529997a3747 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; ndim[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 428340ca9a7c..667bfd8a3491 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; ndim[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 523b980fb8f5..a5c499410bd8 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; ndim[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 67062d3d9957..7c9292cddb36 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; ndim[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 2b62a6738043..022e49c97078 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; ndim[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 1329d30adaac..a99c5307afcb 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; ndim[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 a50b0289f29d..2b2dcaacb239 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; ndim[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 d33368f8badd..f265ae475612 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; ndim[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 37e0b581c71e..59429f22ee92 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; ndim[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 18ae10b33539..24463ead318d 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; ndim[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 7ca79b16b7a7..ddcbc60eab96 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; ndim[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 c6789d990e69..60b2c3fcb579 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; ndim[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 13524f1e84b8..6431f38ba591 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; ndim[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 9d80fd35f9b1..6ffeac577fc6 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; ndim[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 58f1805d4482..e4f10024c50e 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; ndim[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 1a1bc031c5d2..0f9fb9804679 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; ndim[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 3c312c6921da..14c63b35e133 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; ndim[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 ad3b534b9725..168d0ad26211 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; ndim[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 4aa5f18c282e..6dcafbae05de 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; ndim[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 88adc44a861e..f2afae1e643f 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; ndim[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 c7e5f1352de9..d0dd13744276 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; ndim[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 401349e3ea5b..a4c921acfe3f 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; ndim[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 bc3abcaf2ec7..26aa9476cf44 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; ndim[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 90f652e25b3f..b1705ebc5fd8 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; ndim[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 67d5e0c8e028..84b95baa6a59 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; ndim[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 a542e9dea49d..d7b8d547ecec 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; ndim[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 98d6a8ef8656..6ac0bfe1b00e 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; ndim[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 c029050fcf83..c1baf547b4b8 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 88f7e0c64cb6..db992cb4a7cf 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 2268b2ebfdd5..523a4affff4f 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 e4a60ac0e566..e8d5fc397c6e 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 b8222989c8cb..8c3e4e482426 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 982a048a7d91..7aa89a947ccc 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 1e43b24aa146..5b814451d600 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 7f93dd0b9563..b3c61552ffed 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 96eaa9c139bd..0a4b1b507776 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 deb70a155d90..9cebebe10a03 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 8252d1874d78..a984a153d380 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 27768fb61344..685f9793b73f 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 11579c367f92..f44a631d352b 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 cf54b1a0d40c..f6858c028205 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 990d7ea43c8c..8e359fe15193 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 a380df29276d..11cb9c8f9627 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 62e0b2c67d90..31aa1f7a6210 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 16b210ffb45e..a7a56b67f897 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 e50acae5a41f..1fae32b3fb66 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 ed20ec71bc3c..0d31c944b851 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 743c584ba7c6..88655757ddc0 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 1d64d2cf021f..31ee2385b36d 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 d658451d9fe9..13577aba741e 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 1b6888ef4287..726aa1c89370 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 e59b187e70fd..aaf9797856db 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 d7d69e59684f..6b0bcec629cf 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 03f88bd77b0f..8a8d266393df 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 37e0b16de2a6..ef31ba0c8d8f 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 fdac2877e179..8d7bf50c4aed 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 593497393cf0..c3d63f6482b7 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 660f0e737801..48ea446db9cb 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 d7d4c09cf2b2..cd2100a05ace 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 4769f0cf38f5..10d0302d4ee1 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 6754072e1505..da6e7963a3a1 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 ab7d909fbdc7..745889a81311 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 53c7e448805a..1b0fec0174a5 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 34d4e94806e1..701835f9a43e 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 e95dbac079a6..1d58a7687568 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 6c17247c7aca..3754fcb5cae7 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 5d26d3e7cf11..6312451b794d 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 9926bdc6af85..7003129a4f7b 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 f667a6578ce1..3c448082195b 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 a862404146b4..ca57d29dc207 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 5a8a337bc338..d31eb6e15989 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 29c15838fdef..8867aaea2fdf 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 63ef48af791e..235b8a664ddd 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 bb232c5261d2..2f837e303f1c 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 6899f3446539..4e6c3d178ef6 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 e2d613f3063b..849d404869d2 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 46106c95edb3..f3da38498081 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 53040b4a5537..df79daf313a5 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 89cc92b8304d..9ef9e8399f7c 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 f78105d9bd60..a7f7392e7475 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 f20bd8711688..8740fb79b5ee 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 19c4a71cf8aa..6500d178fa4d 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 984b23be1f24..10202c35ac8a 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 93569f49df2c..4d0e8a4a963e 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 67f303c163b9..8b280a81e0d1 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 aa260f05c67c..0fd8775f93ca 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 286b9869eba2..8903b64d8bcf 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 d9ecfd447263..1d3f2d09008e 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 ffa7b878230d..d049876d5f2f 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; diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4 index 720a4c05851c..a49d33b9311e 100644 --- a/libgfortran/m4/iforeach.m4 +++ b/libgfortran/m4/iforeach.m4 @@ -36,11 +36,22 @@ name`'rtype_qual`_'atype_code (rtype * 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; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in u_name intrinsic" + " should be 1, is %d", ret_rank); - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " u_name intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -141,11 +152,40 @@ void } 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, 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 u_name intrinsic" + " should be 1, is %d", ret_rank); - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " u_name 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 u_name intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; ndim[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" + " u_name 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); @@ -270,11 +310,20 @@ void } 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 u_name intrinsic" + " 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/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4 index d8a661c2a890..965fff8acc53 100644 --- a/libgfortran/m4/ifunction.m4 +++ b/libgfortran/m4/ifunction.m4 @@ -98,7 +98,25 @@ name`'rtype_qual`_'atype_code (rtype * 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" + " u_name 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" + " u_name 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++) @@ -269,7 +287,35 @@ void else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in u_name 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" + " u_name 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" + " u_name 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++) @@ -376,13 +422,21 @@ void } 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 u_name intrinsic" + " 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/m4/iparm.m4 b/libgfortran/m4/iparm.m4 index acd3d2ce604b..51ee40d049d3 100644 --- a/libgfortran/m4/iparm.m4 +++ b/libgfortran/m4/iparm.m4 @@ -30,4 +30,6 @@ define(rtype_qual,`_'rtype_kind)dnl define(atype_max, atype_name`_HUGE')dnl define(atype_min,ifelse(regexp(file, `_\(.\)[0-9]*\.c$', `\1'),`i',`(-'atype_max`-1)',`-'atype_max))dnl define(name, regexp(regexp(file, `[^/]*$', `\&'), `^\([^_]*\)_', `\1'))dnl +define(`upcase', `translit(`$*', `a-z', `A-Z')')dnl +define(`u_name',`regexp(upcase(name),`\([A-Z]*\)',`\1')')dnl define(rtype_ccode,ifelse(rtype_letter,`i',rtype_kind,rtype_code))dnl -- 2.39.2