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

2009-04-06  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38863
	* dependency.c (ref_same_as_full_array): New function.
	(gfc_dep_resolver): Call it.

2009-04-06  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/38863
	* gfortran.dg/dependency_23.f90: New test.

From-SVN: r145621

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 6db6c63..bba5fe5 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2009-04-06  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/38863
+       * dependency.c (ref_same_as_full_array): New function.
+       (gfc_dep_resolver): Call it.
+
 2009-04-06  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/39414

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 265cf20..5f74c34 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)

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ffc5ad2..489ca5b 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2009-04-06  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/38863
+       * gfortran.dg/dependency_23.f90: New test.
+
 2009-04-06  Richard Guenther  <rguenther@suse.de>
 
        PR tree-optimization/28868

diff --git a/gcc/testsuite/gfortran.dg/dependency_23.f90 b/gcc/testsuite/gfortran.dg/dependency_23.f90
new file mode 100644 (file)
index 0000000..bdb1711
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_23.f90
@@ -0,0 +1,56 @@
+! { dg-do run }
+! Test the fix for PR38863, in which an unnecessary temporary
+! generated results that are not consistent with other compilers.
+!
+! Contributed by Dick Hendrickson  <dick.hendrickson@gmail.com>
+!
+module rg0045_stuff
+  type unseq
+    integer :: i
+    logical :: l
+  end type unseq
+  interface assignment(=)
+    module procedure l_to_t, i_to_t
+  end interface
+contains
+  elemental subroutine l_to_t (arg1, arg2)
+    type(unseq), intent(inout) :: arg1
+    logical, intent(in) :: arg2
+    arg1%l = arg2
+  end subroutine l_to_t
+  elemental subroutine i_to_t (arg1, arg2)
+    type(unseq), intent(inout) :: arg1
+    integer, intent(in) :: arg2
+    arg1%i = arg2
+  end subroutine i_to_t
+  subroutine rg0045(nf1, nf2, nf3)
+    type(unseq) :: tla2l(nf3, nf2)
+    type(unseq) :: tda2l(3,2)
+    logical :: lda(nf3,nf2)
+    tda2l%l = reshape ([.true.,.false.,.true.,.false.,.true.,.false.],[3,2])
+    tda2l%i = reshape ([1, -1, 3, -1, 5, -1],[3,2])
+    lda = tda2l%l
+    tla2l%l = lda
+    tla2l%i = reshape ([1, 2, 3, 4, 5, 6], [3,2])
+!
+! The problem occurred here: gfortran was producing a temporary for these
+! assignments because the dependency checking was too restrictive.  Since
+! a temporary was used, the integer component was reset in the first assignment
+! rather than being carried over.
+!
+    where(lda)
+      tla2l = tla2l(1:3, 1:2)%l
+      tla2l = tla2l(1:3, 1:2)%i
+    elsewhere
+      tla2l = -1
+    endwhere
+    if (any (tla2l%i .ne. tda2l%i)) call abort
+    if (any (tla2l%l .neqv. tda2l%l)) call abort
+  end subroutine
+end module rg0045_stuff
+
+  use rg0045_stuff
+  call rg0045(1, 2, 3)
+end
+
+