OSDN Git Service

2009-07-19 Thomas Koenig <tkoenig@gcc.gnu.org>
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 19 Jul 2009 15:07:21 +0000 (15:07 +0000)
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 19 Jul 2009 15:07:21 +0000 (15:07 +0000)
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-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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149792 138bc75d-0d04-0410-961f-82ee72b054a4

183 files changed:
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/cshift_bounds_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/cshift_bounds_2.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/cshift_bounds_3.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/cshift_bounds_4.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/eoshift_bounds_1.f90 [new file with mode: 0644]
gcc/testsuite/gfortran.dg/maxloc_bounds_4.f90
gcc/testsuite/gfortran.dg/maxloc_bounds_5.f90
gcc/testsuite/gfortran.dg/maxloc_bounds_7.f90
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in
libgfortran/generated/cshift1_16.c
libgfortran/generated/cshift1_4.c
libgfortran/generated/cshift1_8.c
libgfortran/generated/eoshift1_16.c
libgfortran/generated/eoshift1_4.c
libgfortran/generated/eoshift1_8.c
libgfortran/generated/eoshift3_16.c
libgfortran/generated/eoshift3_4.c
libgfortran/generated/eoshift3_8.c
libgfortran/generated/maxloc0_16_i1.c
libgfortran/generated/maxloc0_16_i16.c
libgfortran/generated/maxloc0_16_i2.c
libgfortran/generated/maxloc0_16_i4.c
libgfortran/generated/maxloc0_16_i8.c
libgfortran/generated/maxloc0_16_r10.c
libgfortran/generated/maxloc0_16_r16.c
libgfortran/generated/maxloc0_16_r4.c
libgfortran/generated/maxloc0_16_r8.c
libgfortran/generated/maxloc0_4_i1.c
libgfortran/generated/maxloc0_4_i16.c
libgfortran/generated/maxloc0_4_i2.c
libgfortran/generated/maxloc0_4_i4.c
libgfortran/generated/maxloc0_4_i8.c
libgfortran/generated/maxloc0_4_r10.c
libgfortran/generated/maxloc0_4_r16.c
libgfortran/generated/maxloc0_4_r4.c
libgfortran/generated/maxloc0_4_r8.c
libgfortran/generated/maxloc0_8_i1.c
libgfortran/generated/maxloc0_8_i16.c
libgfortran/generated/maxloc0_8_i2.c
libgfortran/generated/maxloc0_8_i4.c
libgfortran/generated/maxloc0_8_i8.c
libgfortran/generated/maxloc0_8_r10.c
libgfortran/generated/maxloc0_8_r16.c
libgfortran/generated/maxloc0_8_r4.c
libgfortran/generated/maxloc0_8_r8.c
libgfortran/generated/maxloc1_16_i1.c
libgfortran/generated/maxloc1_16_i16.c
libgfortran/generated/maxloc1_16_i2.c
libgfortran/generated/maxloc1_16_i4.c
libgfortran/generated/maxloc1_16_i8.c
libgfortran/generated/maxloc1_16_r10.c
libgfortran/generated/maxloc1_16_r16.c
libgfortran/generated/maxloc1_16_r4.c
libgfortran/generated/maxloc1_16_r8.c
libgfortran/generated/maxloc1_4_i1.c
libgfortran/generated/maxloc1_4_i16.c
libgfortran/generated/maxloc1_4_i2.c
libgfortran/generated/maxloc1_4_i4.c
libgfortran/generated/maxloc1_4_i8.c
libgfortran/generated/maxloc1_4_r10.c
libgfortran/generated/maxloc1_4_r16.c
libgfortran/generated/maxloc1_4_r4.c
libgfortran/generated/maxloc1_4_r8.c
libgfortran/generated/maxloc1_8_i1.c
libgfortran/generated/maxloc1_8_i16.c
libgfortran/generated/maxloc1_8_i2.c
libgfortran/generated/maxloc1_8_i4.c
libgfortran/generated/maxloc1_8_i8.c
libgfortran/generated/maxloc1_8_r10.c
libgfortran/generated/maxloc1_8_r16.c
libgfortran/generated/maxloc1_8_r4.c
libgfortran/generated/maxloc1_8_r8.c
libgfortran/generated/maxval_i1.c
libgfortran/generated/maxval_i16.c
libgfortran/generated/maxval_i2.c
libgfortran/generated/maxval_i4.c
libgfortran/generated/maxval_i8.c
libgfortran/generated/maxval_r10.c
libgfortran/generated/maxval_r16.c
libgfortran/generated/maxval_r4.c
libgfortran/generated/maxval_r8.c
libgfortran/generated/minloc0_16_i1.c
libgfortran/generated/minloc0_16_i16.c
libgfortran/generated/minloc0_16_i2.c
libgfortran/generated/minloc0_16_i4.c
libgfortran/generated/minloc0_16_i8.c
libgfortran/generated/minloc0_16_r10.c
libgfortran/generated/minloc0_16_r16.c
libgfortran/generated/minloc0_16_r4.c
libgfortran/generated/minloc0_16_r8.c
libgfortran/generated/minloc0_4_i1.c
libgfortran/generated/minloc0_4_i16.c
libgfortran/generated/minloc0_4_i2.c
libgfortran/generated/minloc0_4_i4.c
libgfortran/generated/minloc0_4_i8.c
libgfortran/generated/minloc0_4_r10.c
libgfortran/generated/minloc0_4_r16.c
libgfortran/generated/minloc0_4_r4.c
libgfortran/generated/minloc0_4_r8.c
libgfortran/generated/minloc0_8_i1.c
libgfortran/generated/minloc0_8_i16.c
libgfortran/generated/minloc0_8_i2.c
libgfortran/generated/minloc0_8_i4.c
libgfortran/generated/minloc0_8_i8.c
libgfortran/generated/minloc0_8_r10.c
libgfortran/generated/minloc0_8_r16.c
libgfortran/generated/minloc0_8_r4.c
libgfortran/generated/minloc0_8_r8.c
libgfortran/generated/minloc1_16_i1.c
libgfortran/generated/minloc1_16_i16.c
libgfortran/generated/minloc1_16_i2.c
libgfortran/generated/minloc1_16_i4.c
libgfortran/generated/minloc1_16_i8.c
libgfortran/generated/minloc1_16_r10.c
libgfortran/generated/minloc1_16_r16.c
libgfortran/generated/minloc1_16_r4.c
libgfortran/generated/minloc1_16_r8.c
libgfortran/generated/minloc1_4_i1.c
libgfortran/generated/minloc1_4_i16.c
libgfortran/generated/minloc1_4_i2.c
libgfortran/generated/minloc1_4_i4.c
libgfortran/generated/minloc1_4_i8.c
libgfortran/generated/minloc1_4_r10.c
libgfortran/generated/minloc1_4_r16.c
libgfortran/generated/minloc1_4_r4.c
libgfortran/generated/minloc1_4_r8.c
libgfortran/generated/minloc1_8_i1.c
libgfortran/generated/minloc1_8_i16.c
libgfortran/generated/minloc1_8_i2.c
libgfortran/generated/minloc1_8_i4.c
libgfortran/generated/minloc1_8_i8.c
libgfortran/generated/minloc1_8_r10.c
libgfortran/generated/minloc1_8_r16.c
libgfortran/generated/minloc1_8_r4.c
libgfortran/generated/minloc1_8_r8.c
libgfortran/generated/minval_i1.c
libgfortran/generated/minval_i16.c
libgfortran/generated/minval_i2.c
libgfortran/generated/minval_i4.c
libgfortran/generated/minval_i8.c
libgfortran/generated/minval_r10.c
libgfortran/generated/minval_r16.c
libgfortran/generated/minval_r4.c
libgfortran/generated/minval_r8.c
libgfortran/generated/product_c10.c
libgfortran/generated/product_c16.c
libgfortran/generated/product_c4.c
libgfortran/generated/product_c8.c
libgfortran/generated/product_i1.c
libgfortran/generated/product_i16.c
libgfortran/generated/product_i2.c
libgfortran/generated/product_i4.c
libgfortran/generated/product_i8.c
libgfortran/generated/product_r10.c
libgfortran/generated/product_r16.c
libgfortran/generated/product_r4.c
libgfortran/generated/product_r8.c
libgfortran/generated/sum_c10.c
libgfortran/generated/sum_c16.c
libgfortran/generated/sum_c4.c
libgfortran/generated/sum_c8.c
libgfortran/generated/sum_i1.c
libgfortran/generated/sum_i16.c
libgfortran/generated/sum_i2.c
libgfortran/generated/sum_i4.c
libgfortran/generated/sum_i8.c
libgfortran/generated/sum_r10.c
libgfortran/generated/sum_r16.c
libgfortran/generated/sum_r4.c
libgfortran/generated/sum_r8.c
libgfortran/intrinsics/cshift0.c
libgfortran/intrinsics/eoshift0.c
libgfortran/intrinsics/eoshift2.c
libgfortran/libgfortran.h
libgfortran/m4/cshift1.m4
libgfortran/m4/eoshift1.m4
libgfortran/m4/eoshift3.m4
libgfortran/m4/iforeach.m4
libgfortran/m4/ifunction.m4
libgfortran/runtime/bounds.c [new file with mode: 0644]

