Committed as obvious (r280046). I will backport to GCC 8 + 9 in the next
days.
* * *
Background – slightly more convoluted than the actual patch :-)
If the to-be-used array spec ("to") has a codimension, one needs to move
it to the right such that the shape for the regular-array dimension fit
there. However, one needs to start shifting from the right, otherwise,
all codimensions have the value of the first codimension!
This happens in merge_array_spec for 'current_as' if one has a
'dimension' attribute followed by a 'codimension' atttribute. – It
happens likewise (but in gfc_set_array_spec) if one has declared a
symbol with codimension (in one of three ways) and then has a
'dimension' statement.
It gets more interesting if one has both a dimension and codimension
attribute (hence: rank + corank in current_as) – and then in the var
spec one overrides this by a codimension (z6 in the example). In that
case, only the codimension data has to be taken from current_as. Here,
the code missed to take into account that the first "from->rank"
elements of upper/lower have to be skipped over, i.e. one needs to copy
'from->rank + 0' to 'from->rank + from->corank' instead of 0 to corank!
Cheers,
Tobias
PR fortran/84135
* array.c (gfc_set_array_spec): Fix shifting of codimensions
when adding a dimension.
* decl.c (merge_array_spec): Ditto. Fix using correct codimensions.
PR fortran/84135
* gfortran.dg/coarray/codimension_3.f90: New.
diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index e5b4ad7b4b2..157acb8cd90 100644
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -887,7 +887,7 @@ gfc_set_array_spec (gfc_symbol *sym, gfc_array_spec *as, locus *error_loc)
if (sym->as->rank + sym->as->corank > GFC_MAX_DIMENSIONS)
goto too_many;
- for (i = 0; i < sym->as->corank; i++)
+ for (i = sym->as->corank - 1; i >= 0; i--)
{
sym->as->lower[as->rank + i] = sym->as->lower[i];
sym->as->upper[as->rank + i] = sym->as->upper[i];
diff --git a/gcc/fortran/decl.c b/gcc/fortran/decl.c
index 67c67667d9e..499d2429aba 100644
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -928,8 +928,6 @@ done:
static bool
merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
{
- int i, j;
-
if ((from->type == AS_ASSUMED_RANK && to->corank)
|| (to->type == AS_ASSUMED_RANK && from->corank))
{
@@ -944,18 +942,18 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
to->cray_pointee = from->cray_pointee;
to->cp_was_assumed = from->cp_was_assumed;
- for (i = 0; i < to->corank; i++)
+ for (int i = to->corank - 1; i >= 0; i--)
{
/* Do not exceed the limits on lower[] and upper[]. gfortran
cleans up elsewhere. */
- j = from->rank + i;
+ int j = from->rank + i;
if (j >= GFC_MAX_DIMENSIONS)
break;
to->lower[j] = to->lower[i];
to->upper[j] = to->upper[i];
}
- for (i = 0; i < from->rank; i++)
+ for (int i = 0; i < from->rank; i++)
{
if (copy)
{
@@ -974,23 +972,24 @@ merge_array_spec (gfc_array_spec *from, gfc_array_spec *to, bool copy)
to->corank = from->corank;
to->cotype = from->cotype;
- for (i = 0; i < from->corank; i++)
+ for (int i = 0; i < from->corank; i++)
{
/* Do not exceed the limits on lower[] and upper[]. gfortran
cleans up elsewhere. */
- j = to->rank + i;
+ int k = from->rank + i;
+ int j = to->rank + i;
if (j >= GFC_MAX_DIMENSIONS)
break;
if (copy)
{
- to->lower[j] = gfc_copy_expr (from->lower[i]);
- to->upper[j] = gfc_copy_expr (from->upper[i]);
+ to->lower[j] = gfc_copy_expr (from->lower[k]);
+ to->upper[j] = gfc_copy_expr (from->upper[k]);
}
else
{
- to->lower[j] = from->lower[i];
- to->upper[j] = from->upper[i];
+ to->lower[j] = from->lower[k];
+ to->upper[j] = from->upper[k];
}
}
}
diff --git a/gcc/testsuite/gfortran.dg/coarray/codimension_3.f90 b/gcc/testsuite/gfortran.dg/coarray/codimension_3.f90
new file mode 100644
index 00000000000..d596f5ae1fe
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/coarray/codimension_3.f90
@@ -0,0 +1,76 @@
+! { dg-do run }
+!
+! PR fortran/84135
+!
+! Co-contributed by G. Steinmetz
+!
+! Ensure that coarray shape remains correct
+! after merging the shape from 'dimension'
+!
+program p
+ integer :: i
+ integer, dimension(3) :: x[2,*]
+ data (x(i:i+2:i+1), i=1,2) /1,2,3/
+ integer, dimension(3) :: y[2,3,-3:4,5,7:*] = [1,2,3]
+ integer :: z, z2[2:4,7:9,-2:2,-7:8,-4:*]
+ codimension :: z[2:4,7:9,-2:2,-7:8,-4:*]
+ integer, codimension[1:*] :: z3[2:4,7:9,-2:2,-7:8,-4:*]
+ dimension :: z(1:2,-3:-2,7:7), z2(1:2,-3:-2,7:7), z3(1:2,-3:-2,7:7)
+ integer, codimension[2:4,7:9,-2:2,-7:8,-4:*], dimension(1:2,-3:-2,7:7) :: z4
+ integer, codimension[*], dimension(1:2,-3:-2,7:7) :: z5[2:4,7:9,-2:2,-7:8,-4:*]
+ integer, codimension[2:4,7:9,-2:2,-7:8,-4:*], dimension(3) :: z6(1:2,-3:-2,7:7)
+ integer, codimension[*], dimension(4) :: z7(1:2,-3:-2,7:7)[2:4,7:9,-2:2,-7:8,-4:*]
+
+ if (any (lcobound(x) /= [1, 1])) stop 1
+ if (any (lcobound(y) /= [1, 1, -3, 1, 7])) stop 3
+ if (any (lcobound(z) /= [2,7,-2,-7,-4])) stop 4
+ if (any (lcobound(z2) /= lcobound(z))) stop 4
+ if (any (lcobound(z3) /= lcobound(z))) stop 5
+ if (any (lcobound(z4) /= lcobound(z))) stop 6
+ if (any (lcobound(z5) /= lcobound(z))) stop 7
+ if (any (lcobound(z6) /= lcobound(z))) stop 8
+ if (any (lcobound(z7) /= lcobound(z))) stop 9
+
+ if (any (lbound(x) /= [1])) stop 11
+ if (any (lbound(y) /= [1])) stop 12
+ if (any (lbound(z) /= [1,-3,7])) stop 13
+ if (any (lbound(z2) /= lbound(z))) stop 14
+ if (any (lbound(z3) /= lbound(z))) stop 15
+ if (any (lbound(z4) /= lbound(z))) stop 16
+ if (any (lbound(z5) /= lbound(z))) stop 17
+ if (any (lbound(z6) /= lbound(z))) stop 18
+ if (any (lbound(z7) /= lbound(z))) stop 19
+
+ if (any (ubound(x) /= [3])) stop 21
+ if (any (ubound(y) /= [3])) stop 22
+ if (any (ubound(z) /= [2,-2,7])) stop 23
+ if (any (ubound(z2) /= ubound(z))) stop 24
+ if (any (ubound(z3) /= ubound(z))) stop 25
+ if (any (ubound(z4) /= ubound(z))) stop 26
+ if (any (ubound(z5) /= ubound(z))) stop 27
+ if (any (ubound(z6) /= ubound(z))) stop 28
+ if (any (ubound(z7) /= ubound(z))) stop 29
+
+ if (any (ucobound(z2) /= ucobound(z))) stop 31
+ if (any (ucobound(z3) /= ucobound(z))) stop 32
+ if (any (ucobound(z4) /= ucobound(z))) stop 33
+ if (any (ucobound(z5) /= ucobound(z))) stop 34
+ if (any (ucobound(z6) /= ucobound(z))) stop 35
+ if (any (ucobound(z7) /= ucobound(z))) stop 36
+
+ if (num_images() == 1) then
+ if (any (ucobound(x) /= [2, lbound(x,dim=1)])) stop 37
+ if (any (ucobound(y) /= [2, 3, 4, 5, 7])) stop 38
+ if (any (ucobound(z) /= [4,9,2,8,-4])) stop 39
+ else
+ if (ucobound(x, dim=1) /= 2) stop 41
+ if (ucobound(y, dim=1) /= 2) stop 42
+ if (ucobound(y, dim=2) /= 3) stop 43
+ if (ucobound(y, dim=3) /= 4) stop 44
+ if (ucobound(y, dim=4) /= 5) stop 45
+ if (ucobound(z, dim=1) /= 4) stop 46
+ if (ucobound(z, dim=2) /= 9) stop 47
+ if (ucobound(z, dim=3) /= 2) stop 48
+ if (ucobound(z, dim=4) /= 8) stop 49
+ endif
+end
