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

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

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

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)

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

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
+
+