index 6951c22..a1ba3f1 100644 (file)
@@ -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 (file)
index 0000000..5932004
--- /dev/null
@@ -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 (file)
index 0000000..8d7e779
--- /dev/null
@@ -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 (file)
index 0000000..33e387f
--- /dev/null
@@ -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 (file)
index 0000000..4a3fcfb
--- /dev/null
@@ -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 (file)
index 0000000..f323415
--- /dev/null
@@ -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" }
index 5a38813..7ba103d 100644 (file)
@@ -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" } }
 
index 42e19e5..34d06da 100644 (file)
@@ -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" } }
index 2194eee..817bf8f 100644 (file)
@@ -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" } }
index 2374683..8231ed1 100644 (file)
@@ -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>
                
index f5f92df..4a974ba 100644 (file)
@@ -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 \
index ce2b5a2..7741c32 100644 (file)
@@ -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
index df97dfa..b2cb7f1 100644 (file)
@@ -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;
index f048e8e..30f3d99 100644 (file)
@@ -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;
index 9667728..c3bf473 100644 (file)
@@ -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;
index 02365cc..a14bd29 100644 (file)
@@ -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++)
     {
index e703db4..06bc309 100644 (file)
@@ -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++)
     {
index f8922b3..3e9162d 100644 (file)
@@ -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++)
     {
index c3efae9..ec21d1e 100644 (file)
@@ -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;
index 5038c09..ce4cede 100644 (file)
@@ -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;
index f745a1d..4af36f7 100644 (file)
@@ -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;
index b43f083..c9f58e3 100644 (file)
@@ -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);
index 26941a7..8adbc93 100644 (file)
@@ -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);
index e1d329c..16849c2 100644 (file)
@@ -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);
index 4d1d0a1..a6e979c 100644 (file)
@@ -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);
index 12147a0..8e2d4bc 100644 (file)
@@ -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);
index 33c7308..d76e947 100644 (file)
@@ -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);
index 4f4f290..2e6dcf1 100644 (file)
@@ -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);
index 86cedb3..5d1fe35 100644 (file)
@@ -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);
index 378024b..dc489f3 100644 (file)
@@ -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);
index 7475059..7cdd813 100644 (file)
@@ -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);
index 268f09a..b2bc053 100644 (file)
@@ -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);
index 47fb135..fb3b40b 100644 (file)
@@ -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);
index 55bc275..2a84c7f 100644 (file)
@@ -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);
index f598f05..2e1fa6d 100644 (file)
@@ -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);
index 5c99198..934337a 100644 (file)
@@ -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);
index c7609c3..c266025 100644 (file)
@@ -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);
index 50f3c3b..a349953 100644 (file)
@@ -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);
index 30dc297..7180bf8 100644 (file)
@@ -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);
index eb1737d..a850603 100644 (file)
@@ -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);
index 6690c2d..73683d8 100644 (file)
@@ -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);
index b9bb230..3b8e793 100644 (file)
@@ -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);
index 5778146..1b0bc42 100644 (file)
@@ -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);
index ef7dede..5bf9520 100644 (file)
@@ -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);
index 0c08d8e..28008d4 100644 (file)
@@ -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);
index da61d2b..04bfd57 100644 (file)
@@ -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);
index a26b110..238b869 100644 (file)
@@ -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);
index 1198d62..16d9a45 100644 (file)
@@ -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);
index a776f4f..9be5cdd 100644 (file)
@@ -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");
        }
     }
 
