From 8dec97a01c853098d6632fe60e9a442dd9210b35 Mon Sep 17 00:00:00 2001 From: tkoenig Date: Fri, 11 Jan 2008 20:21:05 +0000 Subject: [PATCH] 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131473 138bc75d-0d04-0410-961f-82ee72b054a4 --- 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 fd20866..85060ac 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 0000000..d8cb07b --- /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 0000000..a107db2 --- /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 0000000..39af3cb --- /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 0000000..41df6a8 --- /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 0000000..22e5bf0 --- /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 0000000..cbc0292 --- /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 0000000..74a78ff --- /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 0000000..491a044 --- /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 0000000..4ec1137 --- /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 2d276f6..34b7307 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 1179f9c..2cc81ce 100644 --- a/libgfortran/generated/all_l16.c +++ b/libgfortran/generated/all_l16.c @@ -115,7 +115,25 @@ all_l16 (gfc_array_l16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " ALL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ALL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/all_l4.c b/libgfortran/generated/all_l4.c index 11b9b9f..12f9efb 100644 --- a/libgfortran/generated/all_l4.c +++ b/libgfortran/generated/all_l4.c @@ -115,7 +115,25 @@ all_l4 (gfc_array_l4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " ALL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ALL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/all_l8.c b/libgfortran/generated/all_l8.c index 93d00c2..c9fa809 100644 --- a/libgfortran/generated/all_l8.c +++ b/libgfortran/generated/all_l8.c @@ -115,7 +115,25 @@ all_l8 (gfc_array_l8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " ALL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ALL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/any_l16.c b/libgfortran/generated/any_l16.c index 1ca5584..1ba59ed 100644 --- a/libgfortran/generated/any_l16.c +++ b/libgfortran/generated/any_l16.c @@ -115,7 +115,25 @@ any_l16 (gfc_array_l16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " ANY intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ANY intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/any_l4.c b/libgfortran/generated/any_l4.c index b17d273..83116eb 100644 --- a/libgfortran/generated/any_l4.c +++ b/libgfortran/generated/any_l4.c @@ -115,7 +115,25 @@ any_l4 (gfc_array_l4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " ANY intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ANY intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/any_l8.c b/libgfortran/generated/any_l8.c index 6c50bef..a85e6e8 100644 --- a/libgfortran/generated/any_l8.c +++ b/libgfortran/generated/any_l8.c @@ -115,7 +115,25 @@ any_l8 (gfc_array_l8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " ANY intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " ANY intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/count_16_l16.c b/libgfortran/generated/count_16_l16.c index cc9b470..351eb8a 100644 --- a/libgfortran/generated/count_16_l16.c +++ b/libgfortran/generated/count_16_l16.c @@ -115,7 +115,25 @@ count_16_l16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/count_16_l4.c b/libgfortran/generated/count_16_l4.c index 72d61ae..9f849d8 100644 --- a/libgfortran/generated/count_16_l4.c +++ b/libgfortran/generated/count_16_l4.c @@ -115,7 +115,25 @@ count_16_l4 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/count_16_l8.c b/libgfortran/generated/count_16_l8.c index 9275f7e..90659da 100644 --- a/libgfortran/generated/count_16_l8.c +++ b/libgfortran/generated/count_16_l8.c @@ -115,7 +115,25 @@ count_16_l8 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/count_4_l16.c b/libgfortran/generated/count_4_l16.c index d111855..c3b3daa 100644 --- a/libgfortran/generated/count_4_l16.c +++ b/libgfortran/generated/count_4_l16.c @@ -115,7 +115,25 @@ count_4_l16 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/count_4_l4.c b/libgfortran/generated/count_4_l4.c index de1f386..3bfcf17 100644 --- a/libgfortran/generated/count_4_l4.c +++ b/libgfortran/generated/count_4_l4.c @@ -115,7 +115,25 @@ count_4_l4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/count_4_l8.c b/libgfortran/generated/count_4_l8.c index e3a80a4..7debda7 100644 --- a/libgfortran/generated/count_4_l8.c +++ b/libgfortran/generated/count_4_l8.c @@ -115,7 +115,25 @@ count_4_l8 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/count_8_l16.c b/libgfortran/generated/count_8_l16.c index 9f3d245..815b79a 100644 --- a/libgfortran/generated/count_8_l16.c +++ b/libgfortran/generated/count_8_l16.c @@ -115,7 +115,25 @@ count_8_l16 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/count_8_l4.c b/libgfortran/generated/count_8_l4.c index adbf309..84401de 100644 --- a/libgfortran/generated/count_8_l4.c +++ b/libgfortran/generated/count_8_l4.c @@ -115,7 +115,25 @@ count_8_l4 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/count_8_l8.c b/libgfortran/generated/count_8_l8.c index 927c7ae..fd26280 100644 --- a/libgfortran/generated/count_8_l8.c +++ b/libgfortran/generated/count_8_l8.c @@ -115,7 +115,25 @@ count_8_l8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " COUNT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " COUNT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) diff --git a/libgfortran/generated/maxloc0_16_i1.c b/libgfortran/generated/maxloc0_16_i1.c index dd05af10..3cd6554 100644 --- a/libgfortran/generated/maxloc0_16_i1.c +++ b/libgfortran/generated/maxloc0_16_i1.c @@ -69,11 +69,22 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 2a68c54..9bfec04 100644 --- a/libgfortran/generated/maxloc0_16_i16.c +++ b/libgfortran/generated/maxloc0_16_i16.c @@ -69,11 +69,22 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 093170a..b57e78f 100644 --- a/libgfortran/generated/maxloc0_16_i2.c +++ b/libgfortran/generated/maxloc0_16_i2.c @@ -69,11 +69,22 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 d166829..2e123b6 100644 --- a/libgfortran/generated/maxloc0_16_i4.c +++ b/libgfortran/generated/maxloc0_16_i4.c @@ -69,11 +69,22 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 e7cc152..cd141a6 100644 --- a/libgfortran/generated/maxloc0_16_i8.c +++ b/libgfortran/generated/maxloc0_16_i8.c @@ -69,11 +69,22 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 5bb8ef1..8426d3a 100644 --- a/libgfortran/generated/maxloc0_16_r10.c +++ b/libgfortran/generated/maxloc0_16_r10.c @@ -69,11 +69,22 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 0b30629..3244452 100644 --- a/libgfortran/generated/maxloc0_16_r16.c +++ b/libgfortran/generated/maxloc0_16_r16.c @@ -69,11 +69,22 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 7a0b156..8057063 100644 --- a/libgfortran/generated/maxloc0_16_r4.c +++ b/libgfortran/generated/maxloc0_16_r4.c @@ -69,11 +69,22 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 e29f80c..6c12815 100644 --- a/libgfortran/generated/maxloc0_16_r8.c +++ b/libgfortran/generated/maxloc0_16_r8.c @@ -69,11 +69,22 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 673b7cf..42c865a 100644 --- a/libgfortran/generated/maxloc0_4_i1.c +++ b/libgfortran/generated/maxloc0_4_i1.c @@ -69,11 +69,22 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 533b682..938ceba 100644 --- a/libgfortran/generated/maxloc0_4_i16.c +++ b/libgfortran/generated/maxloc0_4_i16.c @@ -69,11 +69,22 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 43b6e15..809d938 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 57241ff..5108cbe 100644 --- a/libgfortran/generated/maxloc0_4_i4.c +++ b/libgfortran/generated/maxloc0_4_i4.c @@ -69,11 +69,22 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 c7f7f36..987b424 100644 --- a/libgfortran/generated/maxloc0_4_i8.c +++ b/libgfortran/generated/maxloc0_4_i8.c @@ -69,11 +69,22 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 694b621..b3101bd 100644 --- a/libgfortran/generated/maxloc0_4_r10.c +++ b/libgfortran/generated/maxloc0_4_r10.c @@ -69,11 +69,22 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 e3c093a..9b1e527 100644 --- a/libgfortran/generated/maxloc0_4_r16.c +++ b/libgfortran/generated/maxloc0_4_r16.c @@ -69,11 +69,22 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 a634f31..bf4692c 100644 --- a/libgfortran/generated/maxloc0_4_r4.c +++ b/libgfortran/generated/maxloc0_4_r4.c @@ -69,11 +69,22 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 737de14..774a673 100644 --- a/libgfortran/generated/maxloc0_4_r8.c +++ b/libgfortran/generated/maxloc0_4_r8.c @@ -69,11 +69,22 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 c1aa00e..38890b7 100644 --- a/libgfortran/generated/maxloc0_8_i1.c +++ b/libgfortran/generated/maxloc0_8_i1.c @@ -69,11 +69,22 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 2966228..be99a8c 100644 --- a/libgfortran/generated/maxloc0_8_i16.c +++ b/libgfortran/generated/maxloc0_8_i16.c @@ -69,11 +69,22 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 54555a9..02a5f64 100644 --- a/libgfortran/generated/maxloc0_8_i2.c +++ b/libgfortran/generated/maxloc0_8_i2.c @@ -69,11 +69,22 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 3a22cb0..dca0b76 100644 --- a/libgfortran/generated/maxloc0_8_i4.c +++ b/libgfortran/generated/maxloc0_8_i4.c @@ -69,11 +69,22 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 a756905..d11ba26 100644 --- a/libgfortran/generated/maxloc0_8_i8.c +++ b/libgfortran/generated/maxloc0_8_i8.c @@ -69,11 +69,22 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 706bd53..898f1f5 100644 --- a/libgfortran/generated/maxloc0_8_r10.c +++ b/libgfortran/generated/maxloc0_8_r10.c @@ -69,11 +69,22 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 b849d50..6dec78a 100644 --- a/libgfortran/generated/maxloc0_8_r16.c +++ b/libgfortran/generated/maxloc0_8_r16.c @@ -69,11 +69,22 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 745f295..345dbe1 100644 --- a/libgfortran/generated/maxloc0_8_r4.c +++ b/libgfortran/generated/maxloc0_8_r4.c @@ -69,11 +69,22 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 4441887..bf7020e 100644 --- a/libgfortran/generated/maxloc0_8_r8.c +++ b/libgfortran/generated/maxloc0_8_r8.c @@ -69,11 +69,22 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MAXLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 942d92e..477eb70 100644 --- a/libgfortran/generated/maxloc1_16_i1.c +++ b/libgfortran/generated/maxloc1_16_i1.c @@ -116,7 +116,25 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_i16.c b/libgfortran/generated/maxloc1_16_i16.c index 0eca916..e4a2c1b 100644 --- a/libgfortran/generated/maxloc1_16_i16.c +++ b/libgfortran/generated/maxloc1_16_i16.c @@ -116,7 +116,25 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_i2.c b/libgfortran/generated/maxloc1_16_i2.c index c4fa7b3..f5d7b58 100644 --- a/libgfortran/generated/maxloc1_16_i2.c +++ b/libgfortran/generated/maxloc1_16_i2.c @@ -116,7 +116,25 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_i4.c b/libgfortran/generated/maxloc1_16_i4.c index 7747f80..1fbda54 100644 --- a/libgfortran/generated/maxloc1_16_i4.c +++ b/libgfortran/generated/maxloc1_16_i4.c @@ -116,7 +116,25 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_i8.c b/libgfortran/generated/maxloc1_16_i8.c index 7fe4b6c..59be84c 100644 --- a/libgfortran/generated/maxloc1_16_i8.c +++ b/libgfortran/generated/maxloc1_16_i8.c @@ -116,7 +116,25 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_r10.c b/libgfortran/generated/maxloc1_16_r10.c index 8410240..3a8c8b7 100644 --- a/libgfortran/generated/maxloc1_16_r10.c +++ b/libgfortran/generated/maxloc1_16_r10.c @@ -116,7 +116,25 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_r16.c b/libgfortran/generated/maxloc1_16_r16.c index 92543f8..60b9724 100644 --- a/libgfortran/generated/maxloc1_16_r16.c +++ b/libgfortran/generated/maxloc1_16_r16.c @@ -116,7 +116,25 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_r4.c b/libgfortran/generated/maxloc1_16_r4.c index be979ad..a36a9d11 100644 --- a/libgfortran/generated/maxloc1_16_r4.c +++ b/libgfortran/generated/maxloc1_16_r4.c @@ -116,7 +116,25 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_16_r8.c b/libgfortran/generated/maxloc1_16_r8.c index 3af2124..9c659c0 100644 --- a/libgfortran/generated/maxloc1_16_r8.c +++ b/libgfortran/generated/maxloc1_16_r8.c @@ -116,7 +116,25 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i1.c b/libgfortran/generated/maxloc1_4_i1.c index b588a86..1d91328 100644 --- a/libgfortran/generated/maxloc1_4_i1.c +++ b/libgfortran/generated/maxloc1_4_i1.c @@ -116,7 +116,25 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i16.c b/libgfortran/generated/maxloc1_4_i16.c index 646cb48..92a08be 100644 --- a/libgfortran/generated/maxloc1_4_i16.c +++ b/libgfortran/generated/maxloc1_4_i16.c @@ -116,7 +116,25 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i2.c b/libgfortran/generated/maxloc1_4_i2.c index 8bc84f8..b03d90a 100644 --- a/libgfortran/generated/maxloc1_4_i2.c +++ b/libgfortran/generated/maxloc1_4_i2.c @@ -116,7 +116,25 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i4.c b/libgfortran/generated/maxloc1_4_i4.c index 51b6261..dc90ec2 100644 --- a/libgfortran/generated/maxloc1_4_i4.c +++ b/libgfortran/generated/maxloc1_4_i4.c @@ -116,7 +116,25 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i8.c b/libgfortran/generated/maxloc1_4_i8.c index 0c52075..78da944 100644 --- a/libgfortran/generated/maxloc1_4_i8.c +++ b/libgfortran/generated/maxloc1_4_i8.c @@ -116,7 +116,25 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_r10.c b/libgfortran/generated/maxloc1_4_r10.c index 8354f71..1c83f62 100644 --- a/libgfortran/generated/maxloc1_4_r10.c +++ b/libgfortran/generated/maxloc1_4_r10.c @@ -116,7 +116,25 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_r16.c b/libgfortran/generated/maxloc1_4_r16.c index 6ee0c0d..a31d0ac 100644 --- a/libgfortran/generated/maxloc1_4_r16.c +++ b/libgfortran/generated/maxloc1_4_r16.c @@ -116,7 +116,25 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_r4.c b/libgfortran/generated/maxloc1_4_r4.c index c045ab5..49d9cd5 100644 --- a/libgfortran/generated/maxloc1_4_r4.c +++ b/libgfortran/generated/maxloc1_4_r4.c @@ -116,7 +116,25 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_r8.c b/libgfortran/generated/maxloc1_4_r8.c index baae300..822680a 100644 --- a/libgfortran/generated/maxloc1_4_r8.c +++ b/libgfortran/generated/maxloc1_4_r8.c @@ -116,7 +116,25 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i1.c b/libgfortran/generated/maxloc1_8_i1.c index f09e54a..5c60753 100644 --- a/libgfortran/generated/maxloc1_8_i1.c +++ b/libgfortran/generated/maxloc1_8_i1.c @@ -116,7 +116,25 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i16.c b/libgfortran/generated/maxloc1_8_i16.c index 8a8e9c6..feefc08 100644 --- a/libgfortran/generated/maxloc1_8_i16.c +++ b/libgfortran/generated/maxloc1_8_i16.c @@ -116,7 +116,25 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i2.c b/libgfortran/generated/maxloc1_8_i2.c index 5defc33..8e4868d 100644 --- a/libgfortran/generated/maxloc1_8_i2.c +++ b/libgfortran/generated/maxloc1_8_i2.c @@ -116,7 +116,25 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i4.c b/libgfortran/generated/maxloc1_8_i4.c index 0bd38f1b..cb9d14d 100644 --- a/libgfortran/generated/maxloc1_8_i4.c +++ b/libgfortran/generated/maxloc1_8_i4.c @@ -116,7 +116,25 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c index 56ed65f..8b8f2a9 100644 --- a/libgfortran/generated/maxloc1_8_i8.c +++ b/libgfortran/generated/maxloc1_8_i8.c @@ -116,7 +116,25 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_r10.c b/libgfortran/generated/maxloc1_8_r10.c index 0270184..6aa6ec1 100644 --- a/libgfortran/generated/maxloc1_8_r10.c +++ b/libgfortran/generated/maxloc1_8_r10.c @@ -116,7 +116,25 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_r16.c b/libgfortran/generated/maxloc1_8_r16.c index 93b0c72..59db207 100644 --- a/libgfortran/generated/maxloc1_8_r16.c +++ b/libgfortran/generated/maxloc1_8_r16.c @@ -116,7 +116,25 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_r4.c b/libgfortran/generated/maxloc1_8_r4.c index 3c9104e..3640a5d 100644 --- a/libgfortran/generated/maxloc1_8_r4.c +++ b/libgfortran/generated/maxloc1_8_r4.c @@ -116,7 +116,25 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_8_r8.c b/libgfortran/generated/maxloc1_8_r8.c index abb2767..93c7c78 100644 --- a/libgfortran/generated/maxloc1_8_r8.c +++ b/libgfortran/generated/maxloc1_8_r8.c @@ -116,7 +116,25 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ smaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxval_i1.c b/libgfortran/generated/maxval_i1.c index 163e200..5158e2a 100644 --- a/libgfortran/generated/maxval_i1.c +++ b/libgfortran/generated/maxval_i1.c @@ -115,7 +115,25 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ smaxval_i1 (gfc_array_i1 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxval_i16.c b/libgfortran/generated/maxval_i16.c index f48efb8..a10c8fa 100644 --- a/libgfortran/generated/maxval_i16.c +++ b/libgfortran/generated/maxval_i16.c @@ -115,7 +115,25 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ smaxval_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxval_i2.c b/libgfortran/generated/maxval_i2.c index 9515b99..3819e0e 100644 --- a/libgfortran/generated/maxval_i2.c +++ b/libgfortran/generated/maxval_i2.c @@ -115,7 +115,25 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ smaxval_i2 (gfc_array_i2 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxval_i4.c b/libgfortran/generated/maxval_i4.c index 95ccb1f..1076336 100644 --- a/libgfortran/generated/maxval_i4.c +++ b/libgfortran/generated/maxval_i4.c @@ -115,7 +115,25 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ smaxval_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxval_i8.c b/libgfortran/generated/maxval_i8.c index 7d361a8..f527983 100644 --- a/libgfortran/generated/maxval_i8.c +++ b/libgfortran/generated/maxval_i8.c @@ -115,7 +115,25 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ smaxval_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxval_r10.c b/libgfortran/generated/maxval_r10.c index 3a423ff..fd775c0 100644 --- a/libgfortran/generated/maxval_r10.c +++ b/libgfortran/generated/maxval_r10.c @@ -115,7 +115,25 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ smaxval_r10 (gfc_array_r10 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxval_r16.c b/libgfortran/generated/maxval_r16.c index 7ea30a0..671ce14 100644 --- a/libgfortran/generated/maxval_r16.c +++ b/libgfortran/generated/maxval_r16.c @@ -115,7 +115,25 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ smaxval_r16 (gfc_array_r16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxval_r4.c b/libgfortran/generated/maxval_r4.c index 75d6a06..6741422 100644 --- a/libgfortran/generated/maxval_r4.c +++ b/libgfortran/generated/maxval_r4.c @@ -115,7 +115,25 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ smaxval_r4 (gfc_array_r4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxval_r8.c b/libgfortran/generated/maxval_r8.c index 54e4209..136ef207 100644 --- a/libgfortran/generated/maxval_r8.c +++ b/libgfortran/generated/maxval_r8.c @@ -115,7 +115,25 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MAXVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MAXVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MAXVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ smaxval_r8 (gfc_array_r8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MAXVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc0_16_i1.c b/libgfortran/generated/minloc0_16_i1.c index bb0fdd9..9529997 100644 --- a/libgfortran/generated/minloc0_16_i1.c +++ b/libgfortran/generated/minloc0_16_i1.c @@ -69,11 +69,22 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 428340c..667bfd8 100644 --- a/libgfortran/generated/minloc0_16_i16.c +++ b/libgfortran/generated/minloc0_16_i16.c @@ -69,11 +69,22 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 523b980..a5c4994 100644 --- a/libgfortran/generated/minloc0_16_i2.c +++ b/libgfortran/generated/minloc0_16_i2.c @@ -69,11 +69,22 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 67062d3..7c9292c 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 2b62a67..022e49c 100644 --- a/libgfortran/generated/minloc0_16_i8.c +++ b/libgfortran/generated/minloc0_16_i8.c @@ -69,11 +69,22 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 1329d30..a99c530 100644 --- a/libgfortran/generated/minloc0_16_r10.c +++ b/libgfortran/generated/minloc0_16_r10.c @@ -69,11 +69,22 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 a50b028..2b2dcaa 100644 --- a/libgfortran/generated/minloc0_16_r16.c +++ b/libgfortran/generated/minloc0_16_r16.c @@ -69,11 +69,22 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 d33368f..f265ae4 100644 --- a/libgfortran/generated/minloc0_16_r4.c +++ b/libgfortran/generated/minloc0_16_r4.c @@ -69,11 +69,22 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 37e0b58..59429f2 100644 --- a/libgfortran/generated/minloc0_16_r8.c +++ b/libgfortran/generated/minloc0_16_r8.c @@ -69,11 +69,22 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 18ae10b..24463ea 100644 --- a/libgfortran/generated/minloc0_4_i1.c +++ b/libgfortran/generated/minloc0_4_i1.c @@ -69,11 +69,22 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 7ca79b1..ddcbc60 100644 --- a/libgfortran/generated/minloc0_4_i16.c +++ b/libgfortran/generated/minloc0_4_i16.c @@ -69,11 +69,22 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 c6789d9..60b2c3f 100644 --- a/libgfortran/generated/minloc0_4_i2.c +++ b/libgfortran/generated/minloc0_4_i2.c @@ -69,11 +69,22 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 13524f1..6431f38 100644 --- a/libgfortran/generated/minloc0_4_i4.c +++ b/libgfortran/generated/minloc0_4_i4.c @@ -69,11 +69,22 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 9d80fd3..6ffeac5 100644 --- a/libgfortran/generated/minloc0_4_i8.c +++ b/libgfortran/generated/minloc0_4_i8.c @@ -69,11 +69,22 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 58f1805..e4f1002 100644 --- a/libgfortran/generated/minloc0_4_r10.c +++ b/libgfortran/generated/minloc0_4_r10.c @@ -69,11 +69,22 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 1a1bc03..0f9fb98 100644 --- a/libgfortran/generated/minloc0_4_r16.c +++ b/libgfortran/generated/minloc0_4_r16.c @@ -69,11 +69,22 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 3c312c6..14c63b3 100644 --- a/libgfortran/generated/minloc0_4_r4.c +++ b/libgfortran/generated/minloc0_4_r4.c @@ -69,11 +69,22 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 ad3b534..168d0ad 100644 --- a/libgfortran/generated/minloc0_4_r8.c +++ b/libgfortran/generated/minloc0_4_r8.c @@ -69,11 +69,22 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 4aa5f18..6dcafba 100644 --- a/libgfortran/generated/minloc0_8_i1.c +++ b/libgfortran/generated/minloc0_8_i1.c @@ -69,11 +69,22 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 88adc44..f2afae1 100644 --- a/libgfortran/generated/minloc0_8_i16.c +++ b/libgfortran/generated/minloc0_8_i16.c @@ -69,11 +69,22 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 c7e5f13..d0dd137 100644 --- a/libgfortran/generated/minloc0_8_i2.c +++ b/libgfortran/generated/minloc0_8_i2.c @@ -69,11 +69,22 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 401349e..a4c921a 100644 --- a/libgfortran/generated/minloc0_8_i4.c +++ b/libgfortran/generated/minloc0_8_i4.c @@ -69,11 +69,22 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 bc3abca..26aa947 100644 --- a/libgfortran/generated/minloc0_8_i8.c +++ b/libgfortran/generated/minloc0_8_i8.c @@ -69,11 +69,22 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 90f652e..b1705eb 100644 --- a/libgfortran/generated/minloc0_8_r10.c +++ b/libgfortran/generated/minloc0_8_r10.c @@ -69,11 +69,22 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 67d5e0c..84b95ba 100644 --- a/libgfortran/generated/minloc0_8_r16.c +++ b/libgfortran/generated/minloc0_8_r16.c @@ -69,11 +69,22 @@ minloc0_8_r16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 a542e9d..d7b8d54 100644 --- a/libgfortran/generated/minloc0_8_r4.c +++ b/libgfortran/generated/minloc0_8_r4.c @@ -69,11 +69,22 @@ minloc0_8_r4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 98d6a8e..6ac0bfe 100644 --- a/libgfortran/generated/minloc0_8_r8.c +++ b/libgfortran/generated/minloc0_8_r8.c @@ -69,11 +69,22 @@ minloc0_8_r8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + } } dstride = retarray->dim[0].stride; @@ -182,11 +193,40 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); - - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); + if (compile_options.bounds_check) + { + int ret_rank, mask_rank; + index_type ret_extent; + int n; + index_type array_extent, mask_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrnisic: is %ld, should be %d", + (long int) ret_extent, rank); + + mask_rank = GFC_DESCRIPTOR_RANK (mask); + if (rank != mask_rank) + runtime_error ("rank of MASK argument in MINLOC intrnisic" + "should be %d, is %d", rank, mask_rank); + + for (n=0; 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 c029050..c1baf54 100644 --- a/libgfortran/generated/minloc1_16_i1.c +++ b/libgfortran/generated/minloc1_16_i1.c @@ -116,7 +116,25 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_16_i1 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_i16.c b/libgfortran/generated/minloc1_16_i16.c index 88f7e0c..db992cb 100644 --- a/libgfortran/generated/minloc1_16_i16.c +++ b/libgfortran/generated/minloc1_16_i16.c @@ -116,7 +116,25 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_16_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_i2.c b/libgfortran/generated/minloc1_16_i2.c index 2268b2e..523a4af 100644 --- a/libgfortran/generated/minloc1_16_i2.c +++ b/libgfortran/generated/minloc1_16_i2.c @@ -116,7 +116,25 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_16_i2 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_i4.c b/libgfortran/generated/minloc1_16_i4.c index e4a60ac..e8d5fc3 100644 --- a/libgfortran/generated/minloc1_16_i4.c +++ b/libgfortran/generated/minloc1_16_i4.c @@ -116,7 +116,25 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_16_i4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_i8.c b/libgfortran/generated/minloc1_16_i8.c index b822298..8c3e4e4 100644 --- a/libgfortran/generated/minloc1_16_i8.c +++ b/libgfortran/generated/minloc1_16_i8.c @@ -116,7 +116,25 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_16_i8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_r10.c b/libgfortran/generated/minloc1_16_r10.c index 982a048..7aa89a9 100644 --- a/libgfortran/generated/minloc1_16_r10.c +++ b/libgfortran/generated/minloc1_16_r10.c @@ -116,7 +116,25 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_16_r10 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_r16.c b/libgfortran/generated/minloc1_16_r16.c index 1e43b24..5b81445 100644 --- a/libgfortran/generated/minloc1_16_r16.c +++ b/libgfortran/generated/minloc1_16_r16.c @@ -116,7 +116,25 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_16_r16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_r4.c b/libgfortran/generated/minloc1_16_r4.c index 7f93dd0..b3c6155 100644 --- a/libgfortran/generated/minloc1_16_r4.c +++ b/libgfortran/generated/minloc1_16_r4.c @@ -116,7 +116,25 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_16_r4 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_16_r8.c b/libgfortran/generated/minloc1_16_r8.c index 96eaa9c..0a4b1b5 100644 --- a/libgfortran/generated/minloc1_16_r8.c +++ b/libgfortran/generated/minloc1_16_r8.c @@ -116,7 +116,25 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_16_r8 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i1.c b/libgfortran/generated/minloc1_4_i1.c index deb70a1..9cebebe 100644 --- a/libgfortran/generated/minloc1_4_i1.c +++ b/libgfortran/generated/minloc1_4_i1.c @@ -116,7 +116,25 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_4_i1 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i16.c b/libgfortran/generated/minloc1_4_i16.c index 8252d18..a984a15 100644 --- a/libgfortran/generated/minloc1_4_i16.c +++ b/libgfortran/generated/minloc1_4_i16.c @@ -116,7 +116,25 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_4_i16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i2.c b/libgfortran/generated/minloc1_4_i2.c index 27768fb..685f979 100644 --- a/libgfortran/generated/minloc1_4_i2.c +++ b/libgfortran/generated/minloc1_4_i2.c @@ -116,7 +116,25 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_4_i2 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i4.c b/libgfortran/generated/minloc1_4_i4.c index 11579c3..f44a631 100644 --- a/libgfortran/generated/minloc1_4_i4.c +++ b/libgfortran/generated/minloc1_4_i4.c @@ -116,7 +116,25 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_4_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i8.c b/libgfortran/generated/minloc1_4_i8.c index cf54b1a..f6858c0 100644 --- a/libgfortran/generated/minloc1_4_i8.c +++ b/libgfortran/generated/minloc1_4_i8.c @@ -116,7 +116,25 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_4_i8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_r10.c b/libgfortran/generated/minloc1_4_r10.c index 990d7ea..8e359fe 100644 --- a/libgfortran/generated/minloc1_4_r10.c +++ b/libgfortran/generated/minloc1_4_r10.c @@ -116,7 +116,25 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_4_r10 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_r16.c b/libgfortran/generated/minloc1_4_r16.c index a380df2..11cb9c8 100644 --- a/libgfortran/generated/minloc1_4_r16.c +++ b/libgfortran/generated/minloc1_4_r16.c @@ -116,7 +116,25 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_4_r16 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_r4.c b/libgfortran/generated/minloc1_4_r4.c index 62e0b2c..31aa1f7 100644 --- a/libgfortran/generated/minloc1_4_r4.c +++ b/libgfortran/generated/minloc1_4_r4.c @@ -116,7 +116,25 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_4_r4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_r8.c b/libgfortran/generated/minloc1_4_r8.c index 16b210f..a7a56b6 100644 --- a/libgfortran/generated/minloc1_4_r8.c +++ b/libgfortran/generated/minloc1_4_r8.c @@ -116,7 +116,25 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_4_r8 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i1.c b/libgfortran/generated/minloc1_8_i1.c index e50acae..1fae32b 100644 --- a/libgfortran/generated/minloc1_8_i1.c +++ b/libgfortran/generated/minloc1_8_i1.c @@ -116,7 +116,25 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_8_i1 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i16.c b/libgfortran/generated/minloc1_8_i16.c index ed20ec7..0d31c94 100644 --- a/libgfortran/generated/minloc1_8_i16.c +++ b/libgfortran/generated/minloc1_8_i16.c @@ -116,7 +116,25 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_8_i16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i2.c b/libgfortran/generated/minloc1_8_i2.c index 743c584..8865575 100644 --- a/libgfortran/generated/minloc1_8_i2.c +++ b/libgfortran/generated/minloc1_8_i2.c @@ -116,7 +116,25 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_8_i2 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i4.c b/libgfortran/generated/minloc1_8_i4.c index 1d64d2c..31ee238 100644 --- a/libgfortran/generated/minloc1_8_i4.c +++ b/libgfortran/generated/minloc1_8_i4.c @@ -116,7 +116,25 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_8_i4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_i8.c b/libgfortran/generated/minloc1_8_i8.c index d658451..13577ab 100644 --- a/libgfortran/generated/minloc1_8_i8.c +++ b/libgfortran/generated/minloc1_8_i8.c @@ -116,7 +116,25 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_8_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_r10.c b/libgfortran/generated/minloc1_8_r10.c index 1b6888e..726aa1c 100644 --- a/libgfortran/generated/minloc1_8_r10.c +++ b/libgfortran/generated/minloc1_8_r10.c @@ -116,7 +116,25 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_8_r10 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_r16.c b/libgfortran/generated/minloc1_8_r16.c index e59b187..aaf9797 100644 --- a/libgfortran/generated/minloc1_8_r16.c +++ b/libgfortran/generated/minloc1_8_r16.c @@ -116,7 +116,25 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_8_r16 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_r4.c b/libgfortran/generated/minloc1_8_r4.c index d7d69e5..6b0bcec 100644 --- a/libgfortran/generated/minloc1_8_r4.c +++ b/libgfortran/generated/minloc1_8_r4.c @@ -116,7 +116,25 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_8_r4 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_8_r8.c b/libgfortran/generated/minloc1_8_r8.c index 03f88bd..8a8d266 100644 --- a/libgfortran/generated/minloc1_8_r8.c +++ b/libgfortran/generated/minloc1_8_r8.c @@ -116,7 +116,25 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINLOC intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -293,7 +311,35 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINLOC intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINLOC intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -406,13 +452,21 @@ sminloc1_8_r8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINLOC intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minval_i1.c b/libgfortran/generated/minval_i1.c index 37e0b16..ef31ba0 100644 --- a/libgfortran/generated/minval_i1.c +++ b/libgfortran/generated/minval_i1.c @@ -115,7 +115,25 @@ minval_i1 (gfc_array_i1 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ sminval_i1 (gfc_array_i1 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minval_i16.c b/libgfortran/generated/minval_i16.c index fdac287..8d7bf50 100644 --- a/libgfortran/generated/minval_i16.c +++ b/libgfortran/generated/minval_i16.c @@ -115,7 +115,25 @@ minval_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ sminval_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minval_i2.c b/libgfortran/generated/minval_i2.c index 5934973..c3d63f6 100644 --- a/libgfortran/generated/minval_i2.c +++ b/libgfortran/generated/minval_i2.c @@ -115,7 +115,25 @@ minval_i2 (gfc_array_i2 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ sminval_i2 (gfc_array_i2 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minval_i4.c b/libgfortran/generated/minval_i4.c index 660f0e7..48ea446 100644 --- a/libgfortran/generated/minval_i4.c +++ b/libgfortran/generated/minval_i4.c @@ -115,7 +115,25 @@ minval_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ sminval_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minval_i8.c b/libgfortran/generated/minval_i8.c index d7d4c09..cd2100a 100644 --- a/libgfortran/generated/minval_i8.c +++ b/libgfortran/generated/minval_i8.c @@ -115,7 +115,25 @@ minval_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ sminval_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minval_r10.c b/libgfortran/generated/minval_r10.c index 4769f0c..10d0302 100644 --- a/libgfortran/generated/minval_r10.c +++ b/libgfortran/generated/minval_r10.c @@ -115,7 +115,25 @@ minval_r10 (gfc_array_r10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ sminval_r10 (gfc_array_r10 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minval_r16.c b/libgfortran/generated/minval_r16.c index 6754072..da6e796 100644 --- a/libgfortran/generated/minval_r16.c +++ b/libgfortran/generated/minval_r16.c @@ -115,7 +115,25 @@ minval_r16 (gfc_array_r16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ sminval_r16 (gfc_array_r16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minval_r4.c b/libgfortran/generated/minval_r4.c index ab7d909..745889a 100644 --- a/libgfortran/generated/minval_r4.c +++ b/libgfortran/generated/minval_r4.c @@ -115,7 +115,25 @@ minval_r4 (gfc_array_r4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ sminval_r4 (gfc_array_r4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minval_r8.c b/libgfortran/generated/minval_r8.c index 53c7e44..1b0fec0 100644 --- a/libgfortran/generated/minval_r8.c +++ b/libgfortran/generated/minval_r8.c @@ -115,7 +115,25 @@ minval_r8 (gfc_array_r8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " MINVAL intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -287,7 +305,35 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in MINVAL intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " MINVAL intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -395,13 +441,21 @@ sminval_r8 (gfc_array_r8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in MINVAL intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_c10.c b/libgfortran/generated/product_c10.c index 34d4e94..701835f 100644 --- a/libgfortran/generated/product_c10.c +++ b/libgfortran/generated/product_c10.c @@ -115,7 +115,25 @@ product_c10 (gfc_array_c10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_c10 (gfc_array_c10 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_c16.c b/libgfortran/generated/product_c16.c index e95dbac..1d58a76 100644 --- a/libgfortran/generated/product_c16.c +++ b/libgfortran/generated/product_c16.c @@ -115,7 +115,25 @@ product_c16 (gfc_array_c16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_c16 (gfc_array_c16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c index 6c17247..3754fcb 100644 --- a/libgfortran/generated/product_c4.c +++ b/libgfortran/generated/product_c4.c @@ -115,7 +115,25 @@ product_c4 (gfc_array_c4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_c4 (gfc_array_c4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_c8.c b/libgfortran/generated/product_c8.c index 5d26d3e..6312451 100644 --- a/libgfortran/generated/product_c8.c +++ b/libgfortran/generated/product_c8.c @@ -115,7 +115,25 @@ product_c8 (gfc_array_c8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_c8 (gfc_array_c8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_i1.c b/libgfortran/generated/product_i1.c index 9926bdc..7003129 100644 --- a/libgfortran/generated/product_i1.c +++ b/libgfortran/generated/product_i1.c @@ -115,7 +115,25 @@ product_i1 (gfc_array_i1 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_i1 (gfc_array_i1 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_i16.c b/libgfortran/generated/product_i16.c index f667a65..3c44808 100644 --- a/libgfortran/generated/product_i16.c +++ b/libgfortran/generated/product_i16.c @@ -115,7 +115,25 @@ product_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_i2.c b/libgfortran/generated/product_i2.c index a862404..ca57d29 100644 --- a/libgfortran/generated/product_i2.c +++ b/libgfortran/generated/product_i2.c @@ -115,7 +115,25 @@ product_i2 (gfc_array_i2 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_i2 (gfc_array_i2 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_i4.c b/libgfortran/generated/product_i4.c index 5a8a337..d31eb6e 100644 --- a/libgfortran/generated/product_i4.c +++ b/libgfortran/generated/product_i4.c @@ -115,7 +115,25 @@ product_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_i8.c b/libgfortran/generated/product_i8.c index 29c1583..8867aae 100644 --- a/libgfortran/generated/product_i8.c +++ b/libgfortran/generated/product_i8.c @@ -115,7 +115,25 @@ product_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_r10.c b/libgfortran/generated/product_r10.c index 63ef48a..235b8a6 100644 --- a/libgfortran/generated/product_r10.c +++ b/libgfortran/generated/product_r10.c @@ -115,7 +115,25 @@ product_r10 (gfc_array_r10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_r10 (gfc_array_r10 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_r16.c b/libgfortran/generated/product_r16.c index bb232c5..2f837e3 100644 --- a/libgfortran/generated/product_r16.c +++ b/libgfortran/generated/product_r16.c @@ -115,7 +115,25 @@ product_r16 (gfc_array_r16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_r16 (gfc_array_r16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_r4.c b/libgfortran/generated/product_r4.c index 6899f34..4e6c3d1 100644 --- a/libgfortran/generated/product_r4.c +++ b/libgfortran/generated/product_r4.c @@ -115,7 +115,25 @@ product_r4 (gfc_array_r4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_r4 (gfc_array_r4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/product_r8.c b/libgfortran/generated/product_r8.c index e2d613f..849d404 100644 --- a/libgfortran/generated/product_r8.c +++ b/libgfortran/generated/product_r8.c @@ -115,7 +115,25 @@ product_r8 (gfc_array_r8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " PRODUCT intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in PRODUCT intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " PRODUCT intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ sproduct_r8 (gfc_array_r8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in PRODUCT intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_c10.c b/libgfortran/generated/sum_c10.c index 46106c9..f3da384 100644 --- a/libgfortran/generated/sum_c10.c +++ b/libgfortran/generated/sum_c10.c @@ -115,7 +115,25 @@ sum_c10 (gfc_array_c10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_c10 (gfc_array_c10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_c10 (gfc_array_c10 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_c16.c b/libgfortran/generated/sum_c16.c index 53040b4..df79daf 100644 --- a/libgfortran/generated/sum_c16.c +++ b/libgfortran/generated/sum_c16.c @@ -115,7 +115,25 @@ sum_c16 (gfc_array_c16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_c16 (gfc_array_c16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_c16 (gfc_array_c16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c index 89cc92b..9ef9e83 100644 --- a/libgfortran/generated/sum_c4.c +++ b/libgfortran/generated/sum_c4.c @@ -115,7 +115,25 @@ sum_c4 (gfc_array_c4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_c4 (gfc_array_c4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_c4 (gfc_array_c4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_c8.c b/libgfortran/generated/sum_c8.c index f78105d..a7f7392 100644 --- a/libgfortran/generated/sum_c8.c +++ b/libgfortran/generated/sum_c8.c @@ -115,7 +115,25 @@ sum_c8 (gfc_array_c8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_c8 (gfc_array_c8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_c8 (gfc_array_c8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_i1.c b/libgfortran/generated/sum_i1.c index f20bd87..8740fb7 100644 --- a/libgfortran/generated/sum_i1.c +++ b/libgfortran/generated/sum_i1.c @@ -115,7 +115,25 @@ sum_i1 (gfc_array_i1 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_i1 (gfc_array_i1 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_i1 (gfc_array_i1 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_i16.c b/libgfortran/generated/sum_i16.c index 19c4a71..6500d17 100644 --- a/libgfortran/generated/sum_i16.c +++ b/libgfortran/generated/sum_i16.c @@ -115,7 +115,25 @@ sum_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_i16 (gfc_array_i16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_i16 (gfc_array_i16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_i2.c b/libgfortran/generated/sum_i2.c index 984b23b..10202c3 100644 --- a/libgfortran/generated/sum_i2.c +++ b/libgfortran/generated/sum_i2.c @@ -115,7 +115,25 @@ sum_i2 (gfc_array_i2 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_i2 (gfc_array_i2 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_i2 (gfc_array_i2 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_i4.c b/libgfortran/generated/sum_i4.c index 93569f4..4d0e8a4 100644 --- a/libgfortran/generated/sum_i4.c +++ b/libgfortran/generated/sum_i4.c @@ -115,7 +115,25 @@ sum_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_i4 (gfc_array_i4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_i4 (gfc_array_i4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_i8.c b/libgfortran/generated/sum_i8.c index 67f303c..8b280a8 100644 --- a/libgfortran/generated/sum_i8.c +++ b/libgfortran/generated/sum_i8.c @@ -115,7 +115,25 @@ sum_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_i8 (gfc_array_i8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_i8 (gfc_array_i8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_r10.c b/libgfortran/generated/sum_r10.c index aa260f0..0fd8775 100644 --- a/libgfortran/generated/sum_r10.c +++ b/libgfortran/generated/sum_r10.c @@ -115,7 +115,25 @@ sum_r10 (gfc_array_r10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_r10 (gfc_array_r10 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_r10 (gfc_array_r10 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_r16.c b/libgfortran/generated/sum_r16.c index 286b986..8903b64 100644 --- a/libgfortran/generated/sum_r16.c +++ b/libgfortran/generated/sum_r16.c @@ -115,7 +115,25 @@ sum_r16 (gfc_array_r16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_r16 (gfc_array_r16 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_r16 (gfc_array_r16 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_r4.c b/libgfortran/generated/sum_r4.c index d9ecfd4..1d3f2d0 100644 --- a/libgfortran/generated/sum_r4.c +++ b/libgfortran/generated/sum_r4.c @@ -115,7 +115,25 @@ sum_r4 (gfc_array_r4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_r4 (gfc_array_r4 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_r4 (gfc_array_r4 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/sum_r8.c b/libgfortran/generated/sum_r8.c index ffa7b87..d049876 100644 --- a/libgfortran/generated/sum_r8.c +++ b/libgfortran/generated/sum_r8.c @@ -115,7 +115,25 @@ sum_r8 (gfc_array_r8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in" + " SUM intrinsic: is %d, should be %d", + GFC_DESCRIPTOR_RANK (retarray), rank); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + } } for (n = 0; n < rank; n++) @@ -286,7 +304,35 @@ msum_r8 (gfc_array_r8 * const restrict retarray, else { if (rank != GFC_DESCRIPTOR_RANK (retarray)) - runtime_error ("rank of return array incorrect"); + runtime_error ("rank of return array incorrect in SUM intrinsic"); + + if (compile_options.bounds_check) + { + for (n=0; n < rank; n++) + { + index_type ret_extent; + + ret_extent = retarray->dim[n].ubound + 1 + - retarray->dim[n].lbound; + if (extent[n] != ret_extent) + runtime_error ("Incorrect extent in return value of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) ret_extent, (long int) extent[n]); + } + for (n=0; n<= rank; n++) + { + index_type mask_extent, array_extent; + + array_extent = array->dim[n].ubound + 1 - array->dim[n].lbound; + mask_extent = mask->dim[n].ubound + 1 - mask->dim[n].lbound; + if (array_extent != mask_extent) + runtime_error ("Incorrect extent in MASK argument of" + " SUM intrinsic in dimension %d:" + " is %ld, should be %ld", n + 1, + (long int) mask_extent, (long int) array_extent); + } + } } for (n = 0; n < rank; n++) @@ -394,13 +440,21 @@ ssum_r8 (gfc_array_r8 * const restrict retarray, } else { - if (GFC_DESCRIPTOR_RANK (retarray) != 1) - runtime_error ("rank of return array does not equal 1"); + if (compile_options.bounds_check) + { + int ret_rank; + index_type ret_extent; - if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) - runtime_error ("dimension of return array incorrect"); - } + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + if (ret_rank != 1) + runtime_error ("rank of return array in SUM intrinsic" + " should be 1, is %d", ret_rank); + ret_extent = retarray->dim[0].ubound + 1 - retarray->dim[0].lbound; + if (ret_extent != rank) + runtime_error ("dimension of return array incorrect"); + } + } dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4 index 720a4c0..a49d33b 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 d8a661c..965fff8 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 acd3d2c..51ee40d 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.7.4