]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
re PR fortran/61780 (Wrong code when shifting elements of a multidimensional array)
authorPaul Thomas <pault@gcc.gnu.org>
Sat, 19 Jul 2014 14:31:06 +0000 (14:31 +0000)
committerPaul Thomas <pault@gcc.gnu.org>
Sat, 19 Jul 2014 14:31:06 +0000 (14:31 +0000)
2014-07-19  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/61780
* dependency.c (gfc_dep_resolver): Index the 'reverse' array so
that elements are skipped. This then correctly aligns 'reverse'
with the scalarizer loops.

2014-07-19  Paul Thomas  <pault@gcc.gnu.org>

PR fortran/61780
* gfortran.dg/dependency_44.f90 : New test

From-SVN: r212847

gcc/fortran/ChangeLog
gcc/fortran/dependency.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/dependency_44.f90 [new file with mode: 0644]

index c0ab45701357215a22be7668af1b791fa547fd23..a21b5dbe7c771551791eeab4b63465a302eb62ec 100644 (file)
@@ -1,3 +1,11 @@
+2014-07-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from trunk.
+       PR fortran/61780
+       * dependency.c (gfc_dep_resolver): Index the 'reverse' array so
+       that elements are skipped. This then correctly aligns 'reverse'
+       with the scalarizer loops.
+
 2014-07-08  Paul Thomas  <pault@gcc.gnu.org>
 
        PR fortran/61459
index e58bd227bdecaced330704134405894dfcbb1fab..3924905f0eff1233a65798d02d56356435c172d3 100644 (file)
@@ -1779,6 +1779,7 @@ int
 gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
 {
   int n;
+  int m;
   gfc_dependency fin_dep;
   gfc_dependency this_dep;
 
@@ -1828,6 +1829,8 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
              break;
            }
 
+         /* Index for the reverse array.  */
+         m = -1;
          for (n=0; n < lref->u.ar.dimen; n++)
            {
              /* Assume dependency when either of array reference is vector
@@ -1862,38 +1865,44 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
                 The ability to reverse or not is set by previous conditions
                 in this dimension.  If reversal is not activated, the
                 value GFC_DEP_BACKWARD is reset to GFC_DEP_OVERLAP.  */
+
+             /* Get the indexing right for the scalarizing loop. If this
+                is an element, there is no corresponding loop.  */
+             if (lref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+               m++;
+
              if (rref->u.ar.dimen_type[n] == DIMEN_RANGE
                    && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
                {
                  /* Set reverse if backward dependence and not inhibited.  */
-                 if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
-                   reverse[n] = (this_dep == GFC_DEP_BACKWARD) ?
-                                GFC_REVERSE_SET : reverse[n];
+                 if (reverse && reverse[m] == GFC_ENABLE_REVERSE)
+                   reverse[m] = (this_dep == GFC_DEP_BACKWARD) ?
+                                GFC_REVERSE_SET : reverse[m];
 
                  /* Set forward if forward dependence and not inhibited.  */
-                 if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
-                   reverse[n] = (this_dep == GFC_DEP_FORWARD) ?
-                                GFC_FORWARD_SET : reverse[n];
+                 if (reverse && reverse[m] == GFC_ENABLE_REVERSE)
+                   reverse[m] = (this_dep == GFC_DEP_FORWARD) ?
+                                GFC_FORWARD_SET : reverse[m];
 
                  /* Flag up overlap if dependence not compatible with
                     the overall state of the expression.  */
-                 if (reverse && reverse[n] == GFC_REVERSE_SET
+                 if (reverse && reverse[m] == GFC_REVERSE_SET
                        && this_dep == GFC_DEP_FORWARD)
                    {
-                     reverse[n] = GFC_INHIBIT_REVERSE;
+                     reverse[m] = GFC_INHIBIT_REVERSE;
                      this_dep = GFC_DEP_OVERLAP;
                    }
-                 else if (reverse && reverse[n] == GFC_FORWARD_SET
+                 else if (reverse && reverse[m] == GFC_FORWARD_SET
                        && this_dep == GFC_DEP_BACKWARD)
                    {
-                     reverse[n] = GFC_INHIBIT_REVERSE;
+                     reverse[m] = GFC_INHIBIT_REVERSE;
                      this_dep = GFC_DEP_OVERLAP;
                    }
 
                  /* If no intention of reversing or reversing is explicitly
                     inhibited, convert backward dependence to overlap.  */
                  if ((reverse == NULL && this_dep == GFC_DEP_BACKWARD)
-                     || (reverse != NULL && reverse[n] == GFC_INHIBIT_REVERSE))
+                     || (reverse != NULL && reverse[m] == GFC_INHIBIT_REVERSE))
                    this_dep = GFC_DEP_OVERLAP;
                }
 
index c35517d0671e8dffcaf1cd615efd183051d764c4..0c120b6c2901820b9df18bf162c5b336a352608f 100644 (file)
@@ -1,3 +1,9 @@
+2014-07-19  Paul Thomas  <pault@gcc.gnu.org>
+
+       Backport from trunk.
+       PR fortran/61780
+       * gfortran.dg/dependency_44.f90 : New test
+
 2014-07-10  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gnat.dg/opt39.adb: New test.
diff --git a/gcc/testsuite/gfortran.dg/dependency_44.f90 b/gcc/testsuite/gfortran.dg/dependency_44.f90
new file mode 100644 (file)
index 0000000..ebfeec6
--- /dev/null
@@ -0,0 +1,36 @@
+! { dg-do run }
+! Tests fix for PR61780 in which the loop reversal mechanism was
+! not accounting for the first index being an element so that no
+! loop in this dimension is created.
+!
+! Contributed by Manfred Tietze on clf.
+!
+program prgm3
+    implicit none
+    integer, parameter :: n = 10, k = 3
+    integer :: i, j
+    integer, dimension(n,n) :: y
+    integer :: res1(n), res2(n)
+
+1   format(10i5)
+
+!initialize
+    do i=1,n
+        do j=1,n
+            y(i,j) = n*i + j
+        end do
+    end do
+    res2 = y(k,:)
+
+!shift right
+    y(k,4:n) = y(k,3:n-1)
+    y(k,3) = 0
+    res1 = y(k,:)
+    y(k,:) = res2
+    y(k,n:4:-1) = y(k,n-1:3:-1)
+    y(k,3) = 0
+    res2 = y(k,:)
+!    print *, res1
+!    print *, res2
+    if (any(res1 /= res2)) call abort ()
+end program prgm3