index 827b3e6..9118f85 100644 (file)
@@ -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");
        }
     }
 
index 24a34e3..66b24b0 100644 (file)
@@ -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");
        }
     }
 
index 0194f28..3f6c952 100644 (file)
@@ -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");
        }
     }
 
index bb17500..141dc51 100644 (file)
@@ -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");
        }
     }
 
index dc8cd5d..74bc4d3 100644 (file)
@@ -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");
        }
     }
 
index 1664edb..cadca8b 100644 (file)
@@ -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");
        }
     }
 
index 58bfcc0..f2afd83 100644 (file)
@@ -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");
        }
     }
 
index d646d25..3da1066 100644 (file)
@@ -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");
        }
     }
 
index 39291ff..3a76e0e 100644 (file)
@@ -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");
        }
     }
 
index 059cacb..7c3bc2d 100644 (file)
@@ -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");
        }
     }
 
index 64cee3e..cdcdfa4 100644 (file)
@@ -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");
        }
     }
 
index f8a843e..bf60007 100644 (file)
@@ -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");
        }
     }
 
index 293c2a9..18edc04 100644 (file)
@@ -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");
        }
     }
 
index 8998279..bae17fe 100644 (file)
@@ -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");
        }
     }
 
index 191ba99..811f01c 100644 (file)
@@ -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");
        }
     }
 
index 1f445e7..065770f 100644 (file)
@@ -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");
        }
     }
 
index 170e3df..e083507 100644 (file)
@@ -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");
        }
     }
 
index 9924b71..b1d1f0e 100644 (file)
@@ -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");
        }
     }
 
index 97946f3..3028b2d 100644 (file)
@@ -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");
        }
     }
 
index d343b0b..74d7fb3 100644 (file)
@@ -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");
        }
     }
 
index 682de41..fcf11b8 100644 (file)
@@ -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");
        }
     }
 
index e17ecc4..1210fb1 100644 (file)
@@ -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");
        }
     }
 
index cb4b692..e0873d2 100644 (file)
@@ -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");
        }
     }
 
index 5a99daf..83d84c5 100644 (file)
@@ -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");
        }
     }
 
index ba88d8e..94250d3 100644 (file)
@@ -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");
        }
     }
 
index 6d05b43..4b75978 100644 (file)
@@ -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");
        }
     }
 
index 10193fd..cbffa30 100644 (file)
@@ -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");
        }
     }
 
index 884ed66..e0e5341 100644 (file)
@@ -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");
        }
     }
 
index 3abe657..293a75f 100644 (file)
@@ -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");
        }
     }
 
index 57aea5f..4d105a0 100644 (file)
@@ -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");
        }
     }
 
index 9d7f57c..2ff1728 100644 (file)
@@ -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);