Fortran] PR84135 fix merging dimension into codimension array spec

        Backported from mainline
        2020-01-09  Tobias Burnus  <tobias@codesourcery.com>

        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.

        Backported from mainline
        2020-01-09  Tobias Burnus  <tobias@codesourcery.com>

        PR fortran/84135
        * gfortran.dg/coarray/codimension_3.f90: New.

From-SVN: r280110

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aaf5ded669b0b608155c227a3cc5d364e6dfc9c4..b7f3146d90340e092b27406bc58312b8684b84d8 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,13 @@
+2020-01-10  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backported from mainline
+       2020-01-09  Tobias Burnus  <tobias@codesourcery.com>
+
+       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.
+
 2019-12-30  Thomas Koenig  <tkoenig@gcc.gnu.org>
 
        Backport from trunk
@@ -24,7 +34,7 @@
        Backported from mainline
        2019-12-19  Jakub Jelinek  <jakub@redhat.com>
 
-       PR fortran/92977
+       PR fortran/92977
        * frontend-passes.c (call_external_blas): Use || instead of |.
 
        PR fortran/92977
@@ -495,7 +505,7 @@
 
        PR fortran/42546
        * check.c(gfc_check_allocated): Add comment pointing to ...
-       * intrinsic.c(sort_actual): ... the checking done here.
+       * intrinsic.c(sort_actual): ... the checking done here.
 
 2019-08-12  Release Manager
 

diff --git a/gcc/fortran/array.c b/gcc/fortran/array.c
index ebce014c28f1632ce6eb7165d7df848a498e3885..4a7f44f3e8bc8d514b6dd9c4725b5c269c03de33 100644 (file)
--- a/gcc/fortran/array.c
+++ b/gcc/fortran/array.c
@@ -865,7 +865,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 053f78321c6d482d846a24614cb53ef48a0519a4..abff4af9f673035e33856e893542749c2017a02b 100644 (file)
--- a/gcc/fortran/decl.c
+++ b/gcc/fortran/decl.c
@@ -900,8 +900,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))
     {
@@ -916,18 +914,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)
            {
@@ -946,23 +944,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/ChangeLog b/gcc/testsuite/ChangeLog
index f23c0804b32beb45c788ab2042156a3c615943c5..b39c1069c2979ac1a51892427bcb727b95d2fae7 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2020-01-10  Tobias Burnus  <tobias@codesourcery.com>
+
+       Backported from mainline
+       2020-01-09  Tobias Burnus  <tobias@codesourcery.com>
+
+       PR fortran/84135
+       * gfortran.dg/coarray/codimension_3.f90: New.
+
 2020-01-07  Iain Sandoe  <iain@sandoe.co.uk>
 
        Backport from mainline.
@@ -28,7 +36,7 @@
        Backported from mainline
        2019-12-19  Jakub Jelinek  <jakub@redhat.com>
 
-       PR fortran/92977
+       PR fortran/92977
        * gfortran.dg/gomp/pr92977.f90: New test.
 
        2019-12-14  Jakub Jelinek  <jakub@redhat.com>
@@ -947,7 +955,7 @@
 
        PR fortran/91660
        * gfortran.dg/pdt_4.f03: Fix invalid code.
-        * gfortran.dg/pr91660_1.f90: New test.
+       * gfortran.dg/pr91660_1.f90: New test.
        * gfortran.dg/pr91660_2.f90: Ditto.
 
 2019-09-04  Wilco Dijkstra  <wdijkstr@arm.com>
@@ -998,7 +1006,7 @@
 2019-08-30  Steven G. Kargl  <kargl@gcc.gnu.org>
 
        PR fortran/91551
-       * gfortran.dg/allocated_3.f90
+       * gfortran.dg/allocated_3.f90
 
 2019-08-30  Segher Boessenkool  <segher@kernel.crashing.org>
 
@@ -1965,7 +1973,7 @@
        Backport fom mainline
        2019-06-21  Jeff Law  <law@redhat.com>
 
-        PR tree-optimization/90949
+       PR tree-optimization/90949
        * gcc.c-torture/execute/pr90949.c: New test.
 
 2019-06-26  Martin Jambor  <mjambor@suse.cz>

diff --git a/gcc/testsuite/gfortran.dg/coarray/codimension_3.f90 b/gcc/testsuite/gfortran.dg/coarray/codimension_3.f90
new file mode 100644 (file)
index 0000000..466ed88
--- /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