+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
--- /dev/null
+! { 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
--- /dev/null
+! { 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" }
--- /dev/null
+! { 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" }
--- /dev/null
+! { 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" }
--- /dev/null
+! { 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" }
! { 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)
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" } }
! { 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)
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" } }
! { 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)
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" } }
+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>
gfor_src= \
runtime/backtrace.c \
+runtime/bounds.c \
runtime/compile_options.c \
runtime/convert_char.c \
runtime/environ.c \
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 \
$(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 \
gfor_src = \
runtime/backtrace.c \
+runtime/bounds.c \
runtime/compile_options.c \
runtime/convert_char.c \
runtime/environ.c \
@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@
@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
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;
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;
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_type len;
index_type n;
index_type size;
+ index_type arraysize;
int which;
GFC_INTEGER_16 sh;
GFC_INTEGER_16 delta;
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++)
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_type len;
index_type n;
index_type size;
+ index_type arraysize;
int which;
GFC_INTEGER_4 sh;
GFC_INTEGER_4 delta;
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++)
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_type len;
index_type n;
index_type size;
+ index_type arraysize;
int which;
GFC_INTEGER_8 sh;
GFC_INTEGER_8 delta;
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++)
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_type len;
index_type n;
index_type size;
+ index_type arraysize;
int which;
GFC_INTEGER_16 sh;
GFC_INTEGER_16 delta;
soffset = 0;
roffset = 0;
+ arraysize = size0 ((array_t *) array);
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
{
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++)
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_type len;
index_type n;
index_type size;
+ index_type arraysize;
int which;
GFC_INTEGER_4 sh;
GFC_INTEGER_4 delta;
soffset = 0;
roffset = 0;
+ arraysize = size0 ((array_t *) array);
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
{
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++)
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_type len;
index_type n;
index_type size;
+ index_type arraysize;
int which;
GFC_INTEGER_8 sh;
GFC_INTEGER_8 delta;
soffset = 0;
roffset = 0;
+ arraysize = size0 ((array_t *) array);
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
{
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++)
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;
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
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);
{
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");
}
}
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);
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
(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++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- 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");
}
}
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_16) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in MINLOC intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
-
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in MINLOC intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "MINLOC");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINLOC intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINLOC");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINLOC");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINVAL");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINVAL");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINVAL");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINVAL");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINVAL");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINVAL");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINVAL");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINVAL");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " MINVAL intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "MINVAL");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "MINVAL");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " PRODUCT intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "PRODUCT");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "PRODUCT");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " SUM intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "SUM");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "SUM");
}
}
if (arraysize > 0)
ret->data = internal_malloc_size (size * arraysize);
else
- {
- ret->data = internal_malloc_size (1);
- return;
- }
+ ret->data = internal_malloc_size (1);
}
-
+ else if (unlikely (compile_options.bounds_check))
+ {
+ bounds_equal_extents ((array_t *) ret, (array_t *) array,
+ "return value", "CSHIFT");
+ }
+
if (arraysize == 0)
return;
+
type_size = GFC_DTYPE_TYPE_SIZE (array);
switch(type_size)
index_type dim;
index_type len;
index_type n;
+ index_type arraysize;
/* The compiler cannot figure out that these are set, initialize
them to avoid warnings. */
soffset = 0;
roffset = 0;
+ arraysize = size0 ((array_t *) array);
+
if (ret->data == NULL)
{
int i;
- ret->data = internal_malloc_size (size * size0 ((array_t *)array));
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
}
+
+ if (arraysize > 0)
+ ret->data = internal_malloc_size (size * arraysize);
+ else
+ ret->data = internal_malloc_size (1);
+
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (size0 ((array_t *) ret) == 0)
- return;
+ bounds_equal_extents ((array_t *) ret, (array_t *) array,
+ "return value", "EOSHIFT");
}
+ if (arraysize == 0)
+ return;
+
which = which - 1;
extent[0] = 1;
{
int i;
- ret->data = internal_malloc_size (size * arraysize);
ret->offset = 0;
ret->dtype = array->dtype;
for (i = 0; i < GFC_DESCRIPTOR_RANK (array); i++)
GFC_DIMENSION_SET(ret->dim[i], 0, ub, str);
+ if (arraysize > 0)
+ ret->data = internal_malloc_size (size * arraysize);
+ else
+ ret->data = internal_malloc_size (1);
+
}
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (size0 ((array_t *) ret) == 0)
- return;
+ bounds_equal_extents ((array_t *) ret, (array_t *) array,
+ "return value", "EOSHIFT");
}
- if (arraysize == 0 && filler == NULL)
+ if (arraysize == 0)
return;
which = which - 1;
extern index_type size0 (const array_t * array);
iexport_proto(size0);
+/* bounds.c */
+
+extern void bounds_equal_extents (array_t *, array_t *, const char *,
+ const char *);
+internal_proto(bounds_equal_extents);
+
+extern void bounds_reduced_extents (array_t *, array_t *, int, const char *,
+ const char *intrinsic);
+internal_proto(bounds_reduced_extents);
+
+extern void bounds_iforeach_return (array_t *, array_t *, const char *);
+internal_proto(bounds_iforeach_return);
+
+extern void bounds_ifunction_return (array_t *, const index_type *,
+ const char *, const char *);
+internal_proto(bounds_ifunction_return);
+
/* Internal auxiliary functions for cshift */
void cshift0_i1 (gfc_array_i1 *, const gfc_array_i1 *, ssize_t, int);
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_type len;
index_type n;
index_type size;
+ index_type arraysize;
int which;
'atype_name` sh;
'atype_name` delta;
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++)
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_type len;
index_type n;
index_type size;
+ index_type arraysize;
int which;
'atype_name` sh;
'atype_name` delta;
soffset = 0;
roffset = 0;
+ arraysize = size0 ((array_t *) array);
size = GFC_DESCRIPTOR_SIZE(array);
if (pwhich)
{
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++)
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;
else
{
if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in u_name intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " u_name intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "u_name");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
{
if (unlikely (compile_options.bounds_check))
{
- int ret_rank, mask_rank;
- index_type ret_extent;
- int n;
- index_type array_extent, mask_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in u_name intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("Incorrect extent in return value of"
- " u_name intrnisic: is %ld, should be %ld",
- (long int) ret_extent, (long int) rank);
-
- mask_rank = GFC_DESCRIPTOR_RANK (mask);
- if (rank != mask_rank)
- runtime_error ("rank of MASK argument in u_name intrnisic"
- "should be %ld, is %ld", (long int) rank,
- (long int) mask_rank);
- for (n=0; n<rank; n++)
- {
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " u_name intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "u_name");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "u_name");
}
}
retarray->offset = 0;
retarray->data = internal_malloc_size (sizeof (rtype_name) * rank);
}
- else
+ else if (unlikely (compile_options.bounds_check))
{
- if (unlikely (compile_options.bounds_check))
- {
- int ret_rank;
- index_type ret_extent;
-
- ret_rank = GFC_DESCRIPTOR_RANK (retarray);
- if (ret_rank != 1)
- runtime_error ("rank of return array in u_name intrinsic"
- " should be 1, is %ld", (long int) ret_rank);
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
- if (ret_extent != rank)
- runtime_error ("dimension of return array incorrect");
- }
+ bounds_iforeach_return ((array_t *) retarray, (array_t *) array,
+ "u_name");
}
dstride = GFC_DESCRIPTOR_STRIDE(retarray,0);
(long int) rank);
if (unlikely (compile_options.bounds_check))
- {
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " u_name intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "u_name");
}
for (n = 0; n < rank; n++)
if (unlikely (compile_options.bounds_check))
{
- for (n=0; n < rank; n++)
- {
- index_type ret_extent;
-
- ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,n);
- if (extent[n] != ret_extent)
- runtime_error ("Incorrect extent in return value of"
- " u_name intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) ret_extent, (long int) extent[n]);
- }
- for (n=0; n<= rank; n++)
- {
- index_type mask_extent, array_extent;
-
- array_extent = GFC_DESCRIPTOR_EXTENT(array,n);
- mask_extent = GFC_DESCRIPTOR_EXTENT(mask,n);
- if (array_extent != mask_extent)
- runtime_error ("Incorrect extent in MASK argument of"
- " u_name intrinsic in dimension %ld:"
- " is %ld, should be %ld", (long int) n + 1,
- (long int) mask_extent, (long int) array_extent);
- }
+ bounds_ifunction_return ((array_t *) retarray, extent,
+ "return value", "u_name");
+ bounds_equal_extents ((array_t *) mask, (array_t *) array,
+ "MASK argument", "u_name");
}
}
--- /dev/null
+/* Copyright (C) 2009
+ Free Software Foundation, Inc.
+ Contributed by Thomas Koenig
+
+This file is part of the GNU Fortran runtime library (libgfortran).
+
+Libgfortran is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 3, or (at your option)
+any later version.
+
+Libgfortran is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+GNU General Public License for more details.
+
+Under Section 7 of GPL version 3, you are granted additional
+permissions described in the GCC Runtime Library Exception, version
+3.1, as published by the Free Software Foundation.
+
+You should have received a copy of the GNU General Public License and
+a copy of the GCC Runtime Library Exception along with this program;
+see the files COPYING3 and COPYING.RUNTIME respectively. If not, see
+<http://www.gnu.org/licenses/>. */
+
+#include "libgfortran.h"
+#include <assert.h>
+
+/* Auxiliary functions for bounds checking, mostly to reduce library size. */
+
+/* Bounds checking for the return values of the iforeach functions (such
+ as maxloc and minloc). The extent of ret_array must
+ must match the rank of array. */
+
+void
+bounds_iforeach_return (array_t *retarray, array_t *array, const char *name)
+{
+ index_type rank;
+ index_type ret_rank;
+ index_type ret_extent;
+
+ ret_rank = GFC_DESCRIPTOR_RANK (retarray);
+
+ if (ret_rank != 1)
+ runtime_error ("Incorrect rank of return array in %s intrinsic:"
+ "is %ld, should be 1", name, (long int) ret_rank);
+
+ rank = GFC_DESCRIPTOR_RANK (array);
+ ret_extent = GFC_DESCRIPTOR_EXTENT(retarray,0);
+ if (ret_extent != rank)
+ runtime_error ("Incorrect extent in return value of"
+ " %s intrinsic: is %ld, should be %ld",
+ name, (long int) ret_extent, (long int) rank);
+
+}
+
+/* Check the return of functions generated from ifunction.m4.
+ We check the array descriptor "a" against the extents precomputed
+ from ifunction.m4, and complain about the argument a_name in the
+ intrinsic function. */
+
+void
+bounds_ifunction_return (array_t * a, const index_type * extent,
+ const char * a_name, const char * intrinsic)
+{
+ int empty;
+ int n;
+ int rank;
+ index_type a_size;
+
+ rank = GFC_DESCRIPTOR_RANK (a);
+ a_size = size0 (a);
+
+ empty = 0;
+ for (n = 0; n < rank; n++)
+ {
+ if (extent[n] == 0)
+ empty = 1;
+ }
+ if (empty)
+ {
+ if (a_size != 0)
+ runtime_error ("Incorrect size in %s of %s"
+ " intrinsic: should be zero-sized",
+ a_name, intrinsic);
+ }
+ else
+ {
+ if (a_size == 0)
+ runtime_error ("Incorrect size of %s in %s"
+ " intrinsic: should not be zero-sized",
+ a_name, intrinsic);
+
+ for (n = 0; n < rank; n++)
+ {
+ index_type a_extent;
+ a_extent = GFC_DESCRIPTOR_EXTENT(a, n);
+ if (a_extent != extent[n])
+ runtime_error("Incorrect extent in %s of %s"
+ " intrinsic in dimension %ld: is %ld,"
+ " should be %ld", a_name, intrinsic, (long int) n + 1,
+ (long int) a_extent, (long int) extent[n]);
+
+ }
+ }
+}
+
+/* Check that two arrays have equal extents, or are both zero-sized. Abort
+ with a runtime error if this is not the case. Complain that a has the
+ wrong size. */
+
+void
+bounds_equal_extents (array_t *a, array_t *b, const char *a_name,
+ const char *intrinsic)
+{
+ index_type a_size, b_size, n;
+
+ assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b));
+
+ a_size = size0 (a);
+ b_size = size0 (b);
+
+ if (b_size == 0)
+ {
+ if (a_size != 0)
+ runtime_error ("Incorrect size of %s in %s"
+ " intrinsic: should be zero-sized",
+ a_name, intrinsic);
+ }
+ else
+ {
+ if (a_size == 0)
+ runtime_error ("Incorrect size of %s of %s"
+ " intrinsic: Should not be zero-sized",
+ a_name, intrinsic);
+
+ for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++)
+ {
+ index_type a_extent, b_extent;
+
+ a_extent = GFC_DESCRIPTOR_EXTENT(a, n);
+ b_extent = GFC_DESCRIPTOR_EXTENT(b, n);
+ if (a_extent != b_extent)
+ runtime_error("Incorrect extent in %s of %s"
+ " intrinsic in dimension %ld: is %ld,"
+ " should be %ld", a_name, intrinsic, (long int) n + 1,
+ (long int) a_extent, (long int) b_extent);
+ }
+ }
+}
+
+/* Check that the extents of a and b agree, except that a has a missing
+ dimension in argument which. Complain about a if anything is wrong. */
+
+void
+bounds_reduced_extents (array_t *a, array_t *b, int which, const char *a_name,
+ const char *intrinsic)
+{
+
+ index_type i, n, a_size, b_size;
+
+ assert (GFC_DESCRIPTOR_RANK(a) == GFC_DESCRIPTOR_RANK(b) - 1);
+
+ a_size = size0 (a);
+ b_size = size0 (b);
+
+ if (b_size == 0)
+ {
+ if (a_size != 0)
+ runtime_error ("Incorrect size in %s of %s"
+ " intrinsic: should not be zero-sized",
+ a_name, intrinsic);
+ }
+ else
+ {
+ if (a_size == 0)
+ runtime_error ("Incorrect size of %s of %s"
+ " intrinsic: should be zero-sized",
+ a_name, intrinsic);
+
+ i = 0;
+ for (n = 0; n < GFC_DESCRIPTOR_RANK (b); n++)
+ {
+ index_type a_extent, b_extent;
+
+ if (n != which)
+ {
+ a_extent = GFC_DESCRIPTOR_EXTENT(a, i);
+ b_extent = GFC_DESCRIPTOR_EXTENT(b, n);
+ if (a_extent != b_extent)
+ runtime_error("Incorrect extent in %s of %s"
+ " intrinsic in dimension %ld: is %ld,"
+ " should be %ld", a_name, intrinsic, (long int) i + 1,
+ (long int) a_extent, (long int) b_extent);
+ i++;
+ }
+ }
+ }
+}
git://gcc.gnu.org / gcc.git / commitdiff