re PR fortran/35756 (incorrect WHERE for functions in ELSEWHERE and overlaps)

2008-05-16  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.

	PR fortran/35743
	* trans-stmt.c (gfc_trans_where_2): Set the mask size to zero
	if it is calculated to be negative.

	PR fortran/35745
	* trans-stmt.c (gfc_trans_where_3, gfc_trans_where_assign): Set
	ss->where for scalar right hand sides.
	* trans-array.c (gfc_add_loop_ss_code): If ss->where is set do
	not evaluate scalars outside the loop.  Clean up whitespace.
	* trans.h : Add a bitfield 'where' to gfc_ss.

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

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

	PR fortran/35743
	PR fortran/35745
	* gfortran.dg/where_2.f90: New test.

From-SVN: r135443

4 files changed, 60 insertions, 20 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index bc62570..0762a64 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,21 @@
+2008-05-16  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.
+
+	PR fortran/35743
+	* trans-stmt.c (gfc_trans_where_2): Set the mask size to zero
+	if it is calculated to be negative.
+
+	PR fortran/35745
+	* trans-stmt.c (gfc_trans_where_3, gfc_trans_where_assign): Set
+	ss->where for scalar right hand sides.
+	* trans-array.c (gfc_add_loop_ss_code): If ss->where is set do
+	not evaluate scalars outside the loop.  Clean up whitespace.
+	* trans.h : Add a bitfield 'where' to gfc_ss.
+
 2008-05-16  Tobias Burnus  <burnus@net-b.de>
 
 	* libgfortran.h: Increase GFC_MAX_DIMENSIONS to 15.
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index d6464ca..784f1bc 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -1900,20 +1900,21 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss, bool subscript)
 	  /* Scalar expression.  Evaluate this now.  This includes elemental
 	     dimension indices, but not array section bounds.  */
 	  gfc_init_se (&se, NULL);
-          gfc_conv_expr (&se, ss->expr);
-          gfc_add_block_to_block (&loop->pre, &se.pre);
+	  gfc_conv_expr (&se, ss->expr);
+	  gfc_add_block_to_block (&loop->pre, &se.pre);
 
-          if (ss->expr->ts.type != BT_CHARACTER)
-            {
-              /* Move the evaluation of scalar expressions outside the
-                 scalarization loop.  */
-              if (subscript)
-                se.expr = convert(gfc_array_index_type, se.expr);
-              se.expr = gfc_evaluate_now (se.expr, &loop->pre);
-              gfc_add_block_to_block (&loop->pre, &se.post);
-            }
-          else
-            gfc_add_block_to_block (&loop->post, &se.post);
+	  if (ss->expr->ts.type != BT_CHARACTER)
+	    {
+	      /* Move the evaluation of scalar expressions outside the
+		 scalarization loop, except for WHERE assignments.  */
+	      if (subscript)
+		se.expr = convert(gfc_array_index_type, se.expr);
+	      if (!ss->where)
+		se.expr = gfc_evaluate_now (se.expr, &loop->pre);
+	      gfc_add_block_to_block (&loop->pre, &se.post);
+	    }
+	  else
+	    gfc_add_block_to_block (&loop->post, &se.post);
 
 	  ss->data.scalar.expr = se.expr;
 	  ss->string_length = se.string_length;
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 9220315..64829e3 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -3150,6 +3150,7 @@ gfc_trans_where_assign (gfc_expr *expr1, gfc_expr *expr2,
    {
      /* The rhs is scalar.  Add a ss for the expression.  */
      rss = gfc_get_ss ();
+     rss->where = 1;
      rss->next = gfc_ss_terminator;
      rss->type = GFC_SS_SCALAR;
      rss->expr = expr2;
@@ -3312,6 +3313,7 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert,
   gfc_code *cblock;
   gfc_code *cnext;
   tree tmp;
+  tree cond;
   tree count1, count2;
   bool need_cmask;
   bool need_pmask;
@@ -3377,6 +3379,13 @@ gfc_trans_where_2 (gfc_code * code, tree mask, bool invert,
       size = compute_overall_iter_number (nested_forall_info, inner_size,
 					  &inner_size_body, block);
 
+      /* Check whether the size is negative.  */
+      cond = fold_build2 (LE_EXPR, boolean_type_node, size,
+			  gfc_index_zero_node);
+      size = fold_build3 (COND_EXPR, gfc_array_index_type, cond,
+			  gfc_index_zero_node, size);
+      size = gfc_evaluate_now (size, block);
+
       /* Allocate temporary for WHERE mask if needed.  */
       if (need_cmask)
 	cmask = allocate_temp_for_forall_nest_1 (mask_type, size, block,
@@ -3578,6 +3587,7 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
   if (tsss == gfc_ss_terminator)
     {
       tsss = gfc_get_ss ();
+      tsss->where = 1;
       tsss->next = gfc_ss_terminator;
       tsss->type = GFC_SS_SCALAR;
       tsss->expr = tsrc;
@@ -3595,6 +3605,7 @@ gfc_trans_where_3 (gfc_code * cblock, gfc_code * eblock)
       if (esss == gfc_ss_terminator)
 	{
 	  esss = gfc_get_ss ();
+	  esss->where = 1;
 	  esss->next = gfc_ss_terminator;
 	  esss->type = GFC_SS_SCALAR;
 	  esss->expr = esrc;
@@ -3709,19 +3720,28 @@ gfc_trans_where (gfc_code * code)
 	     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.  */
+	     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, 0)
+				       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,
-				       cblock->next->expr2, 0)
+				       eblock->next->expr2, 1)
 	      && !gfc_check_dependency(cblock->next->expr,
-				       cblock->next->expr2, 0)
+				       eblock->next->expr, 0)
 	      && !gfc_check_dependency(eblock->next->expr,
-				       eblock->next->expr2, 0))
+				       cblock->next->expr, 0))
 	    return gfc_trans_where_3 (cblock, eblock);
 	}
     }
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 0b431a5..ffd1b84 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -201,8 +201,9 @@ typedef struct gfc_ss
 
   /* This is used by assignments requiring temporaries. The bits specify which
      loops the terms appear in.  This will be 1 for the RHS expressions,
-     2 for the LHS expressions, and 3(=1|2) for the temporary.  */
-  unsigned useflags:2;
+     2 for the LHS expressions, and 3(=1|2) for the temporary.  The bit
+     'where' suppresses precalculation of scalars in WHERE assignments.  */
+  unsigned useflags:2, where:1;
 }
 gfc_ss;
 #define gfc_get_ss() gfc_getmem(sizeof(gfc_ss))