[Patch, libfortran] Fix PR 19014 and 19106
Thomas Koenig
Thomas.Koenig@online.de
Fri Apr 8 22:13:00 GMT 2005
Hello, world,
this fixes PR 19106 and PR 19014. The solution adopted should
work. This time, I've also added checks in the test cases.
Regression-test on 4.0 and mainline tomorrow (I have to go to
bed sometimes :-)
OK if this passes?
Thomas
2005-04-09 Thomas Koenig <Thomas.Koenig@online.de>
PR libfortran/19106
PR libfortran/19014
* m4/iforeach.m4 (name`'rtype_qual`_'atype_code):
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): ditto.
* m4/ifunction.m4 (name`'rtype_qual`_'atype_code): ditto.
(`m'name`'rtype_qual`_'atype_code): ditto.
* 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 write statements
* gfortran.fortran-torture/execute/intrinsic_count.f90:
Added test for write statements
* gfortran.fortran-torture/execute/intrinsic_mmloc.f90:
Added test for write statements
* gfortran.fortran-torture/execute/intrinsic_mmval.f90:
Added test for write statements
* gfortran.fortran-torture/execute/intrinsic_product.f90:
Added test for write statements
* gfortran.fortran-torture/execute/intrinsic_sum.f90:
Added test for write statements
-------------- next part --------------
Index: iforeach.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/iforeach.m4,v
retrieving revision 1.6
diff -p -c -r1.6 iforeach.m4
*** iforeach.m4 12 Jan 2005 21:27:31 -0000 1.6
--- iforeach.m4 8 Apr 2005 21:54:02 -0000
*************** name`'rtype_qual`_'atype_code (rtype * r
*** 21,32 ****
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 (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;
--- 21,48 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** void
*** 110,125 ****
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 (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;
--- 126,154 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: ifunction.m4
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/m4/ifunction.m4,v
retrieving revision 1.8
diff -p -c -r1.8 ifunction.m4
*** ifunction.m4 12 Jan 2005 21:27:31 -0000 1.8
--- ifunction.m4 8 Apr 2005 21:54:02 -0000
*************** name`'rtype_qual`_'atype_code (rtype *re
*** 40,50 ****
/* 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;
--- 40,47 ----
*************** name`'rtype_qual`_'atype_code (rtype *re
*** 78,85 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 75,91 ----
* 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;
*************** void
*** 168,178 ****
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)
--- 174,181 ----
*************** void
*** 194,199 ****
--- 197,230 ----
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;
-------------- next part --------------
Index: all_l4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/all_l4.c,v
retrieving revision 1.8
diff -p -c -r1.8 all_l4.c
*** all_l4.c 12 Jan 2005 21:27:32 -0000 1.8
--- all_l4.c 8 Apr 2005 21:54:21 -0000
*************** all_l4 (gfc_array_l4 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** all_l4 (gfc_array_l4 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
Index: all_l8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/all_l8.c,v
retrieving revision 1.8
diff -p -c -r1.8 all_l8.c
*** all_l8.c 12 Jan 2005 21:27:32 -0000 1.8
--- all_l8.c 8 Apr 2005 21:54:22 -0000
*************** all_l8 (gfc_array_l8 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** all_l8 (gfc_array_l8 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
Index: any_l4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/any_l4.c,v
retrieving revision 1.8
diff -p -c -r1.8 any_l4.c
*** any_l4.c 12 Jan 2005 21:27:32 -0000 1.8
--- any_l4.c 8 Apr 2005 21:54:22 -0000
*************** any_l4 (gfc_array_l4 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** any_l4 (gfc_array_l4 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
Index: any_l8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/any_l8.c,v
retrieving revision 1.8
diff -p -c -r1.8 any_l8.c
*** any_l8.c 12 Jan 2005 21:27:32 -0000 1.8
--- any_l8.c 8 Apr 2005 21:54:22 -0000
*************** any_l8 (gfc_array_l8 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** any_l8 (gfc_array_l8 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
Index: count_4_l4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/count_4_l4.c,v
retrieving revision 1.8
diff -p -c -r1.8 count_4_l4.c
*** count_4_l4.c 12 Jan 2005 21:27:32 -0000 1.8
--- count_4_l4.c 8 Apr 2005 21:54:23 -0000
*************** count_4_l4 (gfc_array_i4 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** count_4_l4 (gfc_array_i4 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
Index: count_4_l8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/count_4_l8.c,v
retrieving revision 1.8
diff -p -c -r1.8 count_4_l8.c
*** count_4_l8.c 12 Jan 2005 21:27:32 -0000 1.8
--- count_4_l8.c 8 Apr 2005 21:54:23 -0000
*************** count_4_l8 (gfc_array_i4 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** count_4_l8 (gfc_array_i4 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
Index: count_8_l4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/count_8_l4.c,v
retrieving revision 1.8
diff -p -c -r1.8 count_8_l4.c
*** count_8_l4.c 12 Jan 2005 21:27:32 -0000 1.8
--- count_8_l4.c 8 Apr 2005 21:54:23 -0000
*************** count_8_l4 (gfc_array_i8 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** count_8_l4 (gfc_array_i8 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
Index: count_8_l8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/count_8_l8.c,v
retrieving revision 1.8
diff -p -c -r1.8 count_8_l8.c
*** count_8_l8.c 12 Jan 2005 21:27:32 -0000 1.8
--- count_8_l8.c 8 Apr 2005 21:54:23 -0000
*************** count_8_l8 (gfc_array_i8 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** count_8_l8 (gfc_array_i8 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
Index: maxloc0_4_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc0_4_i4.c,v
retrieving revision 1.6
diff -p -c -r1.6 maxloc0_4_i4.c
*** maxloc0_4_i4.c 12 Jan 2005 21:27:32 -0000 1.6
--- maxloc0_4_i4.c 8 Apr 2005 21:54:32 -0000
*************** maxloc0_4_i4 (gfc_array_i4 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mmaxloc0_4_i4 (gfc_array_i4 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: maxloc0_4_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc0_4_i8.c,v
retrieving revision 1.6
diff -p -c -r1.6 maxloc0_4_i8.c
*** maxloc0_4_i8.c 12 Jan 2005 21:27:32 -0000 1.6
--- maxloc0_4_i8.c 8 Apr 2005 21:54:32 -0000
*************** maxloc0_4_i8 (gfc_array_i4 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mmaxloc0_4_i8 (gfc_array_i4 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: maxloc0_4_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc0_4_r4.c,v
retrieving revision 1.6
diff -p -c -r1.6 maxloc0_4_r4.c
*** maxloc0_4_r4.c 12 Jan 2005 21:27:32 -0000 1.6
--- maxloc0_4_r4.c 8 Apr 2005 21:54:33 -0000
*************** maxloc0_4_r4 (gfc_array_i4 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mmaxloc0_4_r4 (gfc_array_i4 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: maxloc0_4_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc0_4_r8.c,v
retrieving revision 1.6
diff -p -c -r1.6 maxloc0_4_r8.c
*** maxloc0_4_r8.c 12 Jan 2005 21:27:32 -0000 1.6
--- maxloc0_4_r8.c 8 Apr 2005 21:54:33 -0000
*************** maxloc0_4_r8 (gfc_array_i4 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mmaxloc0_4_r8 (gfc_array_i4 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: maxloc0_8_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc0_8_i4.c,v
retrieving revision 1.6
diff -p -c -r1.6 maxloc0_8_i4.c
*** maxloc0_8_i4.c 12 Jan 2005 21:27:32 -0000 1.6
--- maxloc0_8_i4.c 8 Apr 2005 21:54:34 -0000
*************** maxloc0_8_i4 (gfc_array_i8 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mmaxloc0_8_i4 (gfc_array_i8 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: maxloc0_8_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc0_8_i8.c,v
retrieving revision 1.6
diff -p -c -r1.6 maxloc0_8_i8.c
*** maxloc0_8_i8.c 12 Jan 2005 21:27:32 -0000 1.6
--- maxloc0_8_i8.c 8 Apr 2005 21:54:34 -0000
*************** maxloc0_8_i8 (gfc_array_i8 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mmaxloc0_8_i8 (gfc_array_i8 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: maxloc0_8_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc0_8_r4.c,v
retrieving revision 1.6
diff -p -c -r1.6 maxloc0_8_r4.c
*** maxloc0_8_r4.c 12 Jan 2005 21:27:32 -0000 1.6
--- maxloc0_8_r4.c 8 Apr 2005 21:54:34 -0000
*************** maxloc0_8_r4 (gfc_array_i8 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mmaxloc0_8_r4 (gfc_array_i8 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: maxloc0_8_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc0_8_r8.c,v
retrieving revision 1.6
diff -p -c -r1.6 maxloc0_8_r8.c
*** maxloc0_8_r8.c 12 Jan 2005 21:27:32 -0000 1.6
--- maxloc0_8_r8.c 8 Apr 2005 21:54:35 -0000
*************** maxloc0_8_r8 (gfc_array_i8 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mmaxloc0_8_r8 (gfc_array_i8 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: maxloc1_4_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc1_4_i4.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxloc1_4_i4.c
*** maxloc1_4_i4.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxloc1_4_i4.c 8 Apr 2005 21:54:35 -0000
*************** maxloc1_4_i4 (gfc_array_i4 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** maxloc1_4_i4 (gfc_array_i4 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mmaxloc1_4_i4 (gfc_array_i4 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mmaxloc1_4_i4 (gfc_array_i4 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: maxloc1_4_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc1_4_i8.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxloc1_4_i8.c
*** maxloc1_4_i8.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxloc1_4_i8.c 8 Apr 2005 21:54:36 -0000
*************** maxloc1_4_i8 (gfc_array_i4 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** maxloc1_4_i8 (gfc_array_i4 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mmaxloc1_4_i8 (gfc_array_i4 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mmaxloc1_4_i8 (gfc_array_i4 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: maxloc1_4_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc1_4_r4.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxloc1_4_r4.c
*** maxloc1_4_r4.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxloc1_4_r4.c 8 Apr 2005 21:54:37 -0000
*************** maxloc1_4_r4 (gfc_array_i4 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** maxloc1_4_r4 (gfc_array_i4 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mmaxloc1_4_r4 (gfc_array_i4 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mmaxloc1_4_r4 (gfc_array_i4 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: maxloc1_4_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc1_4_r8.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxloc1_4_r8.c
*** maxloc1_4_r8.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxloc1_4_r8.c 8 Apr 2005 21:54:37 -0000
*************** maxloc1_4_r8 (gfc_array_i4 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** maxloc1_4_r8 (gfc_array_i4 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mmaxloc1_4_r8 (gfc_array_i4 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mmaxloc1_4_r8 (gfc_array_i4 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: maxloc1_8_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc1_8_i4.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxloc1_8_i4.c
*** maxloc1_8_i4.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxloc1_8_i4.c 8 Apr 2005 21:54:38 -0000
*************** maxloc1_8_i4 (gfc_array_i8 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** maxloc1_8_i4 (gfc_array_i8 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mmaxloc1_8_i4 (gfc_array_i8 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mmaxloc1_8_i4 (gfc_array_i8 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: maxloc1_8_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc1_8_i8.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxloc1_8_i8.c
*** maxloc1_8_i8.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxloc1_8_i8.c 8 Apr 2005 21:54:38 -0000
*************** maxloc1_8_i8 (gfc_array_i8 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** maxloc1_8_i8 (gfc_array_i8 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mmaxloc1_8_i8 (gfc_array_i8 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mmaxloc1_8_i8 (gfc_array_i8 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: maxloc1_8_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc1_8_r4.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxloc1_8_r4.c
*** maxloc1_8_r4.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxloc1_8_r4.c 8 Apr 2005 21:54:39 -0000
*************** maxloc1_8_r4 (gfc_array_i8 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** maxloc1_8_r4 (gfc_array_i8 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mmaxloc1_8_r4 (gfc_array_i8 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mmaxloc1_8_r4 (gfc_array_i8 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: maxloc1_8_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxloc1_8_r8.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxloc1_8_r8.c
*** maxloc1_8_r8.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxloc1_8_r8.c 8 Apr 2005 21:54:39 -0000
*************** maxloc1_8_r8 (gfc_array_i8 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** maxloc1_8_r8 (gfc_array_i8 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mmaxloc1_8_r8 (gfc_array_i8 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mmaxloc1_8_r8 (gfc_array_i8 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: maxval_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxval_i4.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxval_i4.c
*** maxval_i4.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxval_i4.c 8 Apr 2005 21:54:40 -0000
*************** maxval_i4 (gfc_array_i4 *retarray, gfc_a
*** 56,66 ****
/* 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;
--- 56,63 ----
*************** maxval_i4 (gfc_array_i4 *retarray, gfc_a
*** 94,101 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 91,107 ----
* 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;
*************** mmaxval_i4 (gfc_array_i4 * retarray, gfc
*** 185,195 ****
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)
--- 191,198 ----
*************** mmaxval_i4 (gfc_array_i4 * retarray, gfc
*** 211,216 ****
--- 214,247 ----
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;
Index: maxval_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxval_i8.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxval_i8.c
*** maxval_i8.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxval_i8.c 8 Apr 2005 21:54:40 -0000
*************** maxval_i8 (gfc_array_i8 *retarray, gfc_a
*** 56,66 ****
/* 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;
--- 56,63 ----
*************** maxval_i8 (gfc_array_i8 *retarray, gfc_a
*** 94,101 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 91,107 ----
* 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;
*************** mmaxval_i8 (gfc_array_i8 * retarray, gfc
*** 185,195 ****
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)
--- 191,198 ----
*************** mmaxval_i8 (gfc_array_i8 * retarray, gfc
*** 211,216 ****
--- 214,247 ----
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;
Index: maxval_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxval_r4.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxval_r4.c
*** maxval_r4.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxval_r4.c 8 Apr 2005 21:54:41 -0000
*************** maxval_r4 (gfc_array_r4 *retarray, gfc_a
*** 56,66 ****
/* 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;
--- 56,63 ----
*************** maxval_r4 (gfc_array_r4 *retarray, gfc_a
*** 94,101 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 91,107 ----
* 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;
*************** mmaxval_r4 (gfc_array_r4 * retarray, gfc
*** 185,195 ****
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)
--- 191,198 ----
*************** mmaxval_r4 (gfc_array_r4 * retarray, gfc
*** 211,216 ****
--- 214,247 ----
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;
Index: maxval_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/maxval_r8.c,v
retrieving revision 1.8
diff -p -c -r1.8 maxval_r8.c
*** maxval_r8.c 12 Jan 2005 21:27:32 -0000 1.8
--- maxval_r8.c 8 Apr 2005 21:54:41 -0000
*************** maxval_r8 (gfc_array_r8 *retarray, gfc_a
*** 56,66 ****
/* 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;
--- 56,63 ----
*************** maxval_r8 (gfc_array_r8 *retarray, gfc_a
*** 94,101 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 91,107 ----
* 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;
*************** mmaxval_r8 (gfc_array_r8 * retarray, gfc
*** 185,195 ****
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)
--- 191,198 ----
*************** mmaxval_r8 (gfc_array_r8 * retarray, gfc
*** 211,216 ****
--- 214,247 ----
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;
Index: minloc0_4_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc0_4_i4.c,v
retrieving revision 1.6
diff -p -c -r1.6 minloc0_4_i4.c
*** minloc0_4_i4.c 12 Jan 2005 21:27:32 -0000 1.6
--- minloc0_4_i4.c 8 Apr 2005 21:54:42 -0000
*************** minloc0_4_i4 (gfc_array_i4 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mminloc0_4_i4 (gfc_array_i4 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: minloc0_4_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc0_4_i8.c,v
retrieving revision 1.6
diff -p -c -r1.6 minloc0_4_i8.c
*** minloc0_4_i8.c 12 Jan 2005 21:27:32 -0000 1.6
--- minloc0_4_i8.c 8 Apr 2005 21:54:42 -0000
*************** minloc0_4_i8 (gfc_array_i4 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mminloc0_4_i8 (gfc_array_i4 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: minloc0_4_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc0_4_r4.c,v
retrieving revision 1.6
diff -p -c -r1.6 minloc0_4_r4.c
*** minloc0_4_r4.c 12 Jan 2005 21:27:32 -0000 1.6
--- minloc0_4_r4.c 8 Apr 2005 21:54:43 -0000
*************** minloc0_4_r4 (gfc_array_i4 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mminloc0_4_r4 (gfc_array_i4 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: minloc0_4_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc0_4_r8.c,v
retrieving revision 1.6
diff -p -c -r1.6 minloc0_4_r8.c
*** minloc0_4_r8.c 12 Jan 2005 21:27:32 -0000 1.6
--- minloc0_4_r8.c 8 Apr 2005 21:54:43 -0000
*************** minloc0_4_r8 (gfc_array_i4 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mminloc0_4_r8 (gfc_array_i4 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: minloc0_8_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc0_8_i4.c,v
retrieving revision 1.6
diff -p -c -r1.6 minloc0_8_i4.c
*** minloc0_8_i4.c 12 Jan 2005 21:27:32 -0000 1.6
--- minloc0_8_i4.c 8 Apr 2005 21:54:43 -0000
*************** minloc0_8_i4 (gfc_array_i8 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mminloc0_8_i4 (gfc_array_i8 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: minloc0_8_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc0_8_i8.c,v
retrieving revision 1.6
diff -p -c -r1.6 minloc0_8_i8.c
*** minloc0_8_i8.c 12 Jan 2005 21:27:32 -0000 1.6
--- minloc0_8_i8.c 8 Apr 2005 21:54:44 -0000
*************** minloc0_8_i8 (gfc_array_i8 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mminloc0_8_i8 (gfc_array_i8 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: minloc0_8_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc0_8_r4.c,v
retrieving revision 1.6
diff -p -c -r1.6 minloc0_8_r4.c
*** minloc0_8_r4.c 12 Jan 2005 21:27:32 -0000 1.6
--- minloc0_8_r4.c 8 Apr 2005 21:54:44 -0000
*************** minloc0_8_r4 (gfc_array_i8 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mminloc0_8_r4 (gfc_array_i8 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: minloc0_8_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc0_8_r8.c,v
retrieving revision 1.6
diff -p -c -r1.6 minloc0_8_r8.c
*** minloc0_8_r8.c 12 Jan 2005 21:27:32 -0000 1.6
--- minloc0_8_r8.c 8 Apr 2005 21:54:45 -0000
*************** minloc0_8_r8 (gfc_array_i8 * retarray, g
*** 54,65 ****
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 (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;
--- 54,81 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
*************** mminloc0_8_r8 (gfc_array_i8 * retarray,
*** 151,166 ****
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 (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;
--- 167,195 ----
rank = GFC_DESCRIPTOR_RANK (array);
assert (rank > 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;
dstride = retarray->dim[0].stride;
dest = retarray->data;
Index: minloc1_4_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc1_4_i4.c,v
retrieving revision 1.8
diff -p -c -r1.8 minloc1_4_i4.c
*** minloc1_4_i4.c 12 Jan 2005 21:27:32 -0000 1.8
--- minloc1_4_i4.c 8 Apr 2005 21:54:45 -0000
*************** minloc1_4_i4 (gfc_array_i4 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** minloc1_4_i4 (gfc_array_i4 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mminloc1_4_i4 (gfc_array_i4 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mminloc1_4_i4 (gfc_array_i4 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: minloc1_4_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc1_4_i8.c,v
retrieving revision 1.8
diff -p -c -r1.8 minloc1_4_i8.c
*** minloc1_4_i8.c 12 Jan 2005 21:27:32 -0000 1.8
--- minloc1_4_i8.c 8 Apr 2005 21:54:46 -0000
*************** minloc1_4_i8 (gfc_array_i4 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** minloc1_4_i8 (gfc_array_i4 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mminloc1_4_i8 (gfc_array_i4 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mminloc1_4_i8 (gfc_array_i4 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: minloc1_4_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc1_4_r4.c,v
retrieving revision 1.8
diff -p -c -r1.8 minloc1_4_r4.c
*** minloc1_4_r4.c 12 Jan 2005 21:27:32 -0000 1.8
--- minloc1_4_r4.c 8 Apr 2005 21:54:47 -0000
*************** minloc1_4_r4 (gfc_array_i4 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** minloc1_4_r4 (gfc_array_i4 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mminloc1_4_r4 (gfc_array_i4 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mminloc1_4_r4 (gfc_array_i4 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: minloc1_4_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc1_4_r8.c,v
retrieving revision 1.8
diff -p -c -r1.8 minloc1_4_r8.c
*** minloc1_4_r8.c 12 Jan 2005 21:27:32 -0000 1.8
--- minloc1_4_r8.c 8 Apr 2005 21:54:48 -0000
*************** minloc1_4_r8 (gfc_array_i4 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** minloc1_4_r8 (gfc_array_i4 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mminloc1_4_r8 (gfc_array_i4 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mminloc1_4_r8 (gfc_array_i4 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: minloc1_8_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc1_8_i4.c,v
retrieving revision 1.8
diff -p -c -r1.8 minloc1_8_i4.c
*** minloc1_8_i4.c 12 Jan 2005 21:27:32 -0000 1.8
--- minloc1_8_i4.c 8 Apr 2005 21:54:48 -0000
*************** minloc1_8_i4 (gfc_array_i8 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** minloc1_8_i4 (gfc_array_i8 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mminloc1_8_i4 (gfc_array_i8 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mminloc1_8_i4 (gfc_array_i8 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: minloc1_8_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc1_8_i8.c,v
retrieving revision 1.8
diff -p -c -r1.8 minloc1_8_i8.c
*** minloc1_8_i8.c 12 Jan 2005 21:27:32 -0000 1.8
--- minloc1_8_i8.c 8 Apr 2005 21:54:49 -0000
*************** minloc1_8_i8 (gfc_array_i8 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** minloc1_8_i8 (gfc_array_i8 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mminloc1_8_i8 (gfc_array_i8 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mminloc1_8_i8 (gfc_array_i8 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: minloc1_8_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc1_8_r4.c,v
retrieving revision 1.8
diff -p -c -r1.8 minloc1_8_r4.c
*** minloc1_8_r4.c 12 Jan 2005 21:27:32 -0000 1.8
--- minloc1_8_r4.c 8 Apr 2005 21:54:49 -0000
*************** minloc1_8_r4 (gfc_array_i8 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** minloc1_8_r4 (gfc_array_i8 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mminloc1_8_r4 (gfc_array_i8 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mminloc1_8_r4 (gfc_array_i8 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: minloc1_8_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minloc1_8_r8.c,v
retrieving revision 1.8
diff -p -c -r1.8 minloc1_8_r8.c
*** minloc1_8_r8.c 12 Jan 2005 21:27:32 -0000 1.8
--- minloc1_8_r8.c 8 Apr 2005 21:54:50 -0000
*************** minloc1_8_r8 (gfc_array_i8 *retarray, gf
*** 57,67 ****
/* 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;
--- 57,64 ----
*************** minloc1_8_r8 (gfc_array_i8 *retarray, gf
*** 95,102 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 92,108 ----
* 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;
*************** mminloc1_8_r8 (gfc_array_i8 * retarray,
*** 191,201 ****
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)
--- 197,204 ----
*************** mminloc1_8_r8 (gfc_array_i8 * retarray,
*** 217,222 ****
--- 220,253 ----
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;
Index: minval_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minval_i4.c,v
retrieving revision 1.8
diff -p -c -r1.8 minval_i4.c
*** minval_i4.c 12 Jan 2005 21:27:32 -0000 1.8
--- minval_i4.c 8 Apr 2005 21:54:51 -0000
*************** minval_i4 (gfc_array_i4 *retarray, gfc_a
*** 56,66 ****
/* 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;
--- 56,63 ----
*************** minval_i4 (gfc_array_i4 *retarray, gfc_a
*** 94,101 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 91,107 ----
* 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;
*************** mminval_i4 (gfc_array_i4 * retarray, gfc
*** 185,195 ****
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)
--- 191,198 ----
*************** mminval_i4 (gfc_array_i4 * retarray, gfc
*** 211,216 ****
--- 214,247 ----
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;
Index: minval_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minval_i8.c,v
retrieving revision 1.8
diff -p -c -r1.8 minval_i8.c
*** minval_i8.c 12 Jan 2005 21:27:32 -0000 1.8
--- minval_i8.c 8 Apr 2005 21:54:51 -0000
*************** minval_i8 (gfc_array_i8 *retarray, gfc_a
*** 56,66 ****
/* 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;
--- 56,63 ----
*************** minval_i8 (gfc_array_i8 *retarray, gfc_a
*** 94,101 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 91,107 ----
* 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;
*************** mminval_i8 (gfc_array_i8 * retarray, gfc
*** 185,195 ****
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)
--- 191,198 ----
*************** mminval_i8 (gfc_array_i8 * retarray, gfc
*** 211,216 ****
--- 214,247 ----
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;
Index: minval_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minval_r4.c,v
retrieving revision 1.8
diff -p -c -r1.8 minval_r4.c
*** minval_r4.c 12 Jan 2005 21:27:32 -0000 1.8
--- minval_r4.c 8 Apr 2005 21:54:51 -0000
*************** minval_r4 (gfc_array_r4 *retarray, gfc_a
*** 56,66 ****
/* 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;
--- 56,63 ----
*************** minval_r4 (gfc_array_r4 *retarray, gfc_a
*** 94,101 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 91,107 ----
* 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;
*************** mminval_r4 (gfc_array_r4 * retarray, gfc
*** 185,195 ****
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)
--- 191,198 ----
*************** mminval_r4 (gfc_array_r4 * retarray, gfc
*** 211,216 ****
--- 214,247 ----
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;
Index: minval_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/minval_r8.c,v
retrieving revision 1.8
diff -p -c -r1.8 minval_r8.c
*** minval_r8.c 12 Jan 2005 21:27:32 -0000 1.8
--- minval_r8.c 8 Apr 2005 21:54:52 -0000
*************** minval_r8 (gfc_array_r8 *retarray, gfc_a
*** 56,66 ****
/* 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;
--- 56,63 ----
*************** minval_r8 (gfc_array_r8 *retarray, gfc_a
*** 94,101 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 91,107 ----
* 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;
*************** mminval_r8 (gfc_array_r8 * retarray, gfc
*** 185,195 ****
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)
--- 191,198 ----
*************** mminval_r8 (gfc_array_r8 * retarray, gfc
*** 211,216 ****
--- 214,247 ----
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;
Index: product_c4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/product_c4.c,v
retrieving revision 1.8
diff -p -c -r1.8 product_c4.c
*** product_c4.c 12 Jan 2005 21:27:32 -0000 1.8
--- product_c4.c 8 Apr 2005 21:54:54 -0000
*************** product_c4 (gfc_array_c4 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** product_c4 (gfc_array_c4 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** mproduct_c4 (gfc_array_c4 * retarray, gf
*** 183,193 ****
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)
--- 189,196 ----
*************** mproduct_c4 (gfc_array_c4 * retarray, gf
*** 209,214 ****
--- 212,245 ----
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;
Index: product_c8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/product_c8.c,v
retrieving revision 1.8
diff -p -c -r1.8 product_c8.c
*** product_c8.c 12 Jan 2005 21:27:32 -0000 1.8
--- product_c8.c 8 Apr 2005 21:54:54 -0000
*************** product_c8 (gfc_array_c8 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** product_c8 (gfc_array_c8 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** mproduct_c8 (gfc_array_c8 * retarray, gf
*** 183,193 ****
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)
--- 189,196 ----
*************** mproduct_c8 (gfc_array_c8 * retarray, gf
*** 209,214 ****
--- 212,245 ----
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;
Index: product_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/product_i4.c,v
retrieving revision 1.8
diff -p -c -r1.8 product_i4.c
*** product_i4.c 12 Jan 2005 21:27:32 -0000 1.8
--- product_i4.c 8 Apr 2005 21:54:55 -0000
*************** product_i4 (gfc_array_i4 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** product_i4 (gfc_array_i4 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** mproduct_i4 (gfc_array_i4 * retarray, gf
*** 183,193 ****
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)
--- 189,196 ----
*************** mproduct_i4 (gfc_array_i4 * retarray, gf
*** 209,214 ****
--- 212,245 ----
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;
Index: product_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/product_i8.c,v
retrieving revision 1.8
diff -p -c -r1.8 product_i8.c
*** product_i8.c 12 Jan 2005 21:27:32 -0000 1.8
--- product_i8.c 8 Apr 2005 21:54:55 -0000
*************** product_i8 (gfc_array_i8 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** product_i8 (gfc_array_i8 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** mproduct_i8 (gfc_array_i8 * retarray, gf
*** 183,193 ****
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)
--- 189,196 ----
*************** mproduct_i8 (gfc_array_i8 * retarray, gf
*** 209,214 ****
--- 212,245 ----
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;
Index: product_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/product_r4.c,v
retrieving revision 1.8
diff -p -c -r1.8 product_r4.c
*** product_r4.c 12 Jan 2005 21:27:32 -0000 1.8
--- product_r4.c 8 Apr 2005 21:54:56 -0000
*************** product_r4 (gfc_array_r4 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** product_r4 (gfc_array_r4 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** mproduct_r4 (gfc_array_r4 * retarray, gf
*** 183,193 ****
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)
--- 189,196 ----
*************** mproduct_r4 (gfc_array_r4 * retarray, gf
*** 209,214 ****
--- 212,245 ----
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;
Index: product_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/product_r8.c,v
retrieving revision 1.8
diff -p -c -r1.8 product_r8.c
*** product_r8.c 12 Jan 2005 21:27:32 -0000 1.8
--- product_r8.c 8 Apr 2005 21:54:56 -0000
*************** product_r8 (gfc_array_r8 *retarray, gfc_
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** product_r8 (gfc_array_r8 *retarray, gfc_
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** mproduct_r8 (gfc_array_r8 * retarray, gf
*** 183,193 ****
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)
--- 189,196 ----
*************** mproduct_r8 (gfc_array_r8 * retarray, gf
*** 209,214 ****
--- 212,245 ----
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;
Index: sum_c4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/sum_c4.c,v
retrieving revision 1.8
diff -p -c -r1.8 sum_c4.c
*** sum_c4.c 12 Jan 2005 21:27:33 -0000 1.8
--- sum_c4.c 8 Apr 2005 21:54:58 -0000
*************** sum_c4 (gfc_array_c4 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** sum_c4 (gfc_array_c4 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** msum_c4 (gfc_array_c4 * retarray, gfc_ar
*** 183,193 ****
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)
--- 189,196 ----
*************** msum_c4 (gfc_array_c4 * retarray, gfc_ar
*** 209,214 ****
--- 212,245 ----
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;
Index: sum_c8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/sum_c8.c,v
retrieving revision 1.8
diff -p -c -r1.8 sum_c8.c
*** sum_c8.c 12 Jan 2005 21:27:33 -0000 1.8
--- sum_c8.c 8 Apr 2005 21:54:59 -0000
*************** sum_c8 (gfc_array_c8 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** sum_c8 (gfc_array_c8 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** msum_c8 (gfc_array_c8 * retarray, gfc_ar
*** 183,193 ****
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)
--- 189,196 ----
*************** msum_c8 (gfc_array_c8 * retarray, gfc_ar
*** 209,214 ****
--- 212,245 ----
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;
Index: sum_i4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/sum_i4.c,v
retrieving revision 1.8
diff -p -c -r1.8 sum_i4.c
*** sum_i4.c 12 Jan 2005 21:27:33 -0000 1.8
--- sum_i4.c 8 Apr 2005 21:54:59 -0000
*************** sum_i4 (gfc_array_i4 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** sum_i4 (gfc_array_i4 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** msum_i4 (gfc_array_i4 * retarray, gfc_ar
*** 183,193 ****
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)
--- 189,196 ----
*************** msum_i4 (gfc_array_i4 * retarray, gfc_ar
*** 209,214 ****
--- 212,245 ----
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;
Index: sum_i8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/sum_i8.c,v
retrieving revision 1.8
diff -p -c -r1.8 sum_i8.c
*** sum_i8.c 12 Jan 2005 21:27:33 -0000 1.8
--- sum_i8.c 8 Apr 2005 21:55:00 -0000
*************** sum_i8 (gfc_array_i8 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** sum_i8 (gfc_array_i8 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** msum_i8 (gfc_array_i8 * retarray, gfc_ar
*** 183,193 ****
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)
--- 189,196 ----
*************** msum_i8 (gfc_array_i8 * retarray, gfc_ar
*** 209,214 ****
--- 212,245 ----
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;
Index: sum_r4.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/sum_r4.c,v
retrieving revision 1.8
diff -p -c -r1.8 sum_r4.c
*** sum_r4.c 12 Jan 2005 21:27:33 -0000 1.8
--- sum_r4.c 8 Apr 2005 21:55:00 -0000
*************** sum_r4 (gfc_array_r4 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** sum_r4 (gfc_array_r4 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** msum_r4 (gfc_array_r4 * retarray, gfc_ar
*** 183,193 ****
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)
--- 189,196 ----
*************** msum_r4 (gfc_array_r4 * retarray, gfc_ar
*** 209,214 ****
--- 212,245 ----
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;
Index: sum_r8.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/generated/sum_r8.c,v
retrieving revision 1.8
diff -p -c -r1.8 sum_r8.c
*** sum_r8.c 12 Jan 2005 21:27:33 -0000 1.8
--- sum_r8.c 8 Apr 2005 21:55:01 -0000
*************** sum_r8 (gfc_array_r8 *retarray, gfc_arra
*** 55,65 ****
/* 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;
--- 55,62 ----
*************** sum_r8 (gfc_array_r8 *retarray, gfc_arra
*** 93,100 ****
* retarray->dim[rank-1].stride
* extent[rank-1]);
retarray->base = 0;
}
!
for (n = 0; n < rank; n++)
{
count[n] = 0;
--- 90,106 ----
* 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;
*************** msum_r8 (gfc_array_r8 * retarray, gfc_ar
*** 183,193 ****
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)
--- 189,196 ----
*************** msum_r8 (gfc_array_r8 * retarray, gfc_ar
*** 209,214 ****
--- 212,245 ----
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;
-------------- next part --------------
Index: intrinsic_anyall.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_anyall.f90,v
retrieving revision 1.2
diff -c -r1.2 intrinsic_anyall.f90
*** intrinsic_anyall.f90 13 May 2004 06:40:53 -0000 1.2
--- intrinsic_anyall.f90 8 Apr 2005 21:55:51 -0000
***************
*** 3,8 ****
--- 3,9 ----
implicit none
logical, dimension(3, 3) :: a
logical, dimension(3) :: b
+ character(len=10) line
a = .false.
if (any(a)) call abort
***************
*** 13,18 ****
--- 14,25 ----
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,26 ****
--- 30,41 ----
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
Index: intrinsic_count.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_count.f90,v
retrieving revision 1.2
diff -c -r1.2 intrinsic_count.f90
*** intrinsic_count.f90 13 May 2004 06:40:53 -0000 1.2
--- intrinsic_count.f90 8 Apr 2005 21:55:51 -0000
***************
*** 4,9 ****
--- 4,10 ----
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,21 ****
--- 14,34 ----
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
Index: intrinsic_mmloc.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmloc.f90,v
retrieving revision 1.2
diff -c -r1.2 intrinsic_mmloc.f90
*** intrinsic_mmloc.f90 13 May 2004 06:40:53 -0000 1.2
--- intrinsic_mmloc.f90 8 Apr 2005 21:55:51 -0000
***************
*** 5,10 ****
--- 5,11 ----
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,17 ****
--- 13,24 ----
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,38 ****
--- 27,69 ----
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,52 ****
--- 72,102 ----
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
Index: intrinsic_mmval.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_mmval.f90,v
retrieving revision 1.2
diff -c -r1.2 intrinsic_mmval.f90
*** intrinsic_mmval.f90 13 May 2004 06:40:53 -0000 1.2
--- intrinsic_mmval.f90 8 Apr 2005 21:55:51 -0000
***************
*** 5,28 ****
--- 5,39 ----
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
Index: intrinsic_product.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_product.f90,v
retrieving revision 1.2
diff -c -r1.2 intrinsic_product.f90
*** intrinsic_product.f90 13 May 2004 06:40:53 -0000 1.2
--- intrinsic_product.f90 8 Apr 2005 21:55:51 -0000
***************
*** 4,9 ****
--- 4,10 ----
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,18 ****
--- 12,25 ----
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,25 ****
--- 27,40 ----
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
Index: intrinsic_sum.f90
===================================================================
RCS file: /cvs/gcc/gcc/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_sum.f90,v
retrieving revision 1.2
diff -c -r1.2 intrinsic_sum.f90
*** intrinsic_sum.f90 13 May 2004 06:40:53 -0000 1.2
--- intrinsic_sum.f90 8 Apr 2005 21:55:52 -0000
***************
*** 5,26 ****
--- 5,39 ----
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
More information about the Gcc-patches
mailing list