Re: [Patch, fortran] PR35759 and PR35756 - WHERE with overlap with ELSEWHERE error

["Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>]

Dominique,
>
> Thank you for being stubborn!
>
> On Mon, Mar 31, 2008 at 11:38 PM, Dominique Dhumieres

I retired to think again on this patch after you correctly pointed out
the problem.  I returned to this and PR35756 in the last few days.  I
produced a variant of gfc_where_3 that did the job... until I looked
at the code.  It was identical to that produced by gfc_trans_where_2.
At this point, I underwent a lightbulb moment - this is a problem with
getting the dependency checking right!

The attached bootstraps and regtests on x86_ia64/FC8 - OK for trunk and 4.3?

Paul

2008-05-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35756
	PR fortran/35759
	* trans-stmt.c (gfc_trans_where): Tighten up the dependency
	check for calling gfc_trans_where_3.

2008-05-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/35756
	PR fortran/35759
	* gfortran.dg/where_1.f90: New test.

Index: gcc/fortran/trans-stmt.c
===================================================================
*** gcc/fortran/trans-stmt.c	(revision 135306)
--- gcc/fortran/trans-stmt.c	(working copy)
*************** gfc_trans_where (gfc_code * code)
*** 3709,3727 ****
  	     block is dependence free if cond is not dependent on writes
  	     to x1 and x2, y1 is not dependent on writes to x2, and y2
  	     is not dependent on writes to x1, and both y's are not
! 	     dependent upon their own x's.  */
  	  if (!gfc_check_dependency(cblock->next->expr,
  				    cblock->expr, 0)
  	      && !gfc_check_dependency(eblock->next->expr,
  				       cblock->expr, 0)
  	      && !gfc_check_dependency(cblock->next->expr,
! 				       eblock->next->expr2, 0)
  	      && !gfc_check_dependency(eblock->next->expr,
! 				       cblock->next->expr2, 0)
  	      && !gfc_check_dependency(cblock->next->expr,
! 				       cblock->next->expr2, 0)
  	      && !gfc_check_dependency(eblock->next->expr,
! 				       eblock->next->expr2, 0))
  	    return gfc_trans_where_3 (cblock, eblock);
  	}
      }
--- 3709,3736 ----
  	     block is dependence free if cond is not dependent on writes
  	     to x1 and x2, y1 is not dependent on writes to x2, and y2
  	     is not dependent on writes to x1, and both y's are not
! 	     dependent upon their own x's.  In addition to this, the
! 	     final two dependency checks below exclude all but the same
! 	     array reference if the where and elswhere destinations
! 	     are the same.  In short, this is VERY conservative and this
! 	     is needed because the two loops, required by the standard
! 	     are coalesced in gfc_trans_where_3.  */
  	  if (!gfc_check_dependency(cblock->next->expr,
  				    cblock->expr, 0)
  	      && !gfc_check_dependency(eblock->next->expr,
  				       cblock->expr, 0)
  	      && !gfc_check_dependency(cblock->next->expr,
! 				       eblock->next->expr2, 1)
  	      && !gfc_check_dependency(eblock->next->expr,
! 				       cblock->next->expr2, 1)
  	      && !gfc_check_dependency(cblock->next->expr,
! 				       cblock->next->expr2, 1)
  	      && !gfc_check_dependency(eblock->next->expr,
! 				       eblock->next->expr2, 1)
! 	      && !gfc_check_dependency(cblock->next->expr,
! 				       eblock->next->expr, 0)
! 	      && !gfc_check_dependency(eblock->next->expr,
! 				       cblock->next->expr, 0))
  	    return gfc_trans_where_3 (cblock, eblock);
  	}
      }
Index: gcc/testsuite/gfortran.dg/where_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/where_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/where_1.f90	(revision 0)
***************
*** 0 ****
--- 1,64 ----
+ ! { dg-do run }
+ ! Tests the fix for PR35759 and PR35756 in which the dependencies
+ ! led to an incorrect use of the "simple where", gfc_trans_where_3.
+ !
+ ! Contributed by Dick Hendrickson <dick.hendrickson@gmail.com>
+ !
+   logical :: la(6) = (/(2*(i/2) /= i, i = 1, 6)/), lb(6)
+   CALL PR35759
+   CALL PR35756
+ !
+ ! The first version of the fix caused this to regress as pointed
+ ! out by Dominique d'Humieres
+ !
+   lb = la
+   where(la)
+     la = .false.
+   elsewhere
+     la = .true.
+   end where
+   if (any(la .eqv. lb)) call abort()
+ CONTAINS
+   subroutine PR35759
+     integer UDA1L(6)
+     integer ::  UDA1R(6), expected(6) = (/2,0,5,0,3,0/)
+     LOGICAL LDA(5)
+     UDA1L(1:6) = 0
+     uda1r = (/1,2,3,4,5,6/)
+     lda = (/ (i/2*2 .ne. I, i=1,5) /)
+     WHERE (LDA)
+       UDA1L(1:5) = UDA1R(2:6)
+     ELSEWHERE
+       UDA1L(2:6) = UDA1R(6:2:-1)
+     ENDWHERE
+     if (any (expected /= uda1l)) call abort
+   END subroutine
+ 
+   SUBROUTINE PR35756
+     INTEGER  ILA(10), CLA(10)
+     LOGICAL  LDA(10)
+     ILA = (/ (I, i=1,10) /)
+     LDA = (/ (i/2*2 .ne. I, i=1,10) /)
+     WHERE(LDA)
+       CLA = 10
+     ELSEWHERE
+       CLA = 2
+     ENDWHERE
+     WHERE(LDA)
+       ILA = R_MY_MAX_I(ILA)
+     ELSEWHERE
+       ILA = R_MY_MIN_I(ILA)
+     ENDWHERE
+     IF (any (CLA /= ILA)) call abort
+   end subroutine
+ 
+   INTEGER FUNCTION R_MY_MAX_I(A)
+     INTEGER  ::  A(:)
+     R_MY_MAX_I = MAXVAL(A)
+   END FUNCTION R_MY_MAX_I
+ 
+   INTEGER FUNCTION R_MY_MIN_I(A)
+     INTEGER  ::  A(:)
+     R_MY_MIN_I = MINVAL(A)
+   END FUNCTION R_MY_MIN_I
+ END