summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authortkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>2005-04-09 21:38:47 +0000
committertkoenig <tkoenig@138bc75d-0d04-0410-961f-82ee72b054a4>2005-04-09 21:38:47 +0000
commit07ea8faa305c0b705c675fc7255da49c66c4f780 (patch)
tree25814186d85901336c2e9c7e9a89298fa18cefc7
parent32fb59abe84b4491fb04818d99930a1fcc3d94aa (diff)
downloadgcc-07ea8faa305c0b705c675fc7255da49c66c4f780.tar.gz
2005-04-09 Thomas Koenig <Thomas.Koenig@online.de>
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 <Thomas.Koenig@online.de> * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@97929 138bc75d-0d04-0410-961f-82ee72b054a4
-rw-r--r--gcc/testsuite/ChangeLog10
-rw-r--r--gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f9015
-rw-r--r--gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f9013
-rw-r--r--gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f9050
-rw-r--r--gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f9011
-rw-r--r--gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f9015
-rw-r--r--gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f9013
-rw-r--r--libgfortran/ChangeLog76
-rw-r--r--libgfortran/generated/all_l4.c14
-rw-r--r--libgfortran/generated/all_l8.c14
-rw-r--r--libgfortran/generated/any_l4.c14
-rw-r--r--libgfortran/generated/any_l8.c14
-rw-r--r--libgfortran/generated/count_4_l4.c14
-rw-r--r--libgfortran/generated/count_4_l8.c14
-rw-r--r--libgfortran/generated/count_8_l4.c14
-rw-r--r--libgfortran/generated/count_8_l8.c14
-rw-r--r--libgfortran/generated/maxloc0_4_i4.c59
-rw-r--r--libgfortran/generated/maxloc0_4_i8.c59
-rw-r--r--libgfortran/generated/maxloc0_4_r4.c59
-rw-r--r--libgfortran/generated/maxloc0_4_r8.c59
-rw-r--r--libgfortran/generated/maxloc0_8_i4.c59
-rw-r--r--libgfortran/generated/maxloc0_8_i8.c59
-rw-r--r--libgfortran/generated/maxloc0_8_r4.c59
-rw-r--r--libgfortran/generated/maxloc0_8_r8.c59
-rw-r--r--libgfortran/generated/maxloc1_4_i4.c45
-rw-r--r--libgfortran/generated/maxloc1_4_i8.c45
-rw-r--r--libgfortran/generated/maxloc1_4_r4.c45
-rw-r--r--libgfortran/generated/maxloc1_4_r8.c45
-rw-r--r--libgfortran/generated/maxloc1_8_i4.c45
-rw-r--r--libgfortran/generated/maxloc1_8_i8.c45
-rw-r--r--libgfortran/generated/maxloc1_8_r4.c45
-rw-r--r--libgfortran/generated/maxloc1_8_r8.c45
-rw-r--r--libgfortran/generated/maxval_i4.c45
-rw-r--r--libgfortran/generated/maxval_i8.c45
-rw-r--r--libgfortran/generated/maxval_r4.c45
-rw-r--r--libgfortran/generated/maxval_r8.c45
-rw-r--r--libgfortran/generated/minloc0_4_i4.c59
-rw-r--r--libgfortran/generated/minloc0_4_i8.c59
-rw-r--r--libgfortran/generated/minloc0_4_r4.c59
-rw-r--r--libgfortran/generated/minloc0_4_r8.c59
-rw-r--r--libgfortran/generated/minloc0_8_i4.c59
-rw-r--r--libgfortran/generated/minloc0_8_i8.c59
-rw-r--r--libgfortran/generated/minloc0_8_r4.c59
-rw-r--r--libgfortran/generated/minloc0_8_r8.c59
-rw-r--r--libgfortran/generated/minloc1_4_i4.c45
-rw-r--r--libgfortran/generated/minloc1_4_i8.c45
-rw-r--r--libgfortran/generated/minloc1_4_r4.c45
-rw-r--r--libgfortran/generated/minloc1_4_r8.c45
-rw-r--r--libgfortran/generated/minloc1_8_i4.c45
-rw-r--r--libgfortran/generated/minloc1_8_i8.c45
-rw-r--r--libgfortran/generated/minloc1_8_r4.c45
-rw-r--r--libgfortran/generated/minloc1_8_r8.c45
-rw-r--r--libgfortran/generated/minval_i4.c45
-rw-r--r--libgfortran/generated/minval_i8.c45
-rw-r--r--libgfortran/generated/minval_r4.c45
-rw-r--r--libgfortran/generated/minval_r8.c45
-rw-r--r--libgfortran/generated/product_c4.c45
-rw-r--r--libgfortran/generated/product_c8.c45
-rw-r--r--libgfortran/generated/product_i4.c45
-rw-r--r--libgfortran/generated/product_i8.c45
-rw-r--r--libgfortran/generated/product_r4.c45
-rw-r--r--libgfortran/generated/product_r8.c45
-rw-r--r--libgfortran/generated/sum_c4.c45
-rw-r--r--libgfortran/generated/sum_c8.c45
-rw-r--r--libgfortran/generated/sum_i4.c45
-rw-r--r--libgfortran/generated/sum_i8.c45
-rw-r--r--libgfortran/generated/sum_r4.c45
-rw-r--r--libgfortran/generated/sum_r8.c45
-rw-r--r--libgfortran/m4/iforeach.m459
-rw-r--r--libgfortran/m4/ifunction.m445
70 files changed, 2471 insertions, 512 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index fe7b88ea7ac..1dfa1457971 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,15 @@
2005-04-09 Thomas Koenig <Thomas.Koenig@online.de>
+ * 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 <Thomas.Koenig@online.de>
+
PR libfortran/20163
* gfortran.dg/open-options-blanks.f: New test.
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90
index d1b99dacb5d..4e392c56960 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 a2de59fb985..f95c198c1f5 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 f64242af9e8..ea73913b6ef 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 368c83ba133..86ec1591727 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 102832c9f9b..2892d5407ca 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 43f832ec63c..552f6c6d01f 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 2f31127bc5a..ba0257d69b6 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,79 @@
+2005-04-09 Thomas Koenig <Thomas.Koenig@online.de>
+
+ 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 <Thomas.Koenig@online.de>
PR libfortran/20163
diff --git a/libgfortran/generated/all_l4.c b/libgfortran/generated/all_l4.c
index 09315e90019..ddf9be1338e 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 6ba381664ee..3978f317098 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 8b9fac090b7..7db73dda8ef 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 4e853c4dd4a..7814797225e 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 5cf35a46fc4..389c37550ff 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 359e13d6cab..44e75eb362e 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 21b0752d03a..33fba4ce4ee 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 e3f493fea36..a867922b6dc 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 5063644bf77..a483c432234 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 333ffc7cf47..ced6d6a2fe1 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 a2d0a507b24..06eb04c31e6 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 43aca18ad3d..791321815bb 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 0af2b9ac6fe..49d370d7323 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 15b3b926f22..100c011d967 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 7f41920c8fe..4cf8364d882 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 e539cb38d29..1a0cceee555 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 633dc64a291..38c6836aa3d 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 76a7314cd37..9c6c7320255 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 93c625b872b..4048d2bc65a 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 4114023d48b..f27a1df4137 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 3ad74db4f04..448c9f9bd16 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 f52e0c5d397..fb91a6a05ce 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 d8079e5df74..33159fb28b3 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 107cbee3682..b1f780567da 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 9cb359c8e37..e992327dd22 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 3c52d7115da..3e603771553 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 5ed4e16e31d..8e94efbfe91 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 7311c384c3a..40a3575a793 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 defdc858734..178bf5af5df 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 0625e40fa1e..d87a444c96c 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 ff691666709..21c9edf451e 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 6010bd19662..a00d0135e87 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 2b401149f8f..340c54d8aee 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 0398268b432..5941eb4c4b1 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 80cd6e1b35b..9900bc98ed5 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 9d94963f19c..d1caf2a181c 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 6744b4a05c4..76f082ba613 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 c9dad8039db..358b4fa88b4 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 f8d4c14a469..b61e6b5bb0f 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 43a38c4f07e..65c1fac6e28 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 0928a69f7a2..a428c919c6c 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 02545f5ec47..fd7f8d6147f 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 11927221c07..0f15fc44c81 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 ca1c977311d..edd9a7191e6 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 8808eba7da4..69330111b9a 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 bd55c10f610..579e5f97181 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 1e1568cf931..d936e2c871e 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 68310d2c6e9..a85e29efae2 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 6c03615d115..29604708812 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 dbc6cb772d2..fc3eccb1110 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 f7481f65e08..d349b66b118 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 b3237b2d034..1fe07458e0b 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 03844afea1a..592210d7705 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 daf4a9c3baf..922bcbe834e 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 37fd93cba4e..74efd07c65b 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 ec040cbd78c..7d688104d55 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 371241c2e2e..01b41126746 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 10e3e99cd49..df882c8137e 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 aa993f383de..d88384dc908 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 a3540d8edeb..6658de72397 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 105ca97c6d9..616caf94621 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 6c4dfbe0273..b377677a5eb 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;