re PR fortran/38863 (WHERE with multiple elemental defined assignments gives wrong...

[thirdparty/gcc.git] / gcc / fortran / dependency.c

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 265cf20f3d4b05f3aa3906c751b6c79910a3af70..5f74c34ac5ca4dc7774ad376164be9f454f32b89 100644 (file)
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -1244,6 +1244,71 @@ gfc_full_array_ref_p (gfc_ref *ref)
 }
 
 
+/* Determine if a full array is the same as an array section with one
+   variable limit.  For this to be so, the strides must both be unity
+   and one of either start == lower or end == upper must be true.  */
+
+static bool
+ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
+{
+  int i;
+  bool upper_or_lower;
+
+  if (full_ref->type != REF_ARRAY)
+    return false;
+  if (full_ref->u.ar.type != AR_FULL)
+    return false;
+  if (ref->type != REF_ARRAY)
+    return false;
+  if (ref->u.ar.type != AR_SECTION)
+    return false;
+
+  for (i = 0; i < ref->u.ar.dimen; i++)
+    {
+      /* If we have a single element in the reference, we need to check
+        that the array has a single element and that we actually reference
+        the correct element.  */
+      if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
+       {
+         if (!full_ref->u.ar.as
+             || !full_ref->u.ar.as->lower[i]
+             || !full_ref->u.ar.as->upper[i]
+             || gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
+                                      full_ref->u.ar.as->upper[i])
+             || !ref->u.ar.start[i]
+             || gfc_dep_compare_expr (ref->u.ar.start[i],
+                                      full_ref->u.ar.as->lower[i]))
+           return false;
+       }
+
+      /* Check the strides.  */
+      if (full_ref->u.ar.stride[i] && !gfc_expr_is_one (full_ref->u.ar.stride[i], 0))
+       return false;
+      if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
+       return false;
+
+      upper_or_lower = false;
+      /* Check the lower bound.  */
+      if (ref->u.ar.start[i]
+         && (ref->u.ar.as
+               && full_ref->u.ar.as->lower[i]
+               && gfc_dep_compare_expr (ref->u.ar.start[i],
+                                        full_ref->u.ar.as->lower[i]) == 0))
+       upper_or_lower =  true;
+      /* Check the upper bound.  */
+      if (ref->u.ar.end[i]
+         && (ref->u.ar.as
+               && full_ref->u.ar.as->upper[i]
+               && gfc_dep_compare_expr (ref->u.ar.end[i],
+                                        full_ref->u.ar.as->upper[i]) == 0))
+       upper_or_lower =  true;
+      if (!upper_or_lower)
+       return false;
+    }
+  return true;
+}
+
+
 /* Finds if two array references are overlapping or not.
    Return value
        1 : array references are overlapping.
@@ -1281,6 +1346,13 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref)
          return (fin_dep == GFC_DEP_OVERLAP) ? 1 : 0;
        
        case REF_ARRAY:
+
+         if (ref_same_as_full_array (lref, rref))
+           return 0;
+
+         if (ref_same_as_full_array (rref, lref))
+           return 0;
+
          if (lref->u.ar.dimen != rref->u.ar.dimen)
            {
              if (lref->u.ar.type == AR_FULL)