re PR fortran/71902 (Unneeded temporary on reallocatable character assignment)
authorThomas Koenig <tkoenig@gcc.gnu.org>
Tue, 19 Jul 2016 21:25:33 +0000 (21:25 +0000)
committerThomas Koenig <tkoenig@gcc.gnu.org>
Tue, 19 Jul 2016 21:25:33 +0000 (21:25 +0000)
2016-07-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

PR fortran/71902
* dependency.c (gfc_check_dependency): Use dep_ref.  Handle case
if identical is true and two array element references differ.
(gfc_dep_resovler):  Move most of the code to dep_ref.
(dep_ref):  New function.
* frontend-passes.c (realloc_string_callback):  Name temporary
variable "realloc_string".

2016-07-19  Thomas Koenig  <tkoenig@gcc.gnu.org>

PR fortran/71902
* gfortran.dg/dependency_47.f90:  New test.

From-SVN: r238497

gcc/fortran/ChangeLog
gcc/fortran/dependency.c
gcc/fortran/frontend-passes.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/dependency_47.f90 [new file with mode: 0644]

index 04335d927266e8cd41e6f663bb67fdb5aa68b788..2912fcb125e0e11d851edeffa9c6b96a433f412e 100644 (file)
@@ -1,3 +1,13 @@
+2016-07-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/71902
+       * dependency.c (gfc_check_dependency): Use dep_ref.  Handle case
+       if identical is true and two array element references differ.
+       (gfc_dep_resovler):  Move most of the code to dep_ref.
+       (dep_ref):  New function.
+       * frontend-passes.c (realloc_string_callback):  Name temporary
+       variable "realloc_string".
+
 2016-07-17  Fritz Reese  <fritzoreese@gmail.com>
 
        PR fortran/71523
index f117de03640e95b77ebe6b11035b9795fee7b628..a873dbe933ca3ba2053f7ff45b829f7fef2ebbc5 100644 (file)
@@ -54,6 +54,8 @@ enum gfc_dependency
 static gfc_dependency check_section_vs_section (gfc_array_ref *,
                                                gfc_array_ref *, int);
 
+static gfc_dependency dep_ref (gfc_ref *, gfc_ref *, gfc_reverse *);
+
 /* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
    def if the value could not be determined.  */
 
@@ -1316,13 +1318,33 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
          return 0;
        }
 
-      if (identical)
-       return 1;
-
       /* Identical and disjoint ranges return 0,
         overlapping ranges return 1.  */
       if (expr1->ref && expr2->ref)
-       return gfc_dep_resolver (expr1->ref, expr2->ref, NULL);
+       {
+         gfc_dependency dep;
+         dep = dep_ref (expr1->ref, expr2->ref, NULL);
+         switch (dep)
+           {
+           case GFC_DEP_EQUAL:
+             return identical;
+
+           case GFC_DEP_FORWARD:
+             return 0;
+
+           case GFC_DEP_BACKWARD:
+             return 1;
+
+           case GFC_DEP_OVERLAP:
+             return 1;
+
+           case GFC_DEP_NODEP:
+             return 0;
+
+           default:
+             gcc_unreachable();
+           }
+       }
 
       return 1;
 
@@ -2052,10 +2074,38 @@ ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
        2 : array references are overlapping but reversal of one or
            more dimensions will clear the dependency.
        1 : array references are overlapping.
-       0 : array references are identical or not overlapping.  */
+       0 : array references are identical or can be handled in a forward loop.  */
 
 int
 gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
+{
+  enum gfc_dependency dep;
+  dep = dep_ref (lref, rref, reverse);
+  switch (dep)
+    {
+    case GFC_DEP_EQUAL:
+      return 0;
+
+    case GFC_DEP_FORWARD:
+      return 0;
+
+    case GFC_DEP_BACKWARD:
+      return 2;
+
+    case GFC_DEP_OVERLAP:
+      return 1;
+
+    case GFC_DEP_NODEP:
+      return 0;
+
+    default:
+      gcc_unreachable();
+    }
+}
+
+
+static gfc_dependency
+dep_ref (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
 {
   int n;
   int m;
@@ -2079,21 +2129,22 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
          /* The two ranges can't overlap if they are from different
             components.  */
          if (lref->u.c.component != rref->u.c.component)
-           return 0;
+           return GFC_DEP_NODEP;
          break;
 
        case REF_SUBSTRING:
          /* Substring overlaps are handled by the string assignment code
             if there is not an underlying dependency.  */
-         return (fin_dep == GFC_DEP_OVERLAP) ? 1 : 0;
+
+         return fin_dep == GFC_DEP_ERROR ? GFC_DEP_NODEP : fin_dep;
 
        case REF_ARRAY:
 
          if (ref_same_as_full_array (lref, rref))
-           return 0;
+           return GFC_DEP_EQUAL;
 
          if (ref_same_as_full_array (rref, lref))
-           return 0;
+           return GFC_DEP_EQUAL;
 
          if (lref->u.ar.dimen != rref->u.ar.dimen)
            {
@@ -2104,7 +2155,7 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
                fin_dep = gfc_full_array_ref_p (lref, NULL) ? GFC_DEP_EQUAL
                                                            : GFC_DEP_OVERLAP;
              else
-               return 1;
+               return GFC_DEP_OVERLAP;
              break;
            }
 
@@ -2148,7 +2199,7 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
 
              /* If any dimension doesn't overlap, we have no dependency.  */
              if (this_dep == GFC_DEP_NODEP)
-               return 0;
+               return GFC_DEP_NODEP;
 
              /* Now deal with the loop reversal logic:  This only works on
                 ranges and is activated by setting
@@ -2215,7 +2266,7 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
          /* Exactly matching and forward overlapping ranges don't cause a
             dependency.  */
          if (fin_dep < GFC_DEP_BACKWARD)
-           return 0;
+           return fin_dep == GFC_DEP_ERROR ? GFC_DEP_NODEP : fin_dep;
 
          /* Keep checking.  We only have a dependency if
             subsequent references also overlap.  */
@@ -2233,7 +2284,7 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
 
   /* Assume the worst if we nest to different depths.  */
   if (lref || rref)
-    return 1;
+    return GFC_DEP_OVERLAP;
 
-  return fin_dep == GFC_DEP_OVERLAP;
+  return fin_dep;
 }
index 9ae3421da057306ca2cbfcd182fb2658665c8b18..d4dee47ab75b14461bf367de05d065364561883b 100644 (file)
@@ -185,7 +185,7 @@ realloc_string_callback (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
   current_code = c;
   inserted_block = NULL;
   changed_statement = NULL;
-  n = create_var (expr2, "trim");
+  n = create_var (expr2, "realloc_string");
   co->expr2 = n;
   return 0;
 }
index ceae017ce8f29bb5115b2ec21831323544e359d3..47ca52628641a19e33f9a9c147420e9fc7deb078 100644 (file)
@@ -1,3 +1,8 @@
+2016-07-19  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR fortran/71902
+       * gfortran.dg/dependency_47.f90:  New test.
+
 2016-07-19  Jakub Jelinek  <jakub@redhat.com>
 
        PR rtl-optimization/71916
diff --git a/gcc/testsuite/gfortran.dg/dependency_47.f90 b/gcc/testsuite/gfortran.dg/dependency_47.f90
new file mode 100644 (file)
index 0000000..eebc910
--- /dev/null
@@ -0,0 +1,15 @@
+! { dg-do compile }
+! Make sure there is only one instance of a temporary variable here.
+! { dg-options "-fdump-tree-original" }
+
+SUBROUTINE prtdata(ilen)
+  INTEGER :: ilen
+  character(len=ilen), allocatable :: cline(:)
+  allocate(cline(2))
+  cline(1) = 'a'
+  cline(1)(2:3) = cline(1)(1:2)
+  cline(2) = cline(1)
+  print *,c
+END SUBROUTINE prtdata
+! { dg-final { scan-tree-dump-not "__var_2" "original" } }
+! { dg-final { scan-tree-dump-times "__var_1" 3 "original" } }