From: Thomas Koenig Date: Sat, 9 Apr 2005 21:38:47 +0000 (+0000) Subject: re PR libfortran/19106 ([4.0 only] segfault in executable for print *,sum(a,dim=2... X-Git-Tag: misc/cutover-cvs2svn~4206 X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=50dd63a96201720c74d336aad9197a0efa019e4d;p=thirdparty%2Fgcc.git re PR libfortran/19106 ([4.0 only] segfault in executable for print *,sum(a,dim=2,mask=a>0)) 2005-04-09 Thomas Koenig PR libfortran/19106 PR libfortran/19014 * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): ditto. If retarray->data is NULL (i.e. the front end does not know the rank and dimenson of the array), fill in its properties and allocate memory. Change the assertions about rank and dimension of retarray into runtime errors and only check them for retarray->data != NULL. Do the same for correcting the stride from 0 to 1 in retarray. (`m'name`'rtype_qual`_'atype_code): Likewise. * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise. Change assertion about rank of array to runtime error. (`m'name`'rtype_qual`_'atype_code): Likewise. * generated/all_l4.c: Regenerated. * generated/all_l8.c: Regenerated. * generated/any_l4.c: Regenerated. * generated/any_l8.c: Regenerated. * generated/count_4_l4.c: Regenerated. * generated/count_4_l8.c: Regenerated. * generated/count_8_l4.c: Regenerated. * generated/count_8_l8.c: Regenerated. * generated/maxloc0_4_i4.c: Regenerated. * generated/maxloc0_4_i8.c: Regenerated. * generated/maxloc0_4_r4.c: Regenerated. * generated/maxloc0_4_r8.c: Regenerated. * generated/maxloc0_8_i4.c: Regenerated. * generated/maxloc0_8_i8.c: Regenerated. * generated/maxloc0_8_r4.c: Regenerated. * generated/maxloc0_8_r8.c: Regenerated. * generated/maxloc1_4_i4.c: Regenerated. * generated/maxloc1_4_i8.c: Regenerated. * generated/maxloc1_4_r4.c: Regenerated. * generated/maxloc1_4_r8.c: Regenerated. * generated/maxloc1_8_i4.c: Regenerated. * generated/maxloc1_8_i8.c: Regenerated. * generated/maxloc1_8_r4.c: Regenerated. * generated/maxloc1_8_r8.c: Regenerated. * generated/maxval_i4.c: Regenerated. * generated/maxval_i8.c: Regenerated. * generated/maxval_r4.c: Regenerated. * generated/maxval_r8.c: Regenerated. * generated/minloc0_4_i4.c: Regenerated. * generated/minloc0_4_i8.c: Regenerated. * generated/minloc0_4_r4.c: Regenerated. * generated/minloc0_4_r8.c: Regenerated. * generated/minloc0_8_i4.c: Regenerated. * generated/minloc0_8_i8.c: Regenerated. * generated/minloc0_8_r4.c: Regenerated. * generated/minloc0_8_r8.c: Regenerated. * generated/minloc1_4_i4.c: Regenerated. * generated/minloc1_4_i8.c: Regenerated. * generated/minloc1_4_r4.c: Regenerated. * generated/minloc1_4_r8.c: Regenerated. * generated/minloc1_8_i4.c: Regenerated. * generated/minloc1_8_i8.c: Regenerated. * generated/minloc1_8_r4.c: Regenerated. * generated/minloc1_8_r8.c: Regenerated. * generated/minval_i4.c: Regenerated. * generated/minval_i8.c: Regenerated. * generated/minval_r4.c: Regenerated. * generated/minval_r8.c: Regenerated. * generated/product_c4.c: Regenerated. * generated/product_c8.c: Regenerated. * generated/product_i4.c: Regenerated. * generated/product_i8.c: Regenerated. * generated/product_r4.c: Regenerated. * generated/product_r8.c: Regenerated. * generated/sum_c4.c: Regenerated. * generated/sum_c8.c: Regenerated. * generated/sum_i4.c: Regenerated. * generated/sum_i8.c: Regenerated. * generated/sum_r4.c: Regenerated. * generated/sum_r8.c: Regenerated. 2005-04-09 Thomas Koenig * gfortran.fortran-torture/execute/intrinsic_anyall.f90: Added test for callee-allocated arrays with write statements. * gfortran.fortran-torture/execute/intrinsic_count.f90: Likewise. * gfortran.fortran-torture/execute/intrinsic_mmloc.f90: Likewise. * gfortran.fortran-torture/execute/intrinsic_mmval.f90: Likewise. * gfortran.fortran-torture/execute/intrinsic_product.f90: Likewise. * gfortran.fortran-torture/execute/intrinsic_sum.f90: Likewise. From-SVN: r97929 --- diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index fe7b88ea7ac6..1dfa1457971e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,13 @@ +2005-04-09 Thomas Koenig + + * gfortran.fortran-torture/execute/intrinsic_anyall.f90: + Added test for callee-allocated arrays with write statements. + * gfortran.fortran-torture/execute/intrinsic_count.f90: Likewise. + * gfortran.fortran-torture/execute/intrinsic_mmloc.f90: Likewise. + * gfortran.fortran-torture/execute/intrinsic_mmval.f90: Likewise. + * gfortran.fortran-torture/execute/intrinsic_product.f90: Likewise. + * gfortran.fortran-torture/execute/intrinsic_sum.f90: Likewise. + 2005-04-09 Thomas Koenig PR libfortran/20163 diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90 index d1b99dacb5d9..4e392c569606 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90 @@ -3,6 +3,7 @@ program anyall implicit none logical, dimension(3, 3) :: a logical, dimension(3) :: b + character(len=10) line a = .false. if (any(a)) call abort @@ -13,6 +14,12 @@ program anyall if (.not. b(1)) call abort if (b(2)) call abort if (.not. b(3)) call abort + b = .false. + write (line, 9000) any(a,1) + read (line, 9000) b + if (.not. b(1)) call abort + if (b(2)) call abort + if (.not. b(3)) call abort a = .true. if (.not. all(a)) call abort @@ -23,4 +30,12 @@ program anyall if (b(1)) call abort if (.not. b(2)) call abort if (b(3)) call abort + b = .false. + write (line, 9000) all(a,1) + read (line, 9000) b + if (b(1)) call abort + if (.not. b(2)) call abort + if (b(3)) call abort + +9000 format (9L1) end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f90 index a2de59fb9858..f95c198c1f56 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f90 @@ -4,6 +4,7 @@ program intrinsic_count logical(kind=4), dimension (3, 5) :: a integer(kind=4), dimension (5) :: b integer i + character(len=10) line a = .false. if (count(a) .ne. 0) call abort @@ -13,9 +14,21 @@ program intrinsic_count a(2, 2) = .false. a(2, 5) = .false. if (count(a) .ne. 12) call abort + write (line, 9000) count(a) + read (line, 9000) i + if (i .ne. 12) call abort b(1:3) = count(a, 2); if (b(1) .ne. 4) call abort if (b(2) .ne. 3) call abort if (b(3) .ne. 5) call abort + b = 0 + write (line, 9000) count(a,2) + read (line, 9000) b + if (b(1) .ne. 4) call abort + if (b(2) .ne. 3) call abort + if (b(3) .ne. 5) call abort + +9000 format(3I3) + end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90 index f64242af9e82..ea73913b6ef2 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90 @@ -5,6 +5,7 @@ program testmmloc integer, dimension (3) :: b logical, dimension (3, 3) :: m integer i + character(len=10) line a = reshape ((/1, 2, 3, 5, 4, 6, 9, 8, 7/), (/3, 3/)); @@ -12,6 +13,12 @@ program testmmloc if (b(1) .ne. 1) call abort if (b(2) .ne. 2) call abort if (b(3) .ne. 3) call abort + b = -1 + write (line, 9000) minloc(a,1) + read (line, 9000) b + if (b(1) .ne. 1) call abort + if (b(2) .ne. 2) call abort + if (b(3) .ne. 3) call abort m = .true. m(1, 1) = .false. @@ -20,19 +27,43 @@ program testmmloc if (b(1) .ne. 2) call abort if (b(2) .ne. 2) call abort if (b(3) .ne. 3) call abort + b = -1 + write (line, 9000) minloc(a, 1, m) + read (line, 9000) b + if (b(1) .ne. 2) call abort + if (b(2) .ne. 2) call abort + if (b(3) .ne. 3) call abort b(1:2) = minloc(a) if (b(1) .ne. 1) call abort if (b(2) .ne. 1) call abort + b = -1 + write (line, 9000) minloc(a) + read (line, 9000) b + if (b(1) .ne. 1) call abort + if (b(2) .ne. 1) call abort + if (b(3) .ne. 0) call abort b(1:2) = minloc(a, mask=m) if (b(1) .ne. 2) call abort if (b(2) .ne. 1) call abort + b = -1 + write (line, 9000) minloc(a, mask=m) + read (line, 9000) b + if (b(1) .ne. 2) call abort + if (b(2) .ne. 1) call abort + if (b(3) .ne. 0) call abort b = maxloc (a, 1) if (b(1) .ne. 3) call abort if (b(2) .ne. 3) call abort if (b(3) .ne. 1) call abort + b = -1 + write (line, 9000) maxloc(a, 1) + read (line, 9000) b + if (b(1) .ne. 3) call abort + if (b(2) .ne. 3) call abort + if (b(3) .ne. 1) call abort m = .true. m(1, 2) = .false. @@ -41,12 +72,31 @@ program testmmloc if (b(1) .ne. 3) call abort if (b(2) .ne. 3) call abort if (b(3) .ne. 2) call abort + b = -1 + write (line, 9000) maxloc(a, 1, m) + read (line, 9000) b + if (b(1) .ne. 3) call abort + if (b(2) .ne. 3) call abort + if (b(3) .ne. 2) call abort b(1:2) = maxloc(a) if (b(1) .ne. 1) call abort if (b(2) .ne. 3) call abort + b = -1 + write (line, 9000) maxloc(a) + read (line, 9000) b + if (b(1) .ne. 1) call abort + if (b(2) .ne. 3) call abort b(1:2) = maxloc(a, mask=m) if (b(1) .ne. 2) call abort if (b(2) .ne. 3) call abort + b = -1 + write (line, 9000) maxloc(a, mask=m) + read (line, 9000) b + if (b(1) .ne. 2) call abort + if (b(2) .ne. 3) call abort + if (b(3) .ne. 0) call abort + +9000 format (3I3) end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f90 index 368c83ba133e..86ec15917279 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f90 @@ -5,24 +5,35 @@ program testmmval integer, dimension (3) :: b logical, dimension (3, 3) :: m integer i + character (len=9) line a = reshape ((/1, 2, 3, 5, 4, 6, 9, 8, 7/), (/3, 3/)); b = minval (a, 1) if (any(b .ne. (/1, 4, 7/))) call abort + write (line, 9000) minval (a, 1) + if (line .ne. ' 1 4 7') call abort m = .true. m(1, 1) = .false. m(1, 2) = .false. b = minval (a, 1, m) if (any(b .ne. (/2, 4, 7/))) call abort + write (line, 9000) minval(a, 1, m) + if (line .ne. ' 2 4 7') call abort b = maxval (a, 1) if (any(b .ne. (/3, 6, 9/))) call abort + write (line, 9000) maxval (a, 1) + if (line .ne. ' 3 6 9') call abort m = .true. m(1, 2) = .false. m(1, 3) = .false. b = maxval (a, 1, m) if (any(b .ne. (/3, 6, 8/))) call abort + write (line, 9000) maxval(a, 1, m) + if (line .ne. ' 3 6 8') call abort + +9000 format(3I3) end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f90 index 102832c9f9ba..2892d5407cac 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f90 @@ -4,6 +4,7 @@ program testproduct integer, dimension (3, 3) :: a integer, dimension (3) :: b logical, dimension (3, 3) :: m + character(len=12) line a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)); @@ -11,8 +12,14 @@ program testproduct if (any(b .ne. (/6, 120, 504/))) call abort + write (line, 9000) product(a,1) + if (line .ne. ' 6 120 504') call abort + if (product (a) .ne. 362880) call abort + write (line, 9010) product(a) + if (line .ne. '362880') call abort + m = .true. m(1, 1) = .false. m(2, 1) = .false. @@ -20,6 +27,14 @@ program testproduct if (any(b .ne. (/28, 40, 162/))) call abort + write (line, 9000) product(a, 2, m) + if (line .ne. ' 28 40 162') call abort + if (product (a, mask=m) .ne. 181440) call abort + write (line, 9010) product(a, mask=m) + if (line .ne. '181440') call abort + +9000 format (3I4) +9010 format (I6) end program diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f90 index 43f832ec63c8..552f6c6d01f8 100644 --- a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f90 +++ b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f90 @@ -5,22 +5,35 @@ program testforall integer, dimension (3) :: b logical, dimension (3, 3) :: m integer i + character(len=9) line a = reshape ((/1, 2, 3, 4, 5, 6, 7, 8, 9/), (/3, 3/)); if (sum(a) .ne. 45) call abort + write (line, 9000) sum(a) + if (line .ne. ' 45 ') call abort b = sum (a, 1) if (b(1) .ne. 6) call abort if (b(2) .ne. 15) call abort if (b(3) .ne. 24) call abort + write (line, 9000) sum (a, 1) + if (line .ne. ' 6 15 24') call abort m = .true. m(1, 1) = .false. m(2, 1) = .false. if (sum (a, mask=m) .ne. 42) call abort + + write(line, 9000) sum (a, mask=m) + if (line .ne. ' 42 ') call abort + b = sum (a, 2, m) if (b(1) .ne. 11) call abort if (b(2) .ne. 13) call abort if (b(3) .ne. 18) call abort + write (line, 9000) sum (a, 2, m) + if (line .ne. ' 11 13 18') call abort + +9000 format(3I3) end program diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index 2f31127bc5a8..ba0257d69b68 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,79 @@ +2005-04-09 Thomas Koenig + + PR libfortran/19106 + PR libfortran/19014 + * m4/ifunction.m4 (name`'rtype_qual`_'atype_code): ditto. + If retarray->data is NULL (i.e. the front end does not + know the rank and dimenson of the array), fill in its + properties and allocate memory. + Change the assertions about rank and dimension of retarray into + runtime errors and only check them for retarray->data != NULL. + Do the same for correcting the stride from 0 to 1 in retarray. + (`m'name`'rtype_qual`_'atype_code): Likewise. + * m4/iforeach.m4 (name`'rtype_qual`_'atype_code): Likewise. + Change assertion about rank of array to runtime error. + (`m'name`'rtype_qual`_'atype_code): Likewise. + * generated/all_l4.c: Regenerated. + * generated/all_l8.c: Regenerated. + * generated/any_l4.c: Regenerated. + * generated/any_l8.c: Regenerated. + * generated/count_4_l4.c: Regenerated. + * generated/count_4_l8.c: Regenerated. + * generated/count_8_l4.c: Regenerated. + * generated/count_8_l8.c: Regenerated. + * generated/maxloc0_4_i4.c: Regenerated. + * generated/maxloc0_4_i8.c: Regenerated. + * generated/maxloc0_4_r4.c: Regenerated. + * generated/maxloc0_4_r8.c: Regenerated. + * generated/maxloc0_8_i4.c: Regenerated. + * generated/maxloc0_8_i8.c: Regenerated. + * generated/maxloc0_8_r4.c: Regenerated. + * generated/maxloc0_8_r8.c: Regenerated. + * generated/maxloc1_4_i4.c: Regenerated. + * generated/maxloc1_4_i8.c: Regenerated. + * generated/maxloc1_4_r4.c: Regenerated. + * generated/maxloc1_4_r8.c: Regenerated. + * generated/maxloc1_8_i4.c: Regenerated. + * generated/maxloc1_8_i8.c: Regenerated. + * generated/maxloc1_8_r4.c: Regenerated. + * generated/maxloc1_8_r8.c: Regenerated. + * generated/maxval_i4.c: Regenerated. + * generated/maxval_i8.c: Regenerated. + * generated/maxval_r4.c: Regenerated. + * generated/maxval_r8.c: Regenerated. + * generated/minloc0_4_i4.c: Regenerated. + * generated/minloc0_4_i8.c: Regenerated. + * generated/minloc0_4_r4.c: Regenerated. + * generated/minloc0_4_r8.c: Regenerated. + * generated/minloc0_8_i4.c: Regenerated. + * generated/minloc0_8_i8.c: Regenerated. + * generated/minloc0_8_r4.c: Regenerated. + * generated/minloc0_8_r8.c: Regenerated. + * generated/minloc1_4_i4.c: Regenerated. + * generated/minloc1_4_i8.c: Regenerated. + * generated/minloc1_4_r4.c: Regenerated. + * generated/minloc1_4_r8.c: Regenerated. + * generated/minloc1_8_i4.c: Regenerated. + * generated/minloc1_8_i8.c: Regenerated. + * generated/minloc1_8_r4.c: Regenerated. + * generated/minloc1_8_r8.c: Regenerated. + * generated/minval_i4.c: Regenerated. + * generated/minval_i8.c: Regenerated. + * generated/minval_r4.c: Regenerated. + * generated/minval_r8.c: Regenerated. + * generated/product_c4.c: Regenerated. + * generated/product_c8.c: Regenerated. + * generated/product_i4.c: Regenerated. + * generated/product_i8.c: Regenerated. + * generated/product_r4.c: Regenerated. + * generated/product_r8.c: Regenerated. + * generated/sum_c4.c: Regenerated. + * generated/sum_c8.c: Regenerated. + * generated/sum_i4.c: Regenerated. + * generated/sum_i8.c: Regenerated. + * generated/sum_r4.c: Regenerated. + * generated/sum_r8.c: Regenerated. + 2005-04-09 Thomas Koenig PR libfortran/20163 diff --git a/libgfortran/generated/all_l4.c b/libgfortran/generated/all_l4.c index 09315e900198..ddf9be1338e8 100644 --- a/libgfortran/generated/all_l4.c +++ b/libgfortran/generated/all_l4.c @@ -55,11 +55,8 @@ all_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ all_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/all_l8.c b/libgfortran/generated/all_l8.c index 6ba381664eef..3978f3170986 100644 --- a/libgfortran/generated/all_l8.c +++ b/libgfortran/generated/all_l8.c @@ -55,11 +55,8 @@ all_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ all_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/any_l4.c b/libgfortran/generated/any_l4.c index 8b9fac090b77..7db73dda8efc 100644 --- a/libgfortran/generated/any_l4.c +++ b/libgfortran/generated/any_l4.c @@ -55,11 +55,8 @@ any_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ any_l4 (gfc_array_l4 *retarray, gfc_array_l4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/any_l8.c b/libgfortran/generated/any_l8.c index 4e853c4dd4af..7814797225ee 100644 --- a/libgfortran/generated/any_l8.c +++ b/libgfortran/generated/any_l8.c @@ -55,11 +55,8 @@ any_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ any_l8 (gfc_array_l8 *retarray, gfc_array_l8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/count_4_l4.c b/libgfortran/generated/count_4_l4.c index 5cf35a46fc41..389c37550ff4 100644 --- a/libgfortran/generated/count_4_l4.c +++ b/libgfortran/generated/count_4_l4.c @@ -55,11 +55,8 @@ count_4_l4 (gfc_array_i4 *retarray, gfc_array_l4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ count_4_l4 (gfc_array_i4 *retarray, gfc_array_l4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/count_4_l8.c b/libgfortran/generated/count_4_l8.c index 359e13d6cabb..44e75eb362e9 100644 --- a/libgfortran/generated/count_4_l8.c +++ b/libgfortran/generated/count_4_l8.c @@ -55,11 +55,8 @@ count_4_l8 (gfc_array_i4 *retarray, gfc_array_l8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ count_4_l8 (gfc_array_i4 *retarray, gfc_array_l8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/count_8_l4.c b/libgfortran/generated/count_8_l4.c index 21b0752d03a0..33fba4ce4eed 100644 --- a/libgfortran/generated/count_8_l4.c +++ b/libgfortran/generated/count_8_l4.c @@ -55,11 +55,8 @@ count_8_l4 (gfc_array_i8 *retarray, gfc_array_l4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ count_8_l4 (gfc_array_i8 *retarray, gfc_array_l4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/count_8_l8.c b/libgfortran/generated/count_8_l8.c index e3f493fea362..a867922b6dc5 100644 --- a/libgfortran/generated/count_8_l8.c +++ b/libgfortran/generated/count_8_l8.c @@ -55,11 +55,8 @@ count_8_l8 (gfc_array_i8 *retarray, gfc_array_l8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ count_8_l8 (gfc_array_i8 *retarray, gfc_array_l8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxloc0_4_i4.c b/libgfortran/generated/maxloc0_4_i4.c index 5063644bf77d..a483c432234a 100644 --- a/libgfortran/generated/maxloc0_4_i4.c +++ b/libgfortran/generated/maxloc0_4_i4.c @@ -53,13 +53,31 @@ maxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mmaxloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc0_4_i8.c b/libgfortran/generated/maxloc0_4_i8.c index 333ffc7cf47e..ced6d6a2fe1a 100644 --- a/libgfortran/generated/maxloc0_4_i8.c +++ b/libgfortran/generated/maxloc0_4_i8.c @@ -53,13 +53,31 @@ maxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mmaxloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc0_4_r4.c b/libgfortran/generated/maxloc0_4_r4.c index a2d0a507b241..06eb04c31e6c 100644 --- a/libgfortran/generated/maxloc0_4_r4.c +++ b/libgfortran/generated/maxloc0_4_r4.c @@ -53,13 +53,31 @@ maxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mmaxloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc0_4_r8.c b/libgfortran/generated/maxloc0_4_r8.c index 43aca18ad3df..791321815bb7 100644 --- a/libgfortran/generated/maxloc0_4_r8.c +++ b/libgfortran/generated/maxloc0_4_r8.c @@ -53,13 +53,31 @@ maxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mmaxloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc0_8_i4.c b/libgfortran/generated/maxloc0_8_i4.c index 0af2b9ac6fe2..49d370d73237 100644 --- a/libgfortran/generated/maxloc0_8_i4.c +++ b/libgfortran/generated/maxloc0_8_i4.c @@ -53,13 +53,31 @@ maxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mmaxloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc0_8_i8.c b/libgfortran/generated/maxloc0_8_i8.c index 15b3b926f22d..100c011d9672 100644 --- a/libgfortran/generated/maxloc0_8_i8.c +++ b/libgfortran/generated/maxloc0_8_i8.c @@ -53,13 +53,31 @@ maxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mmaxloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc0_8_r4.c b/libgfortran/generated/maxloc0_8_r4.c index 7f41920c8feb..4cf8364d882d 100644 --- a/libgfortran/generated/maxloc0_8_r4.c +++ b/libgfortran/generated/maxloc0_8_r4.c @@ -53,13 +53,31 @@ maxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mmaxloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc0_8_r8.c b/libgfortran/generated/maxloc0_8_r8.c index e539cb38d29a..1a0cceee555c 100644 --- a/libgfortran/generated/maxloc0_8_r8.c +++ b/libgfortran/generated/maxloc0_8_r8.c @@ -53,13 +53,31 @@ maxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mmaxloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/maxloc1_4_i4.c b/libgfortran/generated/maxloc1_4_i4.c index 633dc64a291f..38c6836aa3dd 100644 --- a/libgfortran/generated/maxloc1_4_i4.c +++ b/libgfortran/generated/maxloc1_4_i4.c @@ -57,11 +57,8 @@ maxloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ maxloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mmaxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mmaxloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxloc1_4_i8.c b/libgfortran/generated/maxloc1_4_i8.c index 76a7314cd37f..9c6c7320255a 100644 --- a/libgfortran/generated/maxloc1_4_i8.c +++ b/libgfortran/generated/maxloc1_4_i8.c @@ -57,11 +57,8 @@ maxloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ maxloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mmaxloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxloc1_4_r4.c b/libgfortran/generated/maxloc1_4_r4.c index 93c625b872bc..4048d2bc65ac 100644 --- a/libgfortran/generated/maxloc1_4_r4.c +++ b/libgfortran/generated/maxloc1_4_r4.c @@ -57,11 +57,8 @@ maxloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ maxloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mmaxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mmaxloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxloc1_4_r8.c b/libgfortran/generated/maxloc1_4_r8.c index 4114023d48b5..f27a1df41374 100644 --- a/libgfortran/generated/maxloc1_4_r8.c +++ b/libgfortran/generated/maxloc1_4_r8.c @@ -57,11 +57,8 @@ maxloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ maxloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mmaxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mmaxloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxloc1_8_i4.c b/libgfortran/generated/maxloc1_8_i4.c index 3ad74db4f04e..448c9f9bd16d 100644 --- a/libgfortran/generated/maxloc1_8_i4.c +++ b/libgfortran/generated/maxloc1_8_i4.c @@ -57,11 +57,8 @@ maxloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ maxloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mmaxloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxloc1_8_i8.c b/libgfortran/generated/maxloc1_8_i8.c index f52e0c5d3971..fb91a6a05ce4 100644 --- a/libgfortran/generated/maxloc1_8_i8.c +++ b/libgfortran/generated/maxloc1_8_i8.c @@ -57,11 +57,8 @@ maxloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ maxloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mmaxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mmaxloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxloc1_8_r4.c b/libgfortran/generated/maxloc1_8_r4.c index d8079e5df745..33159fb28b39 100644 --- a/libgfortran/generated/maxloc1_8_r4.c +++ b/libgfortran/generated/maxloc1_8_r4.c @@ -57,11 +57,8 @@ maxloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ maxloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mmaxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mmaxloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxloc1_8_r8.c b/libgfortran/generated/maxloc1_8_r8.c index 107cbee36826..b1f780567daa 100644 --- a/libgfortran/generated/maxloc1_8_r8.c +++ b/libgfortran/generated/maxloc1_8_r8.c @@ -57,11 +57,8 @@ maxloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ maxloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mmaxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mmaxloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxval_i4.c b/libgfortran/generated/maxval_i4.c index 9cb359c8e376..e992327dd226 100644 --- a/libgfortran/generated/maxval_i4.c +++ b/libgfortran/generated/maxval_i4.c @@ -56,11 +56,8 @@ maxval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -94,8 +91,17 @@ maxval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -185,11 +191,8 @@ mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -211,6 +214,34 @@ mmaxval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxval_i8.c b/libgfortran/generated/maxval_i8.c index 3c52d7115dae..3e6037715538 100644 --- a/libgfortran/generated/maxval_i8.c +++ b/libgfortran/generated/maxval_i8.c @@ -56,11 +56,8 @@ maxval_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -94,8 +91,17 @@ maxval_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -185,11 +191,8 @@ mmaxval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -211,6 +214,34 @@ mmaxval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxval_r4.c b/libgfortran/generated/maxval_r4.c index 5ed4e16e31dd..8e94efbfe91b 100644 --- a/libgfortran/generated/maxval_r4.c +++ b/libgfortran/generated/maxval_r4.c @@ -56,11 +56,8 @@ maxval_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -94,8 +91,17 @@ maxval_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -185,11 +191,8 @@ mmaxval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -211,6 +214,34 @@ mmaxval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/maxval_r8.c b/libgfortran/generated/maxval_r8.c index 7311c384c3ab..40a3575a793a 100644 --- a/libgfortran/generated/maxval_r8.c +++ b/libgfortran/generated/maxval_r8.c @@ -56,11 +56,8 @@ maxval_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -94,8 +91,17 @@ maxval_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -185,11 +191,8 @@ mmaxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -211,6 +214,34 @@ mmaxval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minloc0_4_i4.c b/libgfortran/generated/minloc0_4_i4.c index defdc8587340..178bf5af5dfd 100644 --- a/libgfortran/generated/minloc0_4_i4.c +++ b/libgfortran/generated/minloc0_4_i4.c @@ -53,13 +53,31 @@ minloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mminloc0_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc0_4_i8.c b/libgfortran/generated/minloc0_4_i8.c index 0625e40fa1ef..d87a444c96cb 100644 --- a/libgfortran/generated/minloc0_4_i8.c +++ b/libgfortran/generated/minloc0_4_i8.c @@ -53,13 +53,31 @@ minloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mminloc0_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc0_4_r4.c b/libgfortran/generated/minloc0_4_r4.c index ff691666709f..21c9edf451e2 100644 --- a/libgfortran/generated/minloc0_4_r4.c +++ b/libgfortran/generated/minloc0_4_r4.c @@ -53,13 +53,31 @@ minloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mminloc0_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc0_4_r8.c b/libgfortran/generated/minloc0_4_r8.c index 6010bd19662c..a00d0135e872 100644 --- a/libgfortran/generated/minloc0_4_r8.c +++ b/libgfortran/generated/minloc0_4_r8.c @@ -53,13 +53,31 @@ minloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mminloc0_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_4) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc0_8_i4.c b/libgfortran/generated/minloc0_8_i4.c index 2b401149f8f9..340c54d8aee9 100644 --- a/libgfortran/generated/minloc0_8_i4.c +++ b/libgfortran/generated/minloc0_8_i4.c @@ -53,13 +53,31 @@ minloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mminloc0_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc0_8_i8.c b/libgfortran/generated/minloc0_8_i8.c index 0398268b4327..5941eb4c4b18 100644 --- a/libgfortran/generated/minloc0_8_i8.c +++ b/libgfortran/generated/minloc0_8_i8.c @@ -53,13 +53,31 @@ minloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mminloc0_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc0_8_r4.c b/libgfortran/generated/minloc0_8_r4.c index 80cd6e1b35b3..9900bc98ed5c 100644 --- a/libgfortran/generated/minloc0_8_r4.c +++ b/libgfortran/generated/minloc0_8_r4.c @@ -53,13 +53,31 @@ minloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mminloc0_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc0_8_r8.c b/libgfortran/generated/minloc0_8_r8.c index 9d94963f19c3..d1caf2a181c4 100644 --- a/libgfortran/generated/minloc0_8_r8.c +++ b/libgfortran/generated/minloc0_8_r8.c @@ -53,13 +53,31 @@ minloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -150,17 +168,32 @@ mminloc0_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 *array, index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (GFC_INTEGER_8) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/generated/minloc1_4_i4.c b/libgfortran/generated/minloc1_4_i4.c index 6744b4a05c4b..76f082ba6132 100644 --- a/libgfortran/generated/minloc1_4_i4.c +++ b/libgfortran/generated/minloc1_4_i4.c @@ -57,11 +57,8 @@ minloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ minloc1_4_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mminloc1_4_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minloc1_4_i8.c b/libgfortran/generated/minloc1_4_i8.c index c9dad8039db5..358b4fa88b43 100644 --- a/libgfortran/generated/minloc1_4_i8.c +++ b/libgfortran/generated/minloc1_4_i8.c @@ -57,11 +57,8 @@ minloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ minloc1_4_i8 (gfc_array_i4 *retarray, gfc_array_i8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mminloc1_4_i8 (gfc_array_i4 * retarray, gfc_array_i8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minloc1_4_r4.c b/libgfortran/generated/minloc1_4_r4.c index f8d4c14a4692..b61e6b5bb0f9 100644 --- a/libgfortran/generated/minloc1_4_r4.c +++ b/libgfortran/generated/minloc1_4_r4.c @@ -57,11 +57,8 @@ minloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ minloc1_4_r4 (gfc_array_i4 *retarray, gfc_array_r4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mminloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mminloc1_4_r4 (gfc_array_i4 * retarray, gfc_array_r4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minloc1_4_r8.c b/libgfortran/generated/minloc1_4_r8.c index 43a38c4f07e4..65c1fac6e288 100644 --- a/libgfortran/generated/minloc1_4_r8.c +++ b/libgfortran/generated/minloc1_4_r8.c @@ -57,11 +57,8 @@ minloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ minloc1_4_r8 (gfc_array_i4 *retarray, gfc_array_r8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mminloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mminloc1_4_r8 (gfc_array_i4 * retarray, gfc_array_r8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minloc1_8_i4.c b/libgfortran/generated/minloc1_8_i4.c index 0928a69f7a2b..a428c919c6c7 100644 --- a/libgfortran/generated/minloc1_8_i4.c +++ b/libgfortran/generated/minloc1_8_i4.c @@ -57,11 +57,8 @@ minloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ minloc1_8_i4 (gfc_array_i8 *retarray, gfc_array_i4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mminloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mminloc1_8_i4 (gfc_array_i8 * retarray, gfc_array_i4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minloc1_8_i8.c b/libgfortran/generated/minloc1_8_i8.c index 02545f5ec474..fd7f8d6147f7 100644 --- a/libgfortran/generated/minloc1_8_i8.c +++ b/libgfortran/generated/minloc1_8_i8.c @@ -57,11 +57,8 @@ minloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ minloc1_8_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mminloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mminloc1_8_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minloc1_8_r4.c b/libgfortran/generated/minloc1_8_r4.c index 11927221c071..0f15fc44c818 100644 --- a/libgfortran/generated/minloc1_8_r4.c +++ b/libgfortran/generated/minloc1_8_r4.c @@ -57,11 +57,8 @@ minloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ minloc1_8_r4 (gfc_array_i8 *retarray, gfc_array_r4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mminloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mminloc1_8_r4 (gfc_array_i8 * retarray, gfc_array_r4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minloc1_8_r8.c b/libgfortran/generated/minloc1_8_r8.c index ca1c977311de..edd9a7191e69 100644 --- a/libgfortran/generated/minloc1_8_r8.c +++ b/libgfortran/generated/minloc1_8_r8.c @@ -57,11 +57,8 @@ minloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -95,8 +92,17 @@ minloc1_8_r8 (gfc_array_i8 *retarray, gfc_array_r8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -191,11 +197,8 @@ mminloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -217,6 +220,34 @@ mminloc1_8_r8 (gfc_array_i8 * retarray, gfc_array_r8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minval_i4.c b/libgfortran/generated/minval_i4.c index 8808eba7da4b..69330111b9ad 100644 --- a/libgfortran/generated/minval_i4.c +++ b/libgfortran/generated/minval_i4.c @@ -56,11 +56,8 @@ minval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -94,8 +91,17 @@ minval_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -185,11 +191,8 @@ mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -211,6 +214,34 @@ mminval_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minval_i8.c b/libgfortran/generated/minval_i8.c index bd55c10f6103..579e5f971813 100644 --- a/libgfortran/generated/minval_i8.c +++ b/libgfortran/generated/minval_i8.c @@ -56,11 +56,8 @@ minval_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -94,8 +91,17 @@ minval_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -185,11 +191,8 @@ mminval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -211,6 +214,34 @@ mminval_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minval_r4.c b/libgfortran/generated/minval_r4.c index 1e1568cf9311..d936e2c871ed 100644 --- a/libgfortran/generated/minval_r4.c +++ b/libgfortran/generated/minval_r4.c @@ -56,11 +56,8 @@ minval_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -94,8 +91,17 @@ minval_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -185,11 +191,8 @@ mminval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -211,6 +214,34 @@ mminval_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/minval_r8.c b/libgfortran/generated/minval_r8.c index 68310d2c6e92..a85e29efae26 100644 --- a/libgfortran/generated/minval_r8.c +++ b/libgfortran/generated/minval_r8.c @@ -56,11 +56,8 @@ minval_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -94,8 +91,17 @@ minval_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -185,11 +191,8 @@ mminval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -211,6 +214,34 @@ mminval_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/product_c4.c b/libgfortran/generated/product_c4.c index 6c03615d1159..29604708812e 100644 --- a/libgfortran/generated/product_c4.c +++ b/libgfortran/generated/product_c4.c @@ -55,11 +55,8 @@ product_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ product_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ mproduct_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/product_c8.c b/libgfortran/generated/product_c8.c index dbc6cb772d23..fc3eccb11107 100644 --- a/libgfortran/generated/product_c8.c +++ b/libgfortran/generated/product_c8.c @@ -55,11 +55,8 @@ product_c8 (gfc_array_c8 *retarray, gfc_array_c8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ product_c8 (gfc_array_c8 *retarray, gfc_array_c8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ mproduct_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ mproduct_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/product_i4.c b/libgfortran/generated/product_i4.c index f7481f65e082..d349b66b1186 100644 --- a/libgfortran/generated/product_i4.c +++ b/libgfortran/generated/product_i4.c @@ -55,11 +55,8 @@ product_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ product_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ mproduct_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ mproduct_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/product_i8.c b/libgfortran/generated/product_i8.c index b3237b2d034b..1fe07458e0ba 100644 --- a/libgfortran/generated/product_i8.c +++ b/libgfortran/generated/product_i8.c @@ -55,11 +55,8 @@ product_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ product_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ mproduct_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ mproduct_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/product_r4.c b/libgfortran/generated/product_r4.c index 03844afea1a0..592210d7705e 100644 --- a/libgfortran/generated/product_r4.c +++ b/libgfortran/generated/product_r4.c @@ -55,11 +55,8 @@ product_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ product_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ mproduct_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ mproduct_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/product_r8.c b/libgfortran/generated/product_r8.c index daf4a9c3bafb..922bcbe834e7 100644 --- a/libgfortran/generated/product_r8.c +++ b/libgfortran/generated/product_r8.c @@ -55,11 +55,8 @@ product_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ product_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ mproduct_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ mproduct_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/sum_c4.c b/libgfortran/generated/sum_c4.c index 37fd93cba4ec..74efd07c65ba 100644 --- a/libgfortran/generated/sum_c4.c +++ b/libgfortran/generated/sum_c4.c @@ -55,11 +55,8 @@ sum_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ sum_c4 (gfc_array_c4 *retarray, gfc_array_c4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ msum_c4 (gfc_array_c4 * retarray, gfc_array_c4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/sum_c8.c b/libgfortran/generated/sum_c8.c index ec040cbd78c3..7d688104d55e 100644 --- a/libgfortran/generated/sum_c8.c +++ b/libgfortran/generated/sum_c8.c @@ -55,11 +55,8 @@ sum_c8 (gfc_array_c8 *retarray, gfc_array_c8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ sum_c8 (gfc_array_c8 *retarray, gfc_array_c8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ msum_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ msum_c8 (gfc_array_c8 * retarray, gfc_array_c8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_COMPLEX_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/sum_i4.c b/libgfortran/generated/sum_i4.c index 371241c2e2e3..01b41126746d 100644 --- a/libgfortran/generated/sum_i4.c +++ b/libgfortran/generated/sum_i4.c @@ -55,11 +55,8 @@ sum_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ sum_i4 (gfc_array_i4 *retarray, gfc_array_i4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ msum_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ msum_i4 (gfc_array_i4 * retarray, gfc_array_i4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/sum_i8.c b/libgfortran/generated/sum_i8.c index 10e3e99cd493..df882c8137ee 100644 --- a/libgfortran/generated/sum_i8.c +++ b/libgfortran/generated/sum_i8.c @@ -55,11 +55,8 @@ sum_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ sum_i8 (gfc_array_i8 *retarray, gfc_array_i8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ msum_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ msum_i8 (gfc_array_i8 * retarray, gfc_array_i8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_INTEGER_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/sum_r4.c b/libgfortran/generated/sum_r4.c index aa993f383dea..d88384dc9081 100644 --- a/libgfortran/generated/sum_r4.c +++ b/libgfortran/generated/sum_r4.c @@ -55,11 +55,8 @@ sum_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ sum_r4 (gfc_array_r4 *retarray, gfc_array_r4 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ msum_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ msum_r4 (gfc_array_r4 * retarray, gfc_array_r4 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_4) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/generated/sum_r8.c b/libgfortran/generated/sum_r8.c index a3540d8edeb2..6658de723972 100644 --- a/libgfortran/generated/sum_r8.c +++ b/libgfortran/generated/sum_r8.c @@ -55,11 +55,8 @@ sum_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -93,8 +90,17 @@ sum_r8 (gfc_array_r8 *retarray, gfc_array_r8 *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -183,11 +189,8 @@ msum_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -209,6 +212,34 @@ msum_r8 (gfc_array_r8 * retarray, gfc_array_r8 * array, array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (GFC_REAL_8) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; diff --git a/libgfortran/m4/iforeach.m4 b/libgfortran/m4/iforeach.m4 index 105ca97c6d9f..616caf94621c 100644 --- a/libgfortran/m4/iforeach.m4 +++ b/libgfortran/m4/iforeach.m4 @@ -20,13 +20,31 @@ name`'rtype_qual`_'atype_code (rtype * retarray, atype *array) index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; @@ -109,17 +127,32 @@ void index_type n; rank = GFC_DESCRIPTOR_RANK (array); - assert (rank > 0); - assert (GFC_DESCRIPTOR_RANK (retarray) == 1); - assert (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound == rank); - assert (GFC_DESCRIPTOR_RANK (mask) == rank); + if (rank <= 0) + runtime_error ("Rank of array needs to be > 0"); + + if (retarray->data == NULL) + { + retarray->dim[0].lbound = 0; + retarray->dim[0].ubound = rank-1; + retarray->dim[0].stride = 1; + retarray->dtype = (retarray->dtype & ~GFC_DTYPE_RANK_MASK) | 1; + retarray->base = 0; + retarray->data = internal_malloc_size (sizeof (rtype_name) * rank); + } + else + { + if (GFC_DESCRIPTOR_RANK (retarray) != 1) + runtime_error ("rank of return array does not equal 1"); + + if (retarray->dim[0].ubound + 1 - retarray->dim[0].lbound != rank) + runtime_error ("dimension of return array incorrect"); + + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + } if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; dstride = retarray->dim[0].stride; dest = retarray->data; diff --git a/libgfortran/m4/ifunction.m4 b/libgfortran/m4/ifunction.m4 index 6c4dfbe02736..b377677a5ebc 100644 --- a/libgfortran/m4/ifunction.m4 +++ b/libgfortran/m4/ifunction.m4 @@ -40,11 +40,8 @@ name`'rtype_qual`_'atype_code (rtype *retarray, atype *array, index_type *pdim) /* Make dim zero based to avoid confusion. */ dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; delta = array->dim[dim].stride; @@ -78,8 +75,17 @@ name`'rtype_qual`_'atype_code (rtype *retarray, atype *array, index_type *pdim) * retarray->dim[rank-1].stride * extent[rank-1]); retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; } - + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0; @@ -168,11 +174,8 @@ void dim = (*pdim) - 1; rank = GFC_DESCRIPTOR_RANK (array) - 1; - assert (rank == GFC_DESCRIPTOR_RANK (retarray)); if (array->dim[0].stride == 0) array->dim[0].stride = 1; - if (retarray->dim[0].stride == 0) - retarray->dim[0].stride = 1; len = array->dim[dim].ubound + 1 - array->dim[dim].lbound; if (len <= 0) @@ -194,6 +197,34 @@ void array->dim[n + 1].ubound + 1 - array->dim[n + 1].lbound; } + if (retarray->data == NULL) + { + for (n = 0; n < rank; n++) + { + retarray->dim[n].lbound = 0; + retarray->dim[n].ubound = extent[n]-1; + if (n == 0) + retarray->dim[n].stride = 1; + else + retarray->dim[n].stride = retarray->dim[n-1].stride * extent[n-1]; + } + + retarray->data + = internal_malloc_size (sizeof (rtype_name) + * retarray->dim[rank-1].stride + * extent[rank-1]); + retarray->base = 0; + retarray->dtype = (array->dtype & ~GFC_DTYPE_RANK_MASK) | rank; + } + else + { + if (retarray->dim[0].stride == 0) + retarray->dim[0].stride = 1; + + if (rank != GFC_DESCRIPTOR_RANK (retarray)) + runtime_error ("rank of return array incorrect"); + } + for (n = 0; n < rank; n++) { count[n] = 0;