diff options
183 files changed, 1883 insertions, 7029 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 6951c22..a1ba3f1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,16 @@ +2009-07-19 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR libfortran/34670 + PR libfortran/36874 + * gfortran.dg/cshift_bounds_1.f90: New test. + * gfortran.dg/cshift_bounds_2.f90: New test. + * gfortran.dg/cshift_bounds_3.f90: New test. + * gfortran.dg/cshift_bounds_4.f90: New test. + * gfortran.dg/eoshift_bounds_1.f90: New test. + * gfortran.dg/maxloc_bounds_4.f90: Correct typo in error message. + * gfortran.dg/maxloc_bounds_5.f90: Correct typo in error message. + * gfortran.dg/maxloc_bounds_7.f90: Correct typo in error message. + 2009-07-19 Jan Hubicka <jh@suse.cz> PR tree-optimization/40676 diff --git a/gcc/testsuite/gfortran.dg/cshift_bounds_1.f90 b/gcc/testsuite/gfortran.dg/cshift_bounds_1.f90 new file mode 100644 index 0000000..5932004 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/cshift_bounds_1.f90 @@ -0,0 +1,24 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! Check that empty arrays are handled correctly in +! cshift and eoshift +program main + character(len=50) :: line + character(len=3), dimension(2,2) :: a, b + integer :: n1, n2 + line = '-1-2' + read (line,'(2I2)') n1, n2 + call foo(a, b, n1, n2) + a = 'abc' + write (line,'(4A)') eoshift(a, 3) + write (line,'(4A)') cshift(a, 3) + write (line,'(4A)') cshift(a(:,1:n1), 3) + write (line,'(4A)') eoshift(a(1:n2,:), 3) +end program main + +subroutine foo(a, b, n1, n2) + character(len=3), dimension(2, n1) :: a + character(len=3), dimension(n2, 2) :: b + a = cshift(b,1) + a = eoshift(b,1) +end subroutine foo diff --git a/gcc/testsuite/gfortran.dg/cshift_bounds_2.f90 b/gcc/testsuite/gfortran.dg/cshift_bounds_2.f90 new file mode 100644 index 0000000..8d7e779 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/cshift_bounds_2.f90 @@ -0,0 +1,11 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect extent in return value of CSHIFT intrinsic in dimension 2: is 3, should be 2" } +program main + integer, dimension(:,:), allocatable :: a, b + allocate (a(2,2)) + allocate (b(2,3)) + a = 1 + b = cshift(a,1) +end program main +! { dg-output "Fortran runtime error: Incorrect extent in return value of CSHIFT intrinsic in dimension 2: is 3, should be 2" } diff --git a/gcc/testsuite/gfortran.dg/cshift_bounds_3.f90 b/gcc/testsuite/gfortran.dg/cshift_bounds_3.f90 new file mode 100644 index 0000000..33e387f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/cshift_bounds_3.f90 @@ -0,0 +1,12 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect size in SHIFT argument of CSHIFT intrinsic: should not be zero-sized" } +program main + real, dimension(1,0) :: a, b, c + integer :: sp(3), i + a = 4.0 + sp = 1 + i = 1 + b = cshift (a,sp(1:i)) ! Invalid +end program main +! { dg-output "Fortran runtime error: Incorrect size in SHIFT argument of CSHIFT intrinsic: should not be zero-sized" } diff --git a/gcc/testsuite/gfortran.dg/cshift_bounds_4.f90 b/gcc/testsuite/gfortran.dg/cshift_bounds_4.f90 new file mode 100644 index 0000000..4a3fcfb --- /dev/null +++ b/gcc/testsuite/gfortran.dg/cshift_bounds_4.f90 @@ -0,0 +1,13 @@ +! { dg-do run } +! { dg-shouldfail "Incorrect extent in SHIFT argument of CSHIFT intrinsic in dimension 1: is 3, should be 2" } +! { dg-options "-fbounds-check" } +program main + integer, dimension(:,:), allocatable :: a, b + integer, dimension(:), allocatable :: sh + allocate (a(2,2)) + allocate (b(2,2)) + allocate (sh(3)) + a = 1 + b = cshift(a,sh) +end program main +! { dg-output "Fortran runtime error: Incorrect extent in SHIFT argument of CSHIFT intrinsic in dimension 1: is 3, should be 2" } diff --git a/gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90 b/gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90 new file mode 100644 index 0000000..f323415 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90 @@ -0,0 +1,12 @@ +! { dg-do run } +! { dg-options "-fbounds-check" } +! { dg-shouldfail "Incorrect size in SHIFT argument of EOSHIFT intrinsic: should not be zero-sized" } +program main + real, dimension(1,0) :: a, b, c + integer :: sp(3), i + a = 4.0 + sp = 1 + i = 1 + b = eoshift (a,sp(1:i)) ! Invalid +end program main +! { dg-output "Fortran runtime error: Incorrect size in SHIFT argument of EOSHIFT intrinsic: should not be zero-sized" } diff --git a/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 b/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 index 5a38813a..7ba103d 100644 --- a/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90 @@ -1,6 +1,6 @@ ! { dg-do run } ! { dg-options "-fbounds-check" } -! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" } +! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" } module tst contains subroutine foo(res) @@ -18,6 +18,6 @@ program main integer :: 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-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: 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 index 42e19e5..34d06da 100644 --- a/gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90 @@ -1,6 +1,6 @@ ! { dg-do run } ! { dg-options "-fbounds-check" } -! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" } +! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" } module tst contains subroutine foo(res) @@ -18,5 +18,5 @@ program main integer :: 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-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: 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 index 2194eee..817bf8f 100644 --- a/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 +++ b/gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90 @@ -1,6 +1,6 @@ ! { dg-do run } ! { dg-options "-fbounds-check" } -! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrnisic: is 3, should be 2" } +! { dg-shouldfail "Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" } module tst contains subroutine foo(res) @@ -18,5 +18,5 @@ program main integer :: 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-output "Fortran runtime error: Incorrect extent in return value of MAXLOC intrinsic: is 3, should be 2" } ! { dg-final { cleanup-modules "tst" } } diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2374683..8231ed1 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,190 @@ +2009-07-19 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR libfortran/34670 + PR libfortran/36874 + * Makefile.am: Add bounds.c + * libgfortran.h (bounds_equal_extents): Add prototype. + (bounds_iforeach_return): Likewise. + (bounds_ifunction_return): Likewise. + (bounds_reduced_extents): Likewise. + * runtime/bounds.c: New file. + (bounds_iforeach_return): New function; correct typo in + error message. + (bounds_ifunction_return): New function. + (bounds_equal_extents): New function. + (bounds_reduced_extents): Likewise. + * intrinsics/cshift0.c (cshift0): Use new functions + for bounds checking. + * intrinsics/eoshift0.c (eoshift0): Likewise. + * intrinsics/eoshift2.c (eoshift2): Likewise. + * m4/iforeach.m4: Likewise. + * m4/eoshift1.m4: Likewise. + * m4/eoshift3.m4: Likewise. + * m4/cshift1.m4: Likewise. + * m4/ifunction.m4: Likewise. + * Makefile.in: Regenerated. + * generated/cshift1_16.c: Regenerated. + * generated/cshift1_4.c: Regenerated. + * generated/cshift1_8.c: Regenerated. + * generated/eoshift1_16.c: Regenerated. + * generated/eoshift1_4.c: Regenerated. + * generated/eoshift1_8.c: Regenerated. + * generated/eoshift3_16.c: Regenerated. + * generated/eoshift3_4.c: Regenerated. + * generated/eoshift3_8.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. + 2009-07-17 Janne Blomqvist <jb@gcc.gnu.org> Jerry DeLisle <jvdelisle@gcc.gnu.org> diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index f5f92df..4a974ba 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -122,6 +122,7 @@ runtime/in_unpack_generic.c gfor_src= \ runtime/backtrace.c \ +runtime/bounds.c \ runtime/compile_options.c \ runtime/convert_char.c \ runtime/environ.c \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index ce2b5a2..7741c32 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -78,7 +78,7 @@ myexeclibLTLIBRARIES_INSTALL = $(INSTALL) toolexeclibLTLIBRARIES_INSTALL = $(INSTALL) LTLIBRARIES = $(myexeclib_LTLIBRARIES) $(toolexeclib_LTLIBRARIES) libgfortran_la_LIBADD = -am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \ +am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c runtime/bounds.c \ runtime/compile_options.c runtime/convert_char.c \ runtime/environ.c runtime/error.c runtime/fpu.c runtime/main.c \ runtime/memory.c runtime/pause.c runtime/stop.c \ @@ -580,9 +580,9 @@ am__libgfortran_la_SOURCES_DIST = runtime/backtrace.c \ $(srcdir)/generated/misc_specifics.F90 intrinsics/dprod_r8.f90 \ intrinsics/f2c_specifics.F90 libgfortran_c.c $(filter-out \ %.c,$(prereq_SRC)) -am__objects_1 = backtrace.lo compile_options.lo convert_char.lo \ - environ.lo error.lo fpu.lo main.lo memory.lo pause.lo stop.lo \ - string.lo select.lo +am__objects_1 = backtrace.lo bounds.lo compile_options.lo \ + convert_char.lo environ.lo error.lo fpu.lo main.lo memory.lo \ + pause.lo stop.lo string.lo select.lo am__objects_2 = all_l1.lo all_l2.lo all_l4.lo all_l8.lo all_l16.lo am__objects_3 = any_l1.lo any_l2.lo any_l4.lo any_l8.lo any_l16.lo am__objects_4 = count_1_l.lo count_2_l.lo count_4_l.lo count_8_l.lo \ @@ -1050,6 +1050,7 @@ runtime/in_unpack_generic.c gfor_src = \ runtime/backtrace.c \ +runtime/bounds.c \ runtime/compile_options.c \ runtime/convert_char.c \ runtime/environ.c \ @@ -1806,6 +1807,7 @@ distclean-compile: @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/associated.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/backtrace.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bit_intrinsics.Plo@am__quote@ +@AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/bounds.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/c99_functions.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chdir.Plo@am__quote@ @AMDEP_TRUE@@am__include@ @am__quote@./$(DEPDIR)/chmod.Plo@am__quote@ @@ -2678,6 +2680,13 @@ backtrace.lo: runtime/backtrace.c @AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ @am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o backtrace.lo `test -f 'runtime/backtrace.c' || echo '$(srcdir)/'`runtime/backtrace.c +bounds.lo: runtime/bounds.c +@am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT bounds.lo -MD -MP -MF "$(DEPDIR)/bounds.Tpo" -c -o bounds.lo `test -f 'runtime/bounds.c' || echo '$(srcdir)/'`runtime/bounds.c; \ +@am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/bounds.Tpo" "$(DEPDIR)/bounds.Plo"; else rm -f "$(DEPDIR)/bounds.Tpo"; exit 1; fi +@AMDEP_TRUE@@am__fastdepCC_FALSE@ source='runtime/bounds.c' object='bounds.lo' libtool=yes @AMDEPBACKSLASH@ +@AMDEP_TRUE@@am__fastdepCC_FALSE@ DEPDIR=$(DEPDIR) $(CCDEPMODE) $(depcomp) @AMDEPBACKSLASH@ +@am__fastdepCC_FALSE@ $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o bounds.lo `test -f 'runtime/bounds.c' || echo '$(srcdir)/'`runtime/bounds.c + compile_options.lo: runtime/compile_options.c @am__fastdepCC_TRUE@ if $(LIBTOOL) --tag=CC --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -MT compile_options.lo -MD -MP -MF "$(DEPDIR)/compile_options.Tpo" -c -o compile_options.lo `test -f 'runtime/compile_options.c' || echo '$(srcdir)/'`runtime/compile_options.c; \ @am__fastdepCC_TRUE@ then mv -f "$(DEPDIR)/compile_options.Tpo" "$(DEPDIR)/compile_options.Plo"; else rm -f "$(DEPDIR)/compile_options.Tpo"; exit 1; fi diff --git a/libgfortran/generated/cshift1_16.c b/libgfortran/generated/cshift1_16.c index df97dfa..b2cb7f1 100644 --- a/libgfortran/generated/cshift1_16.c +++ b/libgfortran/generated/cshift1_16.c @@ -98,6 +98,17 @@ cshift1 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "CSHIFT"); + } if (arraysize == 0) return; diff --git a/libgfortran/generated/cshift1_4.c b/libgfortran/generated/cshift1_4.c index f048e8e..30f3d99 100644 --- a/libgfortran/generated/cshift1_4.c +++ b/libgfortran/generated/cshift1_4.c @@ -98,6 +98,17 @@ cshift1 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "CSHIFT"); + } if (arraysize == 0) return; diff --git a/libgfortran/generated/cshift1_8.c b/libgfortran/generated/cshift1_8.c index 9667728..c3bf473 100644 --- a/libgfortran/generated/cshift1_8.c +++ b/libgfortran/generated/cshift1_8.c @@ -98,6 +98,17 @@ cshift1 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "CSHIFT"); + } if (arraysize == 0) return; diff --git a/libgfortran/generated/eoshift1_16.c b/libgfortran/generated/eoshift1_16.c index 02365cc..a14bd29 100644 --- a/libgfortran/generated/eoshift1_16.c +++ b/libgfortran/generated/eoshift1_16.c @@ -62,6 +62,7 @@ eoshift1 (gfc_array_char * const restrict ret, index_type len; index_type n; index_type size; + index_type arraysize; int which; GFC_INTEGER_16 sh; GFC_INTEGER_16 delta; @@ -82,11 +83,12 @@ eoshift1 (gfc_array_char * const restrict ret, extent[0] = 1; count[0] = 0; + arraysize = size0 ((array_t *) array); if (ret->data == NULL) { int i; - ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -104,13 +106,27 @@ eoshift1 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } - else + else if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); } + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { diff --git a/libgfortran/generated/eoshift1_4.c b/libgfortran/generated/eoshift1_4.c index e703db4..06bc309 100644 --- a/libgfortran/generated/eoshift1_4.c +++ b/libgfortran/generated/eoshift1_4.c @@ -62,6 +62,7 @@ eoshift1 (gfc_array_char * const restrict ret, index_type len; index_type n; index_type size; + index_type arraysize; int which; GFC_INTEGER_4 sh; GFC_INTEGER_4 delta; @@ -82,11 +83,12 @@ eoshift1 (gfc_array_char * const restrict ret, extent[0] = 1; count[0] = 0; + arraysize = size0 ((array_t *) array); if (ret->data == NULL) { int i; - ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -104,13 +106,27 @@ eoshift1 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } - else + else if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); } + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { diff --git a/libgfortran/generated/eoshift1_8.c b/libgfortran/generated/eoshift1_8.c index f8922b3..3e9162d 100644 --- a/libgfortran/generated/eoshift1_8.c +++ b/libgfortran/generated/eoshift1_8.c @@ -62,6 +62,7 @@ eoshift1 (gfc_array_char * const restrict ret, index_type len; index_type n; index_type size; + index_type arraysize; int which; GFC_INTEGER_8 sh; GFC_INTEGER_8 delta; @@ -82,11 +83,12 @@ eoshift1 (gfc_array_char * const restrict ret, extent[0] = 1; count[0] = 0; + arraysize = size0 ((array_t *) array); if (ret->data == NULL) { int i; - ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -104,13 +106,27 @@ eoshift1 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } - else + else if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); } + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { diff --git a/libgfortran/generated/eoshift3_16.c b/libgfortran/generated/eoshift3_16.c index c3efae9..ec21d1e 100644 --- a/libgfortran/generated/eoshift3_16.c +++ b/libgfortran/generated/eoshift3_16.c @@ -66,6 +66,7 @@ eoshift3 (gfc_array_char * const restrict ret, index_type len; index_type n; index_type size; + index_type arraysize; int which; GFC_INTEGER_16 sh; GFC_INTEGER_16 delta; @@ -76,6 +77,7 @@ eoshift3 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + arraysize = size0 ((array_t *) array); size = GFC_DESCRIPTOR_SIZE(array); if (pwhich) @@ -87,7 +89,7 @@ eoshift3 (gfc_array_char * const restrict ret, { int i; - ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -105,13 +107,26 @@ eoshift3 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } - else + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); } + if (arraysize == 0) + return; extent[0] = 1; count[0] = 0; diff --git a/libgfortran/generated/eoshift3_4.c b/libgfortran/generated/eoshift3_4.c index 5038c09..ce4cede 100644 --- a/libgfortran/generated/eoshift3_4.c +++ b/libgfortran/generated/eoshift3_4.c @@ -66,6 +66,7 @@ eoshift3 (gfc_array_char * const restrict ret, index_type len; index_type n; index_type size; + index_type arraysize; int which; GFC_INTEGER_4 sh; GFC_INTEGER_4 delta; @@ -76,6 +77,7 @@ eoshift3 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + arraysize = size0 ((array_t *) array); size = GFC_DESCRIPTOR_SIZE(array); if (pwhich) @@ -87,7 +89,7 @@ eoshift3 (gfc_array_char * const restrict ret, { int i; - ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -105,13 +107,26 @@ eoshift3 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } - else + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); } + if (arraysize == 0) + return; extent[0] = 1; count[0] = 0; diff --git a/libgfortran/generated/eoshift3_8.c b/libgfortran/generated/eoshift3_8.c index f745a1d..4af36f7 100644 --- a/libgfortran/generated/eoshift3_8.c +++ b/libgfortran/generated/eoshift3_8.c @@ -66,6 +66,7 @@ eoshift3 (gfc_array_char * const restrict ret, index_type len; index_type n; index_type size; + index_type arraysize; int which; GFC_INTEGER_8 sh; GFC_INTEGER_8 delta; @@ -76,6 +77,7 @@ eoshift3 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + arraysize = size0 ((array_t *) array); size = GFC_DESCRIPTOR_SIZE(array); if (pwhich) @@ -87,7 +89,7 @@ eoshift3 (gfc_array_char * const restrict ret, { int i; - ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -105,13 +107,26 @@ eoshift3 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } - else + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); } + if (arraysize == 0) + return; extent[0] = 1; count[0] = 0; diff --git a/libgfortran/generated/maxloc0_16_i1.c b/libgfortran/generated/maxloc0_16_i1.c index b43f083..c9f58e3 100644 --- a/libgfortran/generated/maxloc0_16_i1.c +++ b/libgfortran/generated/maxloc0_16_i1.c @@ -63,21 +63,8 @@ maxloc0_16_i1 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_16_i1 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_16_i16.c b/libgfortran/generated/maxloc0_16_i16.c index 26941a7..8adbc93 100644 --- a/libgfortran/generated/maxloc0_16_i16.c +++ b/libgfortran/generated/maxloc0_16_i16.c @@ -63,21 +63,8 @@ maxloc0_16_i16 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_16_i16 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_16_i2.c b/libgfortran/generated/maxloc0_16_i2.c index e1d329c..16849c2 100644 --- a/libgfortran/generated/maxloc0_16_i2.c +++ b/libgfortran/generated/maxloc0_16_i2.c @@ -63,21 +63,8 @@ maxloc0_16_i2 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_16_i2 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_16_i4.c b/libgfortran/generated/maxloc0_16_i4.c index 4d1d0a1..a6e979c 100644 --- a/libgfortran/generated/maxloc0_16_i4.c +++ b/libgfortran/generated/maxloc0_16_i4.c @@ -63,21 +63,8 @@ maxloc0_16_i4 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_16_i4 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_16_i8.c b/libgfortran/generated/maxloc0_16_i8.c index 12147a0..8e2d4bc 100644 --- a/libgfortran/generated/maxloc0_16_i8.c +++ b/libgfortran/generated/maxloc0_16_i8.c @@ -63,21 +63,8 @@ maxloc0_16_i8 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_16_i8 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_16_r10.c b/libgfortran/generated/maxloc0_16_r10.c index 33c7308..d76e947 100644 --- a/libgfortran/generated/maxloc0_16_r10.c +++ b/libgfortran/generated/maxloc0_16_r10.c @@ -63,21 +63,8 @@ maxloc0_16_r10 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_16_r10 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_16_r16.c b/libgfortran/generated/maxloc0_16_r16.c index 4f4f290..2e6dcf1 100644 --- a/libgfortran/generated/maxloc0_16_r16.c +++ b/libgfortran/generated/maxloc0_16_r16.c @@ -63,21 +63,8 @@ maxloc0_16_r16 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_16_r16 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_16_r4.c b/libgfortran/generated/maxloc0_16_r4.c index 86cedb3..5d1fe35 100644 --- a/libgfortran/generated/maxloc0_16_r4.c +++ b/libgfortran/generated/maxloc0_16_r4.c @@ -63,21 +63,8 @@ maxloc0_16_r4 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_16_r4 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_16_r8.c b/libgfortran/generated/maxloc0_16_r8.c index 378024b..dc489f3 100644 --- a/libgfortran/generated/maxloc0_16_r8.c +++ b/libgfortran/generated/maxloc0_16_r8.c @@ -63,21 +63,8 @@ maxloc0_16_r8 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_16_r8 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_4_i1.c b/libgfortran/generated/maxloc0_4_i1.c index 7475059..7cdd813 100644 --- a/libgfortran/generated/maxloc0_4_i1.c +++ b/libgfortran/generated/maxloc0_4_i1.c @@ -63,21 +63,8 @@ maxloc0_4_i1 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_4_i1 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_4_i16.c b/libgfortran/generated/maxloc0_4_i16.c index 268f09a..b2bc053 100644 --- a/libgfortran/generated/maxloc0_4_i16.c +++ b/libgfortran/generated/maxloc0_4_i16.c @@ -63,21 +63,8 @@ maxloc0_4_i16 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_4_i16 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_4_i2.c b/libgfortran/generated/maxloc0_4_i2.c index 47fb135..fb3b40b 100644 --- a/libgfortran/generated/maxloc0_4_i2.c +++ b/libgfortran/generated/maxloc0_4_i2.c @@ -63,21 +63,8 @@ maxloc0_4_i2 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_4_i2 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_4_i4.c b/libgfortran/generated/maxloc0_4_i4.c index 55bc275..2a84c7f 100644 --- a/libgfortran/generated/maxloc0_4_i4.c +++ b/libgfortran/generated/maxloc0_4_i4.c @@ -63,21 +63,8 @@ maxloc0_4_i4 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_4_i4 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_4_i8.c b/libgfortran/generated/maxloc0_4_i8.c index f598f05..2e1fa6d 100644 --- a/libgfortran/generated/maxloc0_4_i8.c +++ b/libgfortran/generated/maxloc0_4_i8.c @@ -63,21 +63,8 @@ maxloc0_4_i8 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_4_i8 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_4_r10.c b/libgfortran/generated/maxloc0_4_r10.c index 5c99198..934337a 100644 --- a/libgfortran/generated/maxloc0_4_r10.c +++ b/libgfortran/generated/maxloc0_4_r10.c @@ -63,21 +63,8 @@ maxloc0_4_r10 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_4_r10 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_4_r16.c b/libgfortran/generated/maxloc0_4_r16.c index c7609c3..c266025 100644 --- a/libgfortran/generated/maxloc0_4_r16.c +++ b/libgfortran/generated/maxloc0_4_r16.c @@ -63,21 +63,8 @@ maxloc0_4_r16 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_4_r16 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_4_r4.c b/libgfortran/generated/maxloc0_4_r4.c index 50f3c3b..a349953 100644 --- a/libgfortran/generated/maxloc0_4_r4.c +++ b/libgfortran/generated/maxloc0_4_r4.c @@ -63,21 +63,8 @@ maxloc0_4_r4 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_4_r4 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_4_r8.c b/libgfortran/generated/maxloc0_4_r8.c index 30dc297..7180bf8 100644 --- a/libgfortran/generated/maxloc0_4_r8.c +++ b/libgfortran/generated/maxloc0_4_r8.c @@ -63,21 +63,8 @@ maxloc0_4_r8 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_4_r8 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_8_i1.c b/libgfortran/generated/maxloc0_8_i1.c index eb1737d..a850603 100644 --- a/libgfortran/generated/maxloc0_8_i1.c +++ b/libgfortran/generated/maxloc0_8_i1.c @@ -63,21 +63,8 @@ maxloc0_8_i1 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_8_i1 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_8_i16.c b/libgfortran/generated/maxloc0_8_i16.c index 6690c2d..73683d8 100644 --- a/libgfortran/generated/maxloc0_8_i16.c +++ b/libgfortran/generated/maxloc0_8_i16.c @@ -63,21 +63,8 @@ maxloc0_8_i16 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_8_i16 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_8_i2.c b/libgfortran/generated/maxloc0_8_i2.c index b9bb230..3b8e793 100644 --- a/libgfortran/generated/maxloc0_8_i2.c +++ b/libgfortran/generated/maxloc0_8_i2.c @@ -63,21 +63,8 @@ maxloc0_8_i2 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_8_i2 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_8_i4.c b/libgfortran/generated/maxloc0_8_i4.c index 5778146..1b0bc42b 100644 --- a/libgfortran/generated/maxloc0_8_i4.c +++ b/libgfortran/generated/maxloc0_8_i4.c @@ -63,21 +63,8 @@ maxloc0_8_i4 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_8_i4 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_8_i8.c b/libgfortran/generated/maxloc0_8_i8.c index ef7dede..5bf9520 100644 --- a/libgfortran/generated/maxloc0_8_i8.c +++ b/libgfortran/generated/maxloc0_8_i8.c @@ -63,21 +63,8 @@ maxloc0_8_i8 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_8_i8 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_8_r10.c b/libgfortran/generated/maxloc0_8_r10.c index 0c08d8e..28008d4 100644 --- a/libgfortran/generated/maxloc0_8_r10.c +++ b/libgfortran/generated/maxloc0_8_r10.c @@ -63,21 +63,8 @@ maxloc0_8_r10 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_8_r10 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_8_r16.c b/libgfortran/generated/maxloc0_8_r16.c index da61d2b..04bfd57 100644 --- a/libgfortran/generated/maxloc0_8_r16.c +++ b/libgfortran/generated/maxloc0_8_r16.c @@ -63,21 +63,8 @@ maxloc0_8_r16 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_8_r16 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_8_r4.c b/libgfortran/generated/maxloc0_8_r4.c index a26b110..238b869 100644 --- a/libgfortran/generated/maxloc0_8_r4.c +++ b/libgfortran/generated/maxloc0_8_r4.c @@ -63,21 +63,8 @@ maxloc0_8_r4 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_8_r4 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc0_8_r8.c b/libgfortran/generated/maxloc0_8_r8.c index 1198d62..16d9a45 100644 --- a/libgfortran/generated/maxloc0_8_r8.c +++ b/libgfortran/generated/maxloc0_8_r8.c @@ -63,21 +63,8 @@ maxloc0_8_r8 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mmaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MAXLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } @@ -340,22 +300,10 @@ smaxloc0_8_r8 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MAXLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/maxloc1_16_i1.c b/libgfortran/generated/maxloc1_16_i1.c index a776f4f..9be5cdd 100644 --- a/libgfortran/generated/maxloc1_16_i1.c +++ b/libgfortran/generated/maxloc1_16_i1.c @@ -120,19 +120,8 @@ maxloc1_16_i1 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_16_i16.c b/libgfortran/generated/maxloc1_16_i16.c index 827b3e6..9118f85 100644 --- a/libgfortran/generated/maxloc1_16_i16.c +++ b/libgfortran/generated/maxloc1_16_i16.c @@ -120,19 +120,8 @@ maxloc1_16_i16 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_16_i2.c b/libgfortran/generated/maxloc1_16_i2.c index 24a34e3..66b24b0 100644 --- a/libgfortran/generated/maxloc1_16_i2.c +++ b/libgfortran/generated/maxloc1_16_i2.c @@ -120,19 +120,8 @@ maxloc1_16_i2 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_16_i4.c b/libgfortran/generated/maxloc1_16_i4.c index 0194f28..3f6c952 100644 --- a/libgfortran/generated/maxloc1_16_i4.c +++ b/libgfortran/generated/maxloc1_16_i4.c @@ -120,19 +120,8 @@ maxloc1_16_i4 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_16_i8.c b/libgfortran/generated/maxloc1_16_i8.c index bb17500..141dc51 100644 --- a/libgfortran/generated/maxloc1_16_i8.c +++ b/libgfortran/generated/maxloc1_16_i8.c @@ -120,19 +120,8 @@ maxloc1_16_i8 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_16_r10.c b/libgfortran/generated/maxloc1_16_r10.c index dc8cd5d..74bc4d3 100644 --- a/libgfortran/generated/maxloc1_16_r10.c +++ b/libgfortran/generated/maxloc1_16_r10.c @@ -120,19 +120,8 @@ maxloc1_16_r10 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_16_r16.c b/libgfortran/generated/maxloc1_16_r16.c index 1664edb..cadca8b 100644 --- a/libgfortran/generated/maxloc1_16_r16.c +++ b/libgfortran/generated/maxloc1_16_r16.c @@ -120,19 +120,8 @@ maxloc1_16_r16 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_16_r4.c b/libgfortran/generated/maxloc1_16_r4.c index 58bfcc0..f2afd83 100644 --- a/libgfortran/generated/maxloc1_16_r4.c +++ b/libgfortran/generated/maxloc1_16_r4.c @@ -120,19 +120,8 @@ maxloc1_16_r4 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_16_r8.c b/libgfortran/generated/maxloc1_16_r8.c index d646d25..3da1066 100644 --- a/libgfortran/generated/maxloc1_16_r8.c +++ b/libgfortran/generated/maxloc1_16_r8.c @@ -120,19 +120,8 @@ maxloc1_16_r8 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_4_i1.c b/libgfortran/generated/maxloc1_4_i1.c index 39291ff..3a76e0e 100644 --- a/libgfortran/generated/maxloc1_4_i1.c +++ b/libgfortran/generated/maxloc1_4_i1.c @@ -120,19 +120,8 @@ maxloc1_4_i1 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_4_i16.c b/libgfortran/generated/maxloc1_4_i16.c index 059cacb..7c3bc2d 100644 --- a/libgfortran/generated/maxloc1_4_i16.c +++ b/libgfortran/generated/maxloc1_4_i16.c @@ -120,19 +120,8 @@ maxloc1_4_i16 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_4_i2.c b/libgfortran/generated/maxloc1_4_i2.c index 64cee3e..cdcdfa4 100644 --- a/libgfortran/generated/maxloc1_4_i2.c +++ b/libgfortran/generated/maxloc1_4_i2.c @@ -120,19 +120,8 @@ maxloc1_4_i2 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_4_i4.c b/libgfortran/generated/maxloc1_4_i4.c index f8a843e..bf60007 100644 --- a/libgfortran/generated/maxloc1_4_i4.c +++ b/libgfortran/generated/maxloc1_4_i4.c @@ -120,19 +120,8 @@ maxloc1_4_i4 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_4_i8.c b/libgfortran/generated/maxloc1_4_i8.c index 293c2a9..18edc04 100644 --- a/libgfortran/generated/maxloc1_4_i8.c +++ b/libgfortran/generated/maxloc1_4_i8.c @@ -120,19 +120,8 @@ maxloc1_4_i8 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_4_r10.c b/libgfortran/generated/maxloc1_4_r10.c index 8998279..bae17fe 100644 --- a/libgfortran/generated/maxloc1_4_r10.c +++ b/libgfortran/generated/maxloc1_4_r10.c @@ -120,19 +120,8 @@ maxloc1_4_r10 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_4_r16.c b/libgfortran/generated/maxloc1_4_r16.c index 191ba99..811f01c 100644 --- a/libgfortran/generated/maxloc1_4_r16.c +++ b/libgfortran/generated/maxloc1_4_r16.c @@ -120,19 +120,8 @@ maxloc1_4_r16 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_4_r4.c b/libgfortran/generated/maxloc1_4_r4.c index 1f445e7..065770f 100644 --- a/libgfortran/generated/maxloc1_4_r4.c +++ b/libgfortran/generated/maxloc1_4_r4.c @@ -120,19 +120,8 @@ maxloc1_4_r4 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_4_r8.c b/libgfortran/generated/maxloc1_4_r8.c index 170e3df..e083507 100644 --- a/libgfortran/generated/maxloc1_4_r8.c +++ b/libgfortran/generated/maxloc1_4_r8.c @@ -120,19 +120,8 @@ maxloc1_4_r8 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_8_i1.c b/libgfortran/generated/maxloc1_8_i1.c index 9924b71..b1d1f0e 100644 --- a/libgfortran/generated/maxloc1_8_i1.c +++ b/libgfortran/generated/maxloc1_8_i1.c @@ -120,19 +120,8 @@ maxloc1_8_i1 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_8_i16.c b/libgfortran/generated/maxloc1_8_i16.c index 97946f3..3028b2d 100644 --- a/libgfortran/generated/maxloc1_8_i16.c +++ b/libgfortran/generated/maxloc1_8_i16.c @@ -120,19 +120,8 @@ maxloc1_8_i16 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_8_i2.c b/libgfortran/generated/maxloc1_8_i2.c index d343b0b..74d7fb3 100644 --- a/libgfortran/generated/maxloc1_8_i2.c +++ b/libgfortran/generated/maxloc1_8_i2.c @@ -120,19 +120,8 @@ maxloc1_8_i2 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_8_i4.c b/libgfortran/generated/maxloc1_8_i4.c index 682de41..fcf11b8 100644 --- a/libgfortran/generated/maxloc1_8_i4.c +++ b/libgfortran/generated/maxloc1_8_i4.c @@ -120,19 +120,8 @@ maxloc1_8_i4 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c index e17ecc4..1210fb1 100644 --- a/libgfortran/generated/maxloc1_8_i8.c +++ b/libgfortran/generated/maxloc1_8_i8.c @@ -120,19 +120,8 @@ maxloc1_8_i8 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_8_r10.c b/libgfortran/generated/maxloc1_8_r10.c index cb4b692..e0873d2 100644 --- a/libgfortran/generated/maxloc1_8_r10.c +++ b/libgfortran/generated/maxloc1_8_r10.c @@ -120,19 +120,8 @@ maxloc1_8_r10 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_8_r16.c b/libgfortran/generated/maxloc1_8_r16.c index 5a99daf..83d84c5 100644 --- a/libgfortran/generated/maxloc1_8_r16.c +++ b/libgfortran/generated/maxloc1_8_r16.c @@ -120,19 +120,8 @@ maxloc1_8_r16 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_8_r4.c b/libgfortran/generated/maxloc1_8_r4.c index ba88d8e..94250d3 100644 --- a/libgfortran/generated/maxloc1_8_r4.c +++ b/libgfortran/generated/maxloc1_8_r4.c @@ -120,19 +120,8 @@ maxloc1_8_r4 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxloc1_8_r8.c b/libgfortran/generated/maxloc1_8_r8.c index 6d05b43..4b75978 100644 --- a/libgfortran/generated/maxloc1_8_r8.c +++ b/libgfortran/generated/maxloc1_8_r8.c @@ -120,19 +120,8 @@ maxloc1_8_r8 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mmaxloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXLOC"); } } diff --git a/libgfortran/generated/maxval_i1.c b/libgfortran/generated/maxval_i1.c index 10193fd..cbffa30 100644 --- a/libgfortran/generated/maxval_i1.c +++ b/libgfortran/generated/maxval_i1.c @@ -119,19 +119,8 @@ maxval_i1 (gfc_array_i1 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mmaxval_i1 (gfc_array_i1 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); } } diff --git a/libgfortran/generated/maxval_i16.c b/libgfortran/generated/maxval_i16.c index 884ed66..e0e5341 100644 --- a/libgfortran/generated/maxval_i16.c +++ b/libgfortran/generated/maxval_i16.c @@ -119,19 +119,8 @@ maxval_i16 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mmaxval_i16 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); } } diff --git a/libgfortran/generated/maxval_i2.c b/libgfortran/generated/maxval_i2.c index 3abe657..293a75f 100644 --- a/libgfortran/generated/maxval_i2.c +++ b/libgfortran/generated/maxval_i2.c @@ -119,19 +119,8 @@ maxval_i2 (gfc_array_i2 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mmaxval_i2 (gfc_array_i2 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); } } diff --git a/libgfortran/generated/maxval_i4.c b/libgfortran/generated/maxval_i4.c index 57aea5f..4d105a0 100644 --- a/libgfortran/generated/maxval_i4.c +++ b/libgfortran/generated/maxval_i4.c @@ -119,19 +119,8 @@ maxval_i4 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mmaxval_i4 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); } } diff --git a/libgfortran/generated/maxval_i8.c b/libgfortran/generated/maxval_i8.c index 9d7f57c..2ff1728 100644 --- a/libgfortran/generated/maxval_i8.c +++ b/libgfortran/generated/maxval_i8.c @@ -119,19 +119,8 @@ maxval_i8 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mmaxval_i8 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); } } diff --git a/libgfortran/generated/maxval_r10.c b/libgfortran/generated/maxval_r10.c index 2259e8e..356998b 100644 --- a/libgfortran/generated/maxval_r10.c +++ b/libgfortran/generated/maxval_r10.c @@ -119,19 +119,8 @@ maxval_r10 (gfc_array_r10 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mmaxval_r10 (gfc_array_r10 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); } } diff --git a/libgfortran/generated/maxval_r16.c b/libgfortran/generated/maxval_r16.c index 7efdd65..cf28108 100644 --- a/libgfortran/generated/maxval_r16.c +++ b/libgfortran/generated/maxval_r16.c @@ -119,19 +119,8 @@ maxval_r16 (gfc_array_r16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mmaxval_r16 (gfc_array_r16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); } } diff --git a/libgfortran/generated/maxval_r4.c b/libgfortran/generated/maxval_r4.c index 623c25c..b2541a2 100644 --- a/libgfortran/generated/maxval_r4.c +++ b/libgfortran/generated/maxval_r4.c @@ -119,19 +119,8 @@ maxval_r4 (gfc_array_r4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mmaxval_r4 (gfc_array_r4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); } } diff --git a/libgfortran/generated/maxval_r8.c b/libgfortran/generated/maxval_r8.c index bdbb26f..8eb0b86 100644 --- a/libgfortran/generated/maxval_r8.c +++ b/libgfortran/generated/maxval_r8.c @@ -119,19 +119,8 @@ maxval_r8 (gfc_array_r8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mmaxval_r8 (gfc_array_r8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MAXVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MAXVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MAXVAL"); } } diff --git a/libgfortran/generated/minloc0_16_i1.c b/libgfortran/generated/minloc0_16_i1.c index 961beb9..7a50512 100644 --- a/libgfortran/generated/minloc0_16_i1.c +++ b/libgfortran/generated/minloc0_16_i1.c @@ -63,21 +63,8 @@ minloc0_16_i1 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_16_i1 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_16_i1 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_16_i16.c b/libgfortran/generated/minloc0_16_i16.c index 7303592..cfb4115 100644 --- a/libgfortran/generated/minloc0_16_i16.c +++ b/libgfortran/generated/minloc0_16_i16.c @@ -63,21 +63,8 @@ minloc0_16_i16 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_16_i16 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_16_i16 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_16_i2.c b/libgfortran/generated/minloc0_16_i2.c index ee9f46c..6dbbfbb 100644 --- a/libgfortran/generated/minloc0_16_i2.c +++ b/libgfortran/generated/minloc0_16_i2.c @@ -63,21 +63,8 @@ minloc0_16_i2 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_16_i2 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_16_i2 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_16_i4.c b/libgfortran/generated/minloc0_16_i4.c index 6d07bbe..811ad1f 100644 --- a/libgfortran/generated/minloc0_16_i4.c +++ b/libgfortran/generated/minloc0_16_i4.c @@ -63,21 +63,8 @@ minloc0_16_i4 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_16_i4 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_16_i4 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_16_i8.c b/libgfortran/generated/minloc0_16_i8.c index bbacc11..583f489 100644 --- a/libgfortran/generated/minloc0_16_i8.c +++ b/libgfortran/generated/minloc0_16_i8.c @@ -63,21 +63,8 @@ minloc0_16_i8 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_16_i8 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_16_i8 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_16_r10.c b/libgfortran/generated/minloc0_16_r10.c index a77efcd..fa29e93 100644 --- a/libgfortran/generated/minloc0_16_r10.c +++ b/libgfortran/generated/minloc0_16_r10.c @@ -63,21 +63,8 @@ minloc0_16_r10 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_16_r10 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_16_r10 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_16_r16.c b/libgfortran/generated/minloc0_16_r16.c index 1d29e07..304ca7e 100644 --- a/libgfortran/generated/minloc0_16_r16.c +++ b/libgfortran/generated/minloc0_16_r16.c @@ -63,21 +63,8 @@ minloc0_16_r16 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_16_r16 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_16_r16 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_16_r4.c b/libgfortran/generated/minloc0_16_r4.c index 1c451e9..0ce5e08 100644 --- a/libgfortran/generated/minloc0_16_r4.c +++ b/libgfortran/generated/minloc0_16_r4.c @@ -63,21 +63,8 @@ minloc0_16_r4 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_16_r4 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_16_r4 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_16_r8.c b/libgfortran/generated/minloc0_16_r8.c index d6c7086..8346be1 100644 --- a/libgfortran/generated/minloc0_16_r8.c +++ b/libgfortran/generated/minloc0_16_r8.c @@ -63,21 +63,8 @@ minloc0_16_r8 (gfc_array_i16 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_16_r8 (gfc_array_i16 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_16_r8 (gfc_array_i16 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_4_i1.c b/libgfortran/generated/minloc0_4_i1.c index 418eb30d..3a0b22b 100644 --- a/libgfortran/generated/minloc0_4_i1.c +++ b/libgfortran/generated/minloc0_4_i1.c @@ -63,21 +63,8 @@ minloc0_4_i1 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_4_i1 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_4_i1 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_4_i16.c b/libgfortran/generated/minloc0_4_i16.c index 9a23b27..cd947eb 100644 --- a/libgfortran/generated/minloc0_4_i16.c +++ b/libgfortran/generated/minloc0_4_i16.c @@ -63,21 +63,8 @@ minloc0_4_i16 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_4_i16 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_4_i16 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_4_i2.c b/libgfortran/generated/minloc0_4_i2.c index df081ac..6d65cfb 100644 --- a/libgfortran/generated/minloc0_4_i2.c +++ b/libgfortran/generated/minloc0_4_i2.c @@ -63,21 +63,8 @@ minloc0_4_i2 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_4_i2 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_4_i2 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_4_i4.c b/libgfortran/generated/minloc0_4_i4.c index b076dcf..938d2e4 100644 --- a/libgfortran/generated/minloc0_4_i4.c +++ b/libgfortran/generated/minloc0_4_i4.c @@ -63,21 +63,8 @@ minloc0_4_i4 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_4_i4 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_4_i4 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_4_i8.c b/libgfortran/generated/minloc0_4_i8.c index 944694c..b64024e 100644 --- a/libgfortran/generated/minloc0_4_i8.c +++ b/libgfortran/generated/minloc0_4_i8.c @@ -63,21 +63,8 @@ minloc0_4_i8 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_4_i8 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_4_i8 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_4_r10.c b/libgfortran/generated/minloc0_4_r10.c index 03b8fd4..e130e21 100644 --- a/libgfortran/generated/minloc0_4_r10.c +++ b/libgfortran/generated/minloc0_4_r10.c @@ -63,21 +63,8 @@ minloc0_4_r10 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_4_r10 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_4_r10 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_4_r16.c b/libgfortran/generated/minloc0_4_r16.c index 88059c6..45ccb61 100644 --- a/libgfortran/generated/minloc0_4_r16.c +++ b/libgfortran/generated/minloc0_4_r16.c @@ -63,21 +63,8 @@ minloc0_4_r16 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_4_r16 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_4_r16 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_4_r4.c b/libgfortran/generated/minloc0_4_r4.c index 0b1e642..6d8f74e 100644 --- a/libgfortran/generated/minloc0_4_r4.c +++ b/libgfortran/generated/minloc0_4_r4.c @@ -63,21 +63,8 @@ minloc0_4_r4 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_4_r4 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_4_r4 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_4_r8.c b/libgfortran/generated/minloc0_4_r8.c index a6843b1..eb01e68 100644 --- a/libgfortran/generated/minloc0_4_r8.c +++ b/libgfortran/generated/minloc0_4_r8.c @@ -63,21 +63,8 @@ minloc0_4_r8 (gfc_array_i4 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_4_r8 (gfc_array_i4 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_4_r8 (gfc_array_i4 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_8_i1.c b/libgfortran/generated/minloc0_8_i1.c index 5617aff..d4924e4 100644 --- a/libgfortran/generated/minloc0_8_i1.c +++ b/libgfortran/generated/minloc0_8_i1.c @@ -63,21 +63,8 @@ minloc0_8_i1 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_8_i1 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_8_i1 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_8_i16.c b/libgfortran/generated/minloc0_8_i16.c index bc2454a..dad459a 100644 --- a/libgfortran/generated/minloc0_8_i16.c +++ b/libgfortran/generated/minloc0_8_i16.c @@ -63,21 +63,8 @@ minloc0_8_i16 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_8_i16 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_8_i16 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_8_i2.c b/libgfortran/generated/minloc0_8_i2.c index 198c9b9..20cb1f2 100644 --- a/libgfortran/generated/minloc0_8_i2.c +++ b/libgfortran/generated/minloc0_8_i2.c @@ -63,21 +63,8 @@ minloc0_8_i2 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_8_i2 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_8_i2 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_8_i4.c b/libgfortran/generated/minloc0_8_i4.c index c62fbcb..ca02f4f 100644 --- a/libgfortran/generated/minloc0_8_i4.c +++ b/libgfortran/generated/minloc0_8_i4.c @@ -63,21 +63,8 @@ minloc0_8_i4 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_8_i4 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_8_i4 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_8_i8.c b/libgfortran/generated/minloc0_8_i8.c index ffc7900..dffaec6 100644 --- a/libgfortran/generated/minloc0_8_i8.c +++ b/libgfortran/generated/minloc0_8_i8.c @@ -63,21 +63,8 @@ minloc0_8_i8 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_8_i8 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_8_i8 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_8_r10.c b/libgfortran/generated/minloc0_8_r10.c index 68eb7b6..fe31ea9 100644 --- a/libgfortran/generated/minloc0_8_r10.c +++ b/libgfortran/generated/minloc0_8_r10.c @@ -63,21 +63,8 @@ minloc0_8_r10 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_8_r10 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_8_r10 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_8_r16.c b/libgfortran/generated/minloc0_8_r16.c index da7ae06..365403c 100644 --- a/libgfortran/generated/minloc0_8_r16.c +++ b/libgfortran/generated/minloc0_8_r16.c @@ -63,21 +63,8 @@ minloc0_8_r16 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_8_r16 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_8_r16 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_8_r4.c b/libgfortran/generated/minloc0_8_r4.c index fbf5bab..53c89b1 100644 --- a/libgfortran/generated/minloc0_8_r4.c +++ b/libgfortran/generated/minloc0_8_r4.c @@ -63,21 +63,8 @@ minloc0_8_r4 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_8_r4 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_8_r4 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc0_8_r8.c b/libgfortran/generated/minloc0_8_r8.c index 2dd4cfd..ab553b2 100644 --- a/libgfortran/generated/minloc0_8_r8.c +++ b/libgfortran/generated/minloc0_8_r8.c @@ -63,21 +63,8 @@ minloc0_8_r8 (gfc_array_i8 * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -186,38 +173,11 @@ mminloc0_8_r8 (gfc_array_i8 * const restrict retarray, { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in MINLOC intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } @@ -340,22 +300,10 @@ sminloc0_8_r8 (gfc_array_i8 * const restrict retarray, retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "MINLOC"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/generated/minloc1_16_i1.c b/libgfortran/generated/minloc1_16_i1.c index 5a5ff5e..9177230 100644 --- a/libgfortran/generated/minloc1_16_i1.c +++ b/libgfortran/generated/minloc1_16_i1.c @@ -120,19 +120,8 @@ minloc1_16_i1 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_16_i1 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_16_i16.c b/libgfortran/generated/minloc1_16_i16.c index 25d4ceaa..5ffebe2 100644 --- a/libgfortran/generated/minloc1_16_i16.c +++ b/libgfortran/generated/minloc1_16_i16.c @@ -120,19 +120,8 @@ minloc1_16_i16 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_16_i16 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_16_i2.c b/libgfortran/generated/minloc1_16_i2.c index 228a582..f1110c1 100644 --- a/libgfortran/generated/minloc1_16_i2.c +++ b/libgfortran/generated/minloc1_16_i2.c @@ -120,19 +120,8 @@ minloc1_16_i2 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_16_i2 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_16_i4.c b/libgfortran/generated/minloc1_16_i4.c index c865272..86c0acf 100644 --- a/libgfortran/generated/minloc1_16_i4.c +++ b/libgfortran/generated/minloc1_16_i4.c @@ -120,19 +120,8 @@ minloc1_16_i4 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_16_i4 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_16_i8.c b/libgfortran/generated/minloc1_16_i8.c index fa12444..7e965be 100644 --- a/libgfortran/generated/minloc1_16_i8.c +++ b/libgfortran/generated/minloc1_16_i8.c @@ -120,19 +120,8 @@ minloc1_16_i8 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_16_i8 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_16_r10.c b/libgfortran/generated/minloc1_16_r10.c index 15862a8..e574626 100644 --- a/libgfortran/generated/minloc1_16_r10.c +++ b/libgfortran/generated/minloc1_16_r10.c @@ -120,19 +120,8 @@ minloc1_16_r10 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_16_r10 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_16_r16.c b/libgfortran/generated/minloc1_16_r16.c index f0b452f..08815d3 100644 --- a/libgfortran/generated/minloc1_16_r16.c +++ b/libgfortran/generated/minloc1_16_r16.c @@ -120,19 +120,8 @@ minloc1_16_r16 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_16_r16 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_16_r4.c b/libgfortran/generated/minloc1_16_r4.c index 692259d..7f2967d 100644 --- a/libgfortran/generated/minloc1_16_r4.c +++ b/libgfortran/generated/minloc1_16_r4.c @@ -120,19 +120,8 @@ minloc1_16_r4 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_16_r4 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_16_r8.c b/libgfortran/generated/minloc1_16_r8.c index c0189da..4d6fa8b 100644 --- a/libgfortran/generated/minloc1_16_r8.c +++ b/libgfortran/generated/minloc1_16_r8.c @@ -120,19 +120,8 @@ minloc1_16_r8 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_16_r8 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_4_i1.c b/libgfortran/generated/minloc1_4_i1.c index 164f7ec..107ebea 100644 --- a/libgfortran/generated/minloc1_4_i1.c +++ b/libgfortran/generated/minloc1_4_i1.c @@ -120,19 +120,8 @@ minloc1_4_i1 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_4_i1 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_4_i16.c b/libgfortran/generated/minloc1_4_i16.c index 899f202..b84c524 100644 --- a/libgfortran/generated/minloc1_4_i16.c +++ b/libgfortran/generated/minloc1_4_i16.c @@ -120,19 +120,8 @@ minloc1_4_i16 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_4_i16 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_4_i2.c b/libgfortran/generated/minloc1_4_i2.c index f900506..641b15d 100644 --- a/libgfortran/generated/minloc1_4_i2.c +++ b/libgfortran/generated/minloc1_4_i2.c @@ -120,19 +120,8 @@ minloc1_4_i2 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_4_i2 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_4_i4.c b/libgfortran/generated/minloc1_4_i4.c index 7dedb8f..c1daa57 100644 --- a/libgfortran/generated/minloc1_4_i4.c +++ b/libgfortran/generated/minloc1_4_i4.c @@ -120,19 +120,8 @@ minloc1_4_i4 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_4_i4 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_4_i8.c b/libgfortran/generated/minloc1_4_i8.c index 70eaefa..2229fc4 100644 --- a/libgfortran/generated/minloc1_4_i8.c +++ b/libgfortran/generated/minloc1_4_i8.c @@ -120,19 +120,8 @@ minloc1_4_i8 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_4_i8 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_4_r10.c b/libgfortran/generated/minloc1_4_r10.c index 1a0bdfa..ade388b 100644 --- a/libgfortran/generated/minloc1_4_r10.c +++ b/libgfortran/generated/minloc1_4_r10.c @@ -120,19 +120,8 @@ minloc1_4_r10 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_4_r10 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_4_r16.c b/libgfortran/generated/minloc1_4_r16.c index b8849a5..e6cf58b 100644 --- a/libgfortran/generated/minloc1_4_r16.c +++ b/libgfortran/generated/minloc1_4_r16.c @@ -120,19 +120,8 @@ minloc1_4_r16 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_4_r16 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_4_r4.c b/libgfortran/generated/minloc1_4_r4.c index cc382db..6aa2304 100644 --- a/libgfortran/generated/minloc1_4_r4.c +++ b/libgfortran/generated/minloc1_4_r4.c @@ -120,19 +120,8 @@ minloc1_4_r4 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_4_r4 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_4_r8.c b/libgfortran/generated/minloc1_4_r8.c index c36567f..ccc93f5 100644 --- a/libgfortran/generated/minloc1_4_r8.c +++ b/libgfortran/generated/minloc1_4_r8.c @@ -120,19 +120,8 @@ minloc1_4_r8 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_4_r8 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_8_i1.c b/libgfortran/generated/minloc1_8_i1.c index 6e46c82..86003e5 100644 --- a/libgfortran/generated/minloc1_8_i1.c +++ b/libgfortran/generated/minloc1_8_i1.c @@ -120,19 +120,8 @@ minloc1_8_i1 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_8_i1 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_8_i16.c b/libgfortran/generated/minloc1_8_i16.c index 8e8410a..8dab74c 100644 --- a/libgfortran/generated/minloc1_8_i16.c +++ b/libgfortran/generated/minloc1_8_i16.c @@ -120,19 +120,8 @@ minloc1_8_i16 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_8_i16 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_8_i2.c b/libgfortran/generated/minloc1_8_i2.c index 2a33e3c..ba76fc1 100644 --- a/libgfortran/generated/minloc1_8_i2.c +++ b/libgfortran/generated/minloc1_8_i2.c @@ -120,19 +120,8 @@ minloc1_8_i2 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_8_i2 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_8_i4.c b/libgfortran/generated/minloc1_8_i4.c index 70cdef6..03b57de 100644 --- a/libgfortran/generated/minloc1_8_i4.c +++ b/libgfortran/generated/minloc1_8_i4.c @@ -120,19 +120,8 @@ minloc1_8_i4 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_8_i4 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_8_i8.c b/libgfortran/generated/minloc1_8_i8.c index c1a01e9..dc1c1ff 100644 --- a/libgfortran/generated/minloc1_8_i8.c +++ b/libgfortran/generated/minloc1_8_i8.c @@ -120,19 +120,8 @@ minloc1_8_i8 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_8_i8 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_8_r10.c b/libgfortran/generated/minloc1_8_r10.c index b5a6c8d..15f2254 100644 --- a/libgfortran/generated/minloc1_8_r10.c +++ b/libgfortran/generated/minloc1_8_r10.c @@ -120,19 +120,8 @@ minloc1_8_r10 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_8_r10 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_8_r16.c b/libgfortran/generated/minloc1_8_r16.c index 0f4b036..64d1b26 100644 --- a/libgfortran/generated/minloc1_8_r16.c +++ b/libgfortran/generated/minloc1_8_r16.c @@ -120,19 +120,8 @@ minloc1_8_r16 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_8_r16 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_8_r4.c b/libgfortran/generated/minloc1_8_r4.c index 300b5be..0097788 100644 --- a/libgfortran/generated/minloc1_8_r4.c +++ b/libgfortran/generated/minloc1_8_r4.c @@ -120,19 +120,8 @@ minloc1_8_r4 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_8_r4 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minloc1_8_r8.c b/libgfortran/generated/minloc1_8_r8.c index da498f6..0535914 100644 --- a/libgfortran/generated/minloc1_8_r8.c +++ b/libgfortran/generated/minloc1_8_r8.c @@ -120,19 +120,8 @@ minloc1_8_r8 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); } for (n = 0; n < rank; n++) @@ -313,29 +302,10 @@ mminloc1_8_r8 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINLOC intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINLOC"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINLOC"); } } diff --git a/libgfortran/generated/minval_i1.c b/libgfortran/generated/minval_i1.c index 437232a..3f1c0a5 100644 --- a/libgfortran/generated/minval_i1.c +++ b/libgfortran/generated/minval_i1.c @@ -119,19 +119,8 @@ minval_i1 (gfc_array_i1 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mminval_i1 (gfc_array_i1 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); } } diff --git a/libgfortran/generated/minval_i16.c b/libgfortran/generated/minval_i16.c index f0bd16f..6d0f20a 100644 --- a/libgfortran/generated/minval_i16.c +++ b/libgfortran/generated/minval_i16.c @@ -119,19 +119,8 @@ minval_i16 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mminval_i16 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); } } diff --git a/libgfortran/generated/minval_i2.c b/libgfortran/generated/minval_i2.c index 08fd3a6..c09e453 100644 --- a/libgfortran/generated/minval_i2.c +++ b/libgfortran/generated/minval_i2.c @@ -119,19 +119,8 @@ minval_i2 (gfc_array_i2 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mminval_i2 (gfc_array_i2 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); } } diff --git a/libgfortran/generated/minval_i4.c b/libgfortran/generated/minval_i4.c index d7e1ef9..72c6370 100644 --- a/libgfortran/generated/minval_i4.c +++ b/libgfortran/generated/minval_i4.c @@ -119,19 +119,8 @@ minval_i4 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mminval_i4 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); } } diff --git a/libgfortran/generated/minval_i8.c b/libgfortran/generated/minval_i8.c index 7b6fdc5..fbdcec9 100644 --- a/libgfortran/generated/minval_i8.c +++ b/libgfortran/generated/minval_i8.c @@ -119,19 +119,8 @@ minval_i8 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mminval_i8 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); } } diff --git a/libgfortran/generated/minval_r10.c b/libgfortran/generated/minval_r10.c index 1f6a75f..8e1ba75 100644 --- a/libgfortran/generated/minval_r10.c +++ b/libgfortran/generated/minval_r10.c @@ -119,19 +119,8 @@ minval_r10 (gfc_array_r10 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mminval_r10 (gfc_array_r10 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); } } diff --git a/libgfortran/generated/minval_r16.c b/libgfortran/generated/minval_r16.c index 555d86f..b028029 100644 --- a/libgfortran/generated/minval_r16.c +++ b/libgfortran/generated/minval_r16.c @@ -119,19 +119,8 @@ minval_r16 (gfc_array_r16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mminval_r16 (gfc_array_r16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); } } diff --git a/libgfortran/generated/minval_r4.c b/libgfortran/generated/minval_r4.c index a7f729e..d023684 100644 --- a/libgfortran/generated/minval_r4.c +++ b/libgfortran/generated/minval_r4.c @@ -119,19 +119,8 @@ minval_r4 (gfc_array_r4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mminval_r4 (gfc_array_r4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); } } diff --git a/libgfortran/generated/minval_r8.c b/libgfortran/generated/minval_r8.c index 69afca1..a86ce94 100644 --- a/libgfortran/generated/minval_r8.c +++ b/libgfortran/generated/minval_r8.c @@ -119,19 +119,8 @@ minval_r8 (gfc_array_r8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); } for (n = 0; n < rank; n++) @@ -307,29 +296,10 @@ mminval_r8 (gfc_array_r8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " MINVAL intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "MINVAL"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "MINVAL"); } } diff --git a/libgfortran/generated/product_c10.c b/libgfortran/generated/product_c10.c index 69f7f8b..1f834f8 100644 --- a/libgfortran/generated/product_c10.c +++ b/libgfortran/generated/product_c10.c @@ -119,19 +119,8 @@ product_c10 (gfc_array_c10 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_c10 (gfc_array_c10 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_c16.c b/libgfortran/generated/product_c16.c index efaed2c..20119fa 100644 --- a/libgfortran/generated/product_c16.c +++ b/libgfortran/generated/product_c16.c @@ -119,19 +119,8 @@ product_c16 (gfc_array_c16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_c16 (gfc_array_c16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c index 505647e..231947f 100644 --- a/libgfortran/generated/product_c4.c +++ b/libgfortran/generated/product_c4.c @@ -119,19 +119,8 @@ product_c4 (gfc_array_c4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_c4 (gfc_array_c4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_c8.c b/libgfortran/generated/product_c8.c index 16c776a..e6f8dbb 100644 --- a/libgfortran/generated/product_c8.c +++ b/libgfortran/generated/product_c8.c @@ -119,19 +119,8 @@ product_c8 (gfc_array_c8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_c8 (gfc_array_c8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_i1.c b/libgfortran/generated/product_i1.c index cbc1ab1..4f9b5eb 100644 --- a/libgfortran/generated/product_i1.c +++ b/libgfortran/generated/product_i1.c @@ -119,19 +119,8 @@ product_i1 (gfc_array_i1 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_i1 (gfc_array_i1 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_i16.c b/libgfortran/generated/product_i16.c index e3b8c2a0..a23a96a 100644 --- a/libgfortran/generated/product_i16.c +++ b/libgfortran/generated/product_i16.c @@ -119,19 +119,8 @@ product_i16 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_i16 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_i2.c b/libgfortran/generated/product_i2.c index 507d956..40bbe72 100644 --- a/libgfortran/generated/product_i2.c +++ b/libgfortran/generated/product_i2.c @@ -119,19 +119,8 @@ product_i2 (gfc_array_i2 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_i2 (gfc_array_i2 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_i4.c b/libgfortran/generated/product_i4.c index d5af367..0510fca 100644 --- a/libgfortran/generated/product_i4.c +++ b/libgfortran/generated/product_i4.c @@ -119,19 +119,8 @@ product_i4 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_i4 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_i8.c b/libgfortran/generated/product_i8.c index 3308d91..b9bce58 100644 --- a/libgfortran/generated/product_i8.c +++ b/libgfortran/generated/product_i8.c @@ -119,19 +119,8 @@ product_i8 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_i8 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_r10.c b/libgfortran/generated/product_r10.c index 7bae904..afbf756 100644 --- a/libgfortran/generated/product_r10.c +++ b/libgfortran/generated/product_r10.c @@ -119,19 +119,8 @@ product_r10 (gfc_array_r10 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_r10 (gfc_array_r10 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_r16.c b/libgfortran/generated/product_r16.c index bb67872..1b0723e 100644 --- a/libgfortran/generated/product_r16.c +++ b/libgfortran/generated/product_r16.c @@ -119,19 +119,8 @@ product_r16 (gfc_array_r16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_r16 (gfc_array_r16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_r4.c b/libgfortran/generated/product_r4.c index 333c13d..2f5a891 100644 --- a/libgfortran/generated/product_r4.c +++ b/libgfortran/generated/product_r4.c @@ -119,19 +119,8 @@ product_r4 (gfc_array_r4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_r4 (gfc_array_r4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/product_r8.c b/libgfortran/generated/product_r8.c index 46258c0..88c49ff 100644 --- a/libgfortran/generated/product_r8.c +++ b/libgfortran/generated/product_r8.c @@ -119,19 +119,8 @@ product_r8 (gfc_array_r8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ mproduct_r8 (gfc_array_r8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " PRODUCT intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "PRODUCT"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "PRODUCT"); } } diff --git a/libgfortran/generated/sum_c10.c b/libgfortran/generated/sum_c10.c index c63bc69..9e32c86 100644 --- a/libgfortran/generated/sum_c10.c +++ b/libgfortran/generated/sum_c10.c @@ -119,19 +119,8 @@ sum_c10 (gfc_array_c10 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_c10 (gfc_array_c10 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_c16.c b/libgfortran/generated/sum_c16.c index 9871d2d..ade7d76 100644 --- a/libgfortran/generated/sum_c16.c +++ b/libgfortran/generated/sum_c16.c @@ -119,19 +119,8 @@ sum_c16 (gfc_array_c16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_c16 (gfc_array_c16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c index 920a6fb..ac37cc8 100644 --- a/libgfortran/generated/sum_c4.c +++ b/libgfortran/generated/sum_c4.c @@ -119,19 +119,8 @@ sum_c4 (gfc_array_c4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_c4 (gfc_array_c4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_c8.c b/libgfortran/generated/sum_c8.c index c3e7923..91db496 100644 --- a/libgfortran/generated/sum_c8.c +++ b/libgfortran/generated/sum_c8.c @@ -119,19 +119,8 @@ sum_c8 (gfc_array_c8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_c8 (gfc_array_c8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_i1.c b/libgfortran/generated/sum_i1.c index 913d732..b6e1090 100644 --- a/libgfortran/generated/sum_i1.c +++ b/libgfortran/generated/sum_i1.c @@ -119,19 +119,8 @@ sum_i1 (gfc_array_i1 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_i1 (gfc_array_i1 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_i16.c b/libgfortran/generated/sum_i16.c index 060d45a..481ef8e 100644 --- a/libgfortran/generated/sum_i16.c +++ b/libgfortran/generated/sum_i16.c @@ -119,19 +119,8 @@ sum_i16 (gfc_array_i16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_i16 (gfc_array_i16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_i2.c b/libgfortran/generated/sum_i2.c index 5318283..a0d9789 100644 --- a/libgfortran/generated/sum_i2.c +++ b/libgfortran/generated/sum_i2.c @@ -119,19 +119,8 @@ sum_i2 (gfc_array_i2 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_i2 (gfc_array_i2 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_i4.c b/libgfortran/generated/sum_i4.c index e8c60c3..06f2dee 100644 --- a/libgfortran/generated/sum_i4.c +++ b/libgfortran/generated/sum_i4.c @@ -119,19 +119,8 @@ sum_i4 (gfc_array_i4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_i4 (gfc_array_i4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_i8.c b/libgfortran/generated/sum_i8.c index 9ee3e93..9171c4c 100644 --- a/libgfortran/generated/sum_i8.c +++ b/libgfortran/generated/sum_i8.c @@ -119,19 +119,8 @@ sum_i8 (gfc_array_i8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_i8 (gfc_array_i8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_r10.c b/libgfortran/generated/sum_r10.c index 6a28304..8d12212 100644 --- a/libgfortran/generated/sum_r10.c +++ b/libgfortran/generated/sum_r10.c @@ -119,19 +119,8 @@ sum_r10 (gfc_array_r10 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_r10 (gfc_array_r10 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_r16.c b/libgfortran/generated/sum_r16.c index 35296c1..2cd6150 100644 --- a/libgfortran/generated/sum_r16.c +++ b/libgfortran/generated/sum_r16.c @@ -119,19 +119,8 @@ sum_r16 (gfc_array_r16 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_r16 (gfc_array_r16 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_r4.c b/libgfortran/generated/sum_r4.c index e7e2fe3..b8a5e68 100644 --- a/libgfortran/generated/sum_r4.c +++ b/libgfortran/generated/sum_r4.c @@ -119,19 +119,8 @@ sum_r4 (gfc_array_r4 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_r4 (gfc_array_r4 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/generated/sum_r8.c b/libgfortran/generated/sum_r8.c index 86ae109..da9cec2 100644 --- a/libgfortran/generated/sum_r8.c +++ b/libgfortran/generated/sum_r8.c @@ -119,19 +119,8 @@ sum_r8 (gfc_array_r8 * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); } for (n = 0; n < rank; n++) @@ -306,29 +295,10 @@ msum_r8 (gfc_array_r8 * const restrict retarray, if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " SUM intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "SUM"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "SUM"); } } diff --git a/libgfortran/intrinsics/cshift0.c b/libgfortran/intrinsics/cshift0.c index 1b7dbc1c..6adea76 100644 --- a/libgfortran/intrinsics/cshift0.c +++ b/libgfortran/intrinsics/cshift0.c @@ -87,14 +87,17 @@ cshift0 (gfc_array_char * ret, const gfc_array_char * array, if (arraysize > 0) ret->data = internal_malloc_size (size * arraysize); else - { - ret->data = internal_malloc_size (1); - return; - } + ret->data = internal_malloc_size (1); } - + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + if (arraysize == 0) return; + type_size = GFC_DTYPE_TYPE_SIZE (array); switch(type_size) diff --git a/libgfortran/intrinsics/eoshift0.c b/libgfortran/intrinsics/eoshift0.c index 4b8082f..74ba5ab 100644 --- a/libgfortran/intrinsics/eoshift0.c +++ b/libgfortran/intrinsics/eoshift0.c @@ -54,6 +54,7 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, index_type dim; index_type len; index_type n; + index_type arraysize; /* The compiler cannot figure out that these are set, initialize them to avoid warnings. */ @@ -61,11 +62,12 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, soffset = 0; roffset = 0; + arraysize = size0 ((array_t *) array); + if (ret->data == NULL) { int i; - ret->data = internal_malloc_size (size * size0 ((array_t *)array)); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -83,13 +85,22 @@ eoshift0 (gfc_array_char * ret, const gfc_array_char * array, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } + + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } - else + else if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); } + if (arraysize == 0) + return; + which = which - 1; extent[0] = 1; diff --git a/libgfortran/intrinsics/eoshift2.c b/libgfortran/intrinsics/eoshift2.c index aa5ef5a..2fbf62e 100644 --- a/libgfortran/intrinsics/eoshift2.c +++ b/libgfortran/intrinsics/eoshift2.c @@ -75,7 +75,6 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, { int i; - ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -92,15 +91,20 @@ eoshift2 (gfc_array_char *ret, const gfc_array_char *array, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } } - else + else if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); } - if (arraysize == 0 && filler == NULL) + if (arraysize == 0) return; which = which - 1; diff --git a/libgfortran/libgfortran.h b/libgfortran/libgfortran.h index 517ee76..acb02c4 100644 --- a/libgfortran/libgfortran.h +++ b/libgfortran/libgfortran.h @@ -1242,6 +1242,23 @@ typedef GFC_ARRAY_DESCRIPTOR (GFC_MAX_DIMENSIONS, void) array_t; extern index_type size0 (const array_t * array); iexport_proto(size0); +/* bounds.c */ + +extern void bounds_equal_extents (array_t *, array_t *, const char *, + const char *); +internal_proto(bounds_equal_extents); + +extern void bounds_reduced_extents (array_t *, array_t *, int, const char *, + const char *intrinsic); +internal_proto(bounds_reduced_extents); + +extern void bounds_iforeach_return (array_t *, array_t *, const char *); +internal_proto(bounds_iforeach_return); + +extern void bounds_ifunction_return (array_t *, const index_type *, + const char *, const char *); +internal_proto(bounds_ifunction_return); + /* Internal auxiliary functions for cshift */ void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int); diff --git a/libgfortran/m4/cshift1.m4 b/libgfortran/m4/cshift1.m4 index 22b6185..49a4f73 100644 --- a/libgfortran/m4/cshift1.m4 +++ b/libgfortran/m4/cshift1.m4 @@ -99,6 +99,17 @@ cshift1 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } } + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "CSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "CSHIFT"); + } if (arraysize == 0) return; diff --git a/libgfortran/m4/eoshift1.m4 b/libgfortran/m4/eoshift1.m4 index 831277c..be9b100 100644 --- a/libgfortran/m4/eoshift1.m4 +++ b/libgfortran/m4/eoshift1.m4 @@ -63,6 +63,7 @@ eoshift1 (gfc_array_char * const restrict ret, index_type len; index_type n; index_type size; + index_type arraysize; int which; 'atype_name` sh; 'atype_name` delta; @@ -83,11 +84,12 @@ eoshift1 (gfc_array_char * const restrict ret, extent[0] = 1; count[0] = 0; + arraysize = size0 ((array_t *) array); if (ret->data == NULL) { int i; - ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -105,13 +107,27 @@ eoshift1 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } - else + else if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); } + if (unlikely (compile_options.bounds_check)) + { + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); + } + + if (arraysize == 0) + return; + n = 0; for (dim = 0; dim < GFC_DESCRIPTOR_RANK (array); dim++) { diff --git a/libgfortran/m4/eoshift3.m4 b/libgfortran/m4/eoshift3.m4 index e6b2959..6fa3bd2 100644 --- a/libgfortran/m4/eoshift3.m4 +++ b/libgfortran/m4/eoshift3.m4 @@ -67,6 +67,7 @@ eoshift3 (gfc_array_char * const restrict ret, index_type len; index_type n; index_type size; + index_type arraysize; int which; 'atype_name` sh; 'atype_name` delta; @@ -77,6 +78,7 @@ eoshift3 (gfc_array_char * const restrict ret, soffset = 0; roffset = 0; + arraysize = size0 ((array_t *) array); size = GFC_DESCRIPTOR_SIZE(array); if (pwhich) @@ -88,7 +90,7 @@ eoshift3 (gfc_array_char * const restrict ret, { int i; - ret->data = internal_malloc_size (size * size0 ((array_t *)array)); + ret->data = internal_malloc_size (size * arraysize); ret->offset = 0; ret->dtype = array->dtype; for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++) @@ -106,13 +108,26 @@ eoshift3 (gfc_array_char * const restrict ret, GFC_DIMENSION_SET(ret->dim[i], 0, ub, str); } + if (arraysize > 0) + ret->data = internal_malloc_size (size * arraysize); + else + ret->data = internal_malloc_size (1); + } - else + else if (unlikely (compile_options.bounds_check)) + { + bounds_equal_extents ((array_t *) ret, (array_t *) array, + "return value", "EOSHIFT"); + } + + if (unlikely (compile_options.bounds_check)) { - if (size0 ((array_t *) ret) == 0) - return; + bounds_reduced_extents ((array_t *) h, (array_t *) array, which, + "SHIFT argument", "EOSHIFT"); } + if (arraysize == 0) + return; extent[0] = 1; count[0] = 0; diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4 index 0960d22..d86d298 100644 --- a/libgfortran/m4/iforeach.m4 +++ b/libgfortran/m4/iforeach.m4 @@ -35,21 +35,8 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, else { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " u_name intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "u_name"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); @@ -150,38 +137,11 @@ void { if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("Incorrect extent in return value of" - " u_name intrnisic: is %ld, should be %ld", - (long int) ret_extent, (long int) rank); - - mask_rank = GFC_DESCRIPTOR_RANK (mask); - if (rank != mask_rank) - runtime_error ("rank of MASK argument in u_name intrnisic" - "should be %ld, is %ld", (long int) rank, - (long int) mask_rank); - for (n=0; n<rank; n++) - { - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " u_name intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "u_name"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "u_name"); } } @@ -303,22 +263,10 @@ void retarray->offset = 0; retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); } - else + else if (unlikely (compile_options.bounds_check)) { - if (unlikely (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 %ld", (long int) ret_rank); - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); - if (ret_extent != rank) - runtime_error ("dimension of return array incorrect"); - } + bounds_iforeach_return ((array_t *) retarray, (array_t *) array, + "u_name"); } dstride = GFC_DESCRIPTOR_STRIDE(retarray,0); diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4 index 6785eb3..66b1d98 100644 --- a/libgfortran/m4/ifunction.m4 +++ b/libgfortran/m4/ifunction.m4 @@ -107,19 +107,8 @@ name`'rtype_qual`_'atype_code (rtype * const restrict retarray, (long int) rank); if (unlikely (compile_options.bounds_check)) - { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " u_name intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "u_name"); } for (n = 0; n < rank; n++) @@ -294,29 +283,10 @@ void if (unlikely (compile_options.bounds_check)) { - for (n=0; n < rank; n++) - { - index_type ret_extent; - - ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n); - if (extent[n] != ret_extent) - runtime_error ("Incorrect extent in return value of" - " u_name intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) ret_extent, (long int) extent[n]); - } - for (n=0; n<= rank; n++) - { - index_type mask_extent, array_extent; - - array_extent = GFC_DESCRIPTOR_EXTENT(array,n); - mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n); - if (array_extent != mask_extent) - runtime_error ("Incorrect extent in MASK argument of" - " u_name intrinsic in dimension %ld:" - " is %ld, should be %ld", (long int) n + 1, - (long int) mask_extent, (long int) array_extent); - } + bounds_ifunction_return ((array_t *) retarray, extent, + "return value", "u_name"); + bounds_equal_extents ((array_t *) mask, (array_t *) array, + "MASK argument", "u_name"); } } diff --git a/libgfortran/runtime/bounds.c b/libgfortran/runtime/bounds.c new file mode 100644 index 0000000..8a7affd --- /dev/null +++ b/libgfortran/runtime/bounds.c @@ -0,0 +1,199 @@ +/* Copyright (C) 2009 + Free Software Foundation, Inc. + Contributed by Thomas Koenig + +This file is part of the GNU Fortran runtime library (libgfortran). + +Libgfortran is free software; you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation; either version 3, or (at your option) +any later version. + +Libgfortran is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +Under Section 7 of GPL version 3, you are granted additional +permissions described in the GCC Runtime Library Exception, version +3.1, as published by the Free Software Foundation. + +You should have received a copy of the GNU General Public License and +a copy of the GCC Runtime Library Exception along with this program; +see the files COPYING3 and COPYING.RUNTIME respectively. If not, see +<http://www.gnu.org/licenses/>. */ + +#include "libgfortran.h" +#include <assert.h> + +/* Auxiliary functions for bounds checking, mostly to reduce library size. */ + +/* Bounds checking for the return values of the iforeach functions (such + as maxloc and minloc). The extent of ret_array must + must match the rank of array. */ + +void +bounds_iforeach_return (array_t *retarray, array_t *array, const char *name) +{ + index_type rank; + index_type ret_rank; + index_type ret_extent; + + ret_rank = GFC_DESCRIPTOR_RANK (retarray); + + if (ret_rank != 1) + runtime_error ("Incorrect rank of return array in %s intrinsic:" + "is %ld, should be 1", name, (long int) ret_rank); + + rank = GFC_DESCRIPTOR_RANK (array); + ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0); + if (ret_extent != rank) + runtime_error ("Incorrect extent in return value of" + " %s intrinsic: is %ld, should be %ld", + name, (long int) ret_extent, (long int) rank); + +} + +/* Check the return of functions generated from ifunction.m4. + We check the array descriptor "a" against the extents precomputed + from ifunction.m4, and complain about the argument a_name in the + intrinsic function. */ + +void +bounds_ifunction_return (array_t * a, const index_type * extent, + const char * a_name, const char * intrinsic) +{ + int empty; + int n; + int rank; + index_type a_size; + + rank = GFC_DESCRIPTOR_RANK (a); + a_size = size0 (a); + + empty = 0; + for (n = 0; n < rank; n++) + { + if (extent[n] == 0) + empty = 1; + } + if (empty) + { + if (a_size != 0) + runtime_error ("Incorrect size in %s of %s" + " intrinsic: should be zero-sized", + a_name, intrinsic); + } + else + { + if (a_size == 0) + runtime_error ("Incorrect size of %s in %s" + " intrinsic: should not be zero-sized", + a_name, intrinsic); + + for (n = 0; n < rank; n++) + { + index_type a_extent; + a_extent = GFC_DESCRIPTOR_EXTENT(a, n); + if (a_extent != extent[n]) + runtime_error("Incorrect extent in %s of %s" + " intrinsic in dimension %ld: is %ld," + " should be %ld", a_name, intrinsic, (long int) n + 1, + (long int) a_extent, (long int) extent[n]); + + } + } +} + +/* Check that two arrays have equal extents, or are both zero-sized. Abort + with a runtime error if this is not the case. Complain that a has the + wrong size. */ + +void +bounds_equal_extents (array_t *a, array_t *b, const char *a_name, + const char *intrinsic) +{ + index_type a_size, b_size, n; + + assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b)); + + a_size = size0 (a); + b_size = size0 (b); + + if (b_size == 0) + { + if (a_size != 0) + runtime_error ("Incorrect size of %s in %s" + " intrinsic: should be zero-sized", + a_name, intrinsic); + } + else + { + if (a_size == 0) + runtime_error ("Incorrect size of %s of %s" + " intrinsic: Should not be zero-sized", + a_name, intrinsic); + + for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++) + { + index_type a_extent, b_extent; + + a_extent = GFC_DESCRIPTOR_EXTENT(a, n); + b_extent = GFC_DESCRIPTOR_EXTENT(b, n); + if (a_extent != b_extent) + runtime_error("Incorrect extent in %s of %s" + " intrinsic in dimension %ld: is %ld," + " should be %ld", a_name, intrinsic, (long int) n + 1, + (long int) a_extent, (long int) b_extent); + } + } +} + +/* Check that the extents of a and b agree, except that a has a missing + dimension in argument which. Complain about a if anything is wrong. */ + +void +bounds_reduced_extents (array_t *a, array_t *b, int which, const char *a_name, + const char *intrinsic) +{ + + index_type i, n, a_size, b_size; + + assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b) - 1); + + a_size = size0 (a); + b_size = size0 (b); + + if (b_size == 0) + { + if (a_size != 0) + runtime_error ("Incorrect size in %s of %s" + " intrinsic: should not be zero-sized", + a_name, intrinsic); + } + else + { + if (a_size == 0) + runtime_error ("Incorrect size of %s of %s" + " intrinsic: should be zero-sized", + a_name, intrinsic); + + i = 0; + for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++) + { + index_type a_extent, b_extent; + + if (n != which) + { + a_extent = GFC_DESCRIPTOR_EXTENT(a, i); + b_extent = GFC_DESCRIPTOR_EXTENT(b, n); + if (a_extent != b_extent) + runtime_error("Incorrect extent in %s of %s" + " intrinsic in dimension %ld: is %ld," + " should be %ld", a_name, intrinsic, (long int) i + 1, + (long int) a_extent, (long int) b_extent); + i++; + } + } + } +} |