PR fortran/15080

	* trans-stmt.c (generate_loop_for_temp_to_lhs): Remove SIZE and COUNT2
	arguments.  If LSS is gfc_ss_terminator, increment COUNT1 by 1, instead
	of incrementing COUNT2 and using COUNT1+COUNT2 increment COUNT1 and use
	just that as index.
	(generate_loop_for_rhs_to_temp): Likewise.
	(compute_overall_iter_number): Add INNER_SIZE_BODY argument.
	It non-NULL, add it to body.
	(allocate_temp_for_forall_nest_1): New function, split from
	allocate_temp_for_forall_nest.
	(allocate_temp_for_forall_nest): Add INNER_SIZE_BODY argument,
	propagate it down to compute_overall_iter_number.  Use
	allocate_temp_for_forall_nest_1.
	(gfc_trans_assign_need_temp): Remove COUNT2.  Call
	compute_inner_temp_size into a new stmtblock_t.  Adjust calls to
	allocate_temp_for_forall_nest, generate_loop_for_rhs_to_temp
	and generate_loop_for_temp_to_lhs.
	(gfc_trans_pointer_assign_need_temp): Adjust calls to
	allocate_temp_for_forall_nest.
	(gfc_evaluate_where_mask): Call compute_inner_temp_size into a new
	stmtblock_t.  Call compute_overall_iter_number just once, then
	allocate_temp_for_forall_nest_1 twice with the same size.
	Initialize mask indexes if nested_forall_info != NULL.
	(gfc_trans_where_2): Initialize mask indexes before calling
	gfc_trans_nested_forall_loop.

	* gfortran.fortran-torture/execute/forall_3.f90: Remove comment
	about the test failing.
	* gfortran.fortran-torture/execute/where_7.f90: New test.
	* gfortran.fortran-torture/execute/where_8.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@99812 138bc75d-0d04-0410-961f-82ee72b054a4

6 files changed, 278 insertions, 92 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 5cfe135fda5..c83763a505f 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,31 @@
+2005-05-17  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/15080
+	* trans-stmt.c (generate_loop_for_temp_to_lhs): Remove SIZE and COUNT2
+	arguments.  If LSS is gfc_ss_terminator, increment COUNT1 by 1, instead
+	of incrementing COUNT2 and using COUNT1+COUNT2 increment COUNT1 and use
+	just that as index.
+	(generate_loop_for_rhs_to_temp): Likewise.
+	(compute_overall_iter_number): Add INNER_SIZE_BODY argument.
+	It non-NULL, add it to body.
+	(allocate_temp_for_forall_nest_1): New function, split from
+	allocate_temp_for_forall_nest.
+	(allocate_temp_for_forall_nest): Add INNER_SIZE_BODY argument,
+	propagate it down to compute_overall_iter_number.  Use
+	allocate_temp_for_forall_nest_1.
+	(gfc_trans_assign_need_temp): Remove COUNT2.  Call
+	compute_inner_temp_size into a new stmtblock_t.  Adjust calls to
+	allocate_temp_for_forall_nest, generate_loop_for_rhs_to_temp
+	and generate_loop_for_temp_to_lhs.
+	(gfc_trans_pointer_assign_need_temp): Adjust calls to
+	allocate_temp_for_forall_nest.
+	(gfc_evaluate_where_mask): Call compute_inner_temp_size into a new
+	stmtblock_t.  Call compute_overall_iter_number just once, then
+	allocate_temp_for_forall_nest_1 twice with the same size.
+	Initialize mask indexes if nested_forall_info != NULL.
+	(gfc_trans_where_2): Initialize mask indexes before calling
+	gfc_trans_nested_forall_loop.
+
 2005-05-15  Feng Wang <fengwang@nudt.edu.cn>
 	Jerry DeLisle <jvdelisle@verizon.net>
 
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index b8959968a69..d3e86dd9d9d 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1516,15 +1516,14 @@ gfc_do_allocate (tree bytesize, tree size, tree * pdata, stmtblock_t * pblock,
 /* Generate codes to copy the temporary to the actual lhs.  */
 
 static tree
-generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
-                          tree count3, tree count1, tree count2, tree wheremask)
+generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree count3,
+			       tree count1, tree wheremask)
 {
   gfc_ss *lss;
   gfc_se lse, rse;
   stmtblock_t block, body;
   gfc_loopinfo loop1;
   tree tmp, tmp2;
-  tree index;
   tree wheremaskexpr;
 
   /* Walk the lhs.  */
@@ -1548,8 +1547,10 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
       gfc_add_block_to_block (&block, &lse.post);
 
       /* Increment the count1.  */
-      tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, size);
+      tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1,
+			 gfc_index_one_node);
       gfc_add_modify_expr (&block, count1, tmp);
+
       tmp = gfc_finish_block (&block);
     }
   else
@@ -1569,8 +1570,6 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
       gfc_conv_loop_setup (&loop1);
 
       gfc_mark_ss_chain_used (lss, 1);
-      /* Initialize count2.  */
-      gfc_add_modify_expr (&block, count2, gfc_index_zero_node);
 
       /* Start the scalarized loop body.  */
       gfc_start_scalarized_body (&loop1, &body);
@@ -1581,11 +1580,7 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
 
       /* Form the expression of the temporary.  */
       if (lss != gfc_ss_terminator)
-        {
-          index = fold_build2 (PLUS_EXPR, gfc_array_index_type,
-			       count1, count2);
-          rse.expr = gfc_build_array_ref (tmp1, index);
-        }
+	rse.expr = gfc_build_array_ref (tmp1, count1);
       /* Translate expr.  */
       gfc_conv_expr (&lse, expr);
 
@@ -1596,31 +1591,31 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
      if (wheremask)
        {
 	 wheremaskexpr = gfc_build_array_ref (wheremask, count3);
-         tmp2 = TREE_CHAIN (wheremask);
-         while (tmp2)
-           {
-             tmp1 = gfc_build_array_ref (tmp2, count3);
-             wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
+	 tmp2 = TREE_CHAIN (wheremask);
+	 while (tmp2)
+	   {
+	     tmp1 = gfc_build_array_ref (tmp2, count3);
+	     wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
 				     wheremaskexpr, tmp1);
-             tmp2 = TREE_CHAIN (tmp2);
-           }
-         tmp = build3_v (COND_EXPR, wheremaskexpr, tmp, build_empty_stmt ());
+	     tmp2 = TREE_CHAIN (tmp2);
+	   }
+	 tmp = build3_v (COND_EXPR, wheremaskexpr, tmp, build_empty_stmt ());
        }
 
       gfc_add_expr_to_block (&body, tmp);
 
-      /* Increment count2.  */
+      /* Increment count1.  */
       tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
-			 count2, gfc_index_one_node);
-      gfc_add_modify_expr (&body, count2, tmp);
+			 count1, gfc_index_one_node);
+      gfc_add_modify_expr (&body, count1, tmp);
 
       /* Increment count3.  */
       if (count3)
-        {
-          tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+	{
+	  tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
 			     count3, gfc_index_one_node);
-          gfc_add_modify_expr (&body, count3, tmp);
-        }
+	  gfc_add_modify_expr (&body, count3, tmp);
+	}
 
       /* Generate the copying loops.  */
       gfc_trans_scalarizing_loops (&loop1, &body);
@@ -1628,9 +1623,6 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
       gfc_add_block_to_block (&block, &loop1.post);
       gfc_cleanup_loop (&loop1);
 
-      /* Increment count1.  */
-      tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, size);
-      gfc_add_modify_expr (&block, count1, tmp);
       tmp = gfc_finish_block (&block);
     }
   return tmp;
@@ -1642,15 +1634,15 @@ generate_loop_for_temp_to_lhs (gfc_expr *expr, tree tmp1, tree size,
    not be freed.  */
 
 static tree
-generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
-			       tree count3, tree count1, tree count2,
-			    gfc_ss *lss, gfc_ss *rss, tree wheremask)
+generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree count3,
+			       tree count1, gfc_ss *lss, gfc_ss *rss,
+			       tree wheremask)
 {
   stmtblock_t block, body1;
   gfc_loopinfo loop;
   gfc_se lse;
   gfc_se rse;
-  tree tmp, tmp2, index;
+  tree tmp, tmp2;
   tree wheremaskexpr;
 
   gfc_start_block (&block);
@@ -1666,9 +1658,6 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
     }
   else
     {
-      /* Initialize count2.  */
-      gfc_add_modify_expr (&block, count2, gfc_index_zero_node);
-
       /* Initialize the loop.  */
       gfc_init_loopinfo (&loop);
 
@@ -1689,8 +1678,7 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
       gfc_conv_expr (&rse, expr2);
 
       /* Form the expression of the temporary.  */
-      index = fold_build2 (PLUS_EXPR, gfc_array_index_type, count1, count2);
-      lse.expr = gfc_build_array_ref (tmp1, index);
+      lse.expr = gfc_build_array_ref (tmp1, count1);
     }
 
   /* Use the scalar assignment.  */
@@ -1702,12 +1690,12 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
       wheremaskexpr = gfc_build_array_ref (wheremask, count3);
       tmp2 = TREE_CHAIN (wheremask);
       while (tmp2)
-        {
-          tmp1 = gfc_build_array_ref (tmp2, count3);
-          wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
+	{
+	  tmp1 = gfc_build_array_ref (tmp2, count3);
+	  wheremaskexpr = build2 (TRUTH_AND_EXPR, TREE_TYPE (tmp1),
 				  wheremaskexpr, tmp1);
-          tmp2 = TREE_CHAIN (tmp2);
-        }
+	  tmp2 = TREE_CHAIN (tmp2);
+	}
       tmp = build3_v (COND_EXPR, wheremaskexpr, tmp, build_empty_stmt ());
     }
 
@@ -1716,21 +1704,26 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
   if (lss == gfc_ss_terminator)
     {
       gfc_add_block_to_block (&block, &body1);
+
+      /* Increment count1.  */
+      tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1,
+			 gfc_index_one_node);
+      gfc_add_modify_expr (&block, count1, tmp);
     }
   else
     {
-      /* Increment count2.  */
+      /* Increment count1.  */
       tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
-			 count2, gfc_index_one_node);
-      gfc_add_modify_expr (&body1, count2, tmp);
+			 count1, gfc_index_one_node);
+      gfc_add_modify_expr (&body1, count1, tmp);
 
       /* Increment count3.  */
       if (count3)
-        {
-          tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
+	{
+	  tmp = fold_build2 (PLUS_EXPR, gfc_array_index_type,
 			     count3, gfc_index_one_node);
-          gfc_add_modify_expr (&body1, count3, tmp);
-        }
+	  gfc_add_modify_expr (&body1, count3, tmp);
+	}
 
       /* Generate the copying loops.  */
       gfc_trans_scalarizing_loops (&loop, &body1);
@@ -1740,11 +1733,8 @@ generate_loop_for_rhs_to_temp (gfc_expr *expr2, tree tmp1, tree size,
 
       gfc_cleanup_loop (&loop);
       /* TODO: Reuse lss and rss when copying temp->lhs.  Need to be careful
-         as tree nodes in SS may not be valid in different scope.  */
+	 as tree nodes in SS may not be valid in different scope.  */
     }
-  /* Increment count1.  */
-  tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (count1), count1, size);
-  gfc_add_modify_expr (&block, count1, tmp);
 
   tmp = gfc_finish_block (&block);
   return tmp;
@@ -1822,7 +1812,7 @@ compute_inner_temp_size (gfc_expr *expr1, gfc_expr *expr2,
 
 static tree
 compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
-                             stmtblock_t *block)
+			     stmtblock_t *inner_size_body, stmtblock_t *block)
 {
   tree tmp, number;
   stmtblock_t body;
@@ -1832,6 +1822,8 @@ compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
   gfc_add_modify_expr (block, number, gfc_index_zero_node);
 
   gfc_start_block (&body);
+  if (inner_size_body)
+    gfc_add_block_to_block (&body, inner_size_body);
   if (nested_forall_info)
     tmp = build2 (PLUS_EXPR, gfc_array_index_type, number,
 		  inner_size);
@@ -1850,22 +1842,17 @@ compute_overall_iter_number (forall_info *nested_forall_info, tree inner_size,
 }
 
 
-/* Allocate temporary for forall construct according to the information in
-   nested_forall_info.  INNER_SIZE is the size of temporary needed in the
-   assignment inside forall.  PTEMP1 is returned for space free.  */
+/* Allocate temporary for forall construct.  SIZE is the size of temporary
+   needed.  PTEMP1 is returned for space free.  */
 
 static tree
-allocate_temp_for_forall_nest (forall_info * nested_forall_info, tree type,
-                               tree inner_size, stmtblock_t * block,
-                               tree * ptemp1)
+allocate_temp_for_forall_nest_1 (tree type, tree size, stmtblock_t * block,
+				 tree * ptemp1)
 {
   tree unit;
   tree temp1;
   tree tmp;
-  tree bytesize, size;
-
-  /* Calculate the total size of temporary needed in forall construct.  */
-  size = compute_overall_iter_number (nested_forall_info, inner_size, block);
+  tree bytesize;
 
   unit = TYPE_SIZE_UNIT (type);
   bytesize = fold_build2 (MULT_EXPR, gfc_array_index_type, size, unit);
@@ -1882,7 +1869,56 @@ allocate_temp_for_forall_nest (forall_info * nested_forall_info, tree type,
 }
 
 
-/* Handle assignments inside forall which need temporary.  */
+/* Allocate temporary for forall construct according to the information in
+   nested_forall_info.  INNER_SIZE is the size of temporary needed in the
+   assignment inside forall.  PTEMP1 is returned for space free.  */
+
+static tree
+allocate_temp_for_forall_nest (forall_info * nested_forall_info, tree type,
+			       tree inner_size, stmtblock_t * inner_size_body,
+			       stmtblock_t * block, tree * ptemp1)
+{
+  tree size;
+
+  /* Calculate the total size of temporary needed in forall construct.  */
+  size = compute_overall_iter_number (nested_forall_info, inner_size,
+				      inner_size_body, block);
+
+  return allocate_temp_for_forall_nest_1 (type, size, block, ptemp1);
+}
+
+
+/* Handle assignments inside forall which need temporary.
+
+    forall (i=start:end:stride; maskexpr)
+      e<i> = f<i>
+    end forall
+   (where e,f<i> are arbitrary expressions possibly involving i
+    and there is a dependency between e<i> and f<i>)
+   Translates to:
+    masktmp(:) = maskexpr(:)
+
+    maskindex = 0;
+    count1 = 0;
+    num = 0;
+    for (i = start; i <= end; i += stride)
+      num += SIZE (f<i>)
+    count1 = 0;
+    ALLOCATE (tmp(num))
+    for (i = start; i <= end; i += stride)
+      {
+	if (masktmp[maskindex++])
+	  tmp[count1++] = f<i>
+      }
+    maskindex = 0;
+    count1 = 0;
+    for (i = start; i <= end; i += stride)
+      {
+	if (masktmp[maskindex++])
+	  e<i> = tmp[count1++]
+      }
+    DEALLOCATE (tmp)
+  */
 static void
 gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
                             forall_info * nested_forall_info,
@@ -1891,17 +1927,16 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
   tree type;
   tree inner_size;
   gfc_ss *lss, *rss;
-  tree count, count1, count2;
+  tree count, count1;
   tree tmp, tmp1;
   tree ptemp1;
   tree mask, maskindex;
   forall_info *forall_tmp;
+  stmtblock_t inner_size_body;
 
-  /* Create vars. count1 is the current iterator number of the nested forall.
-     count2 is the current iterator number of the inner loops needed in the
-     assignment.  */
+  /* Create vars. count1 is the current iterator number of the nested
+     forall.  */
   count1 = gfc_create_var (gfc_array_index_type, "count1");
-  count2 = gfc_create_var (gfc_array_index_type, "count2");
 
   /* Count is the wheremask index.  */
   if (wheremask)
@@ -1917,15 +1952,17 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
 
   /* Calculate the size of temporary needed in the assignment. Return loop, lss
      and rss which are used in function generate_loop_for_rhs_to_temp().  */
-  inner_size = compute_inner_temp_size (expr1, expr2, block, &lss, &rss);
+  gfc_init_block (&inner_size_body);
+  inner_size = compute_inner_temp_size (expr1, expr2, &inner_size_body,
+					&lss, &rss);
 
   /* The type of LHS. Used in function allocate_temp_for_forall_nest */
   type = gfc_typenode_for_spec (&expr1->ts);
 
   /* Allocate temporary for nested forall construct according to the
      information in nested_forall_info and inner_size.  */
-  tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type,
-                                inner_size, block, &ptemp1);
+  tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type, inner_size,
+					&inner_size_body, block, &ptemp1);
 
   /* Initialize the maskindexes.  */
   forall_tmp = nested_forall_info;
@@ -1939,8 +1976,8 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
     }
 
   /* Generate codes to copy rhs to the temporary .  */
-  tmp = generate_loop_for_rhs_to_temp (expr2, tmp1, inner_size, count,
-                                       count1, count2, lss, rss, wheremask);
+  tmp = generate_loop_for_rhs_to_temp (expr2, tmp1, count, count1, lss, rss,
+				       wheremask);
 
   /* Generate body and loops according to the information in
      nested_forall_info.  */
@@ -1966,8 +2003,7 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
     gfc_add_modify_expr (block, count, gfc_index_zero_node);
 
   /* Generate codes to copy the temporary to lhs.  */
-  tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, inner_size, count,
-                                       count1, count2, wheremask);
+  tmp = generate_loop_for_temp_to_lhs (expr1, tmp1, count, count1, wheremask);
 
   /* Generate body and loops according to the information in
      nested_forall_info.  */
@@ -2020,8 +2056,8 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
 
       /* Allocate temporary for nested forall construct according to the
          information in nested_forall_info and inner_size.  */
-      tmp1 = allocate_temp_for_forall_nest (nested_forall_info,
-                                            type, inner_size, block, &ptemp1);
+      tmp1 = allocate_temp_for_forall_nest (nested_forall_info, type,
+					    inner_size, NULL, block, &ptemp1);
       gfc_start_block (&body);
       gfc_init_se (&lse, NULL);
       lse.expr = gfc_build_array_ref (tmp1, count);
@@ -2110,7 +2146,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
 
       /* Allocate temporary for nested forall construct.  */
       tmp1 = allocate_temp_for_forall_nest (nested_forall_info, parmtype,
-                                            inner_size, block, &ptemp1);
+					    inner_size, NULL, block, &ptemp1);
       gfc_start_block (&body);
       gfc_init_se (&lse, NULL);
       lse.expr = gfc_build_array_ref (tmp1, count);
@@ -2201,7 +2237,7 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
     end forall
    (where e,f,g,h<i> are arbitrary expressions possibly involving i)
    Translates to:
-    count = ((end + 1 - start) / staride)
+    count = ((end + 1 - start) / stride)
     masktmp(:) = maskexpr(:)
 
     maskindex = 0;
@@ -2567,8 +2603,8 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
   gfc_ss *lss, *rss;
   gfc_loopinfo loop;
   tree ptemp1, ntmp, ptemp2;
-  tree inner_size;
-  stmtblock_t body, body1;
+  tree inner_size, size;
+  stmtblock_t body, body1, inner_size_body;
   gfc_se lse, rse;
   tree count;
   tree tmpexpr;
@@ -2576,11 +2612,16 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
   gfc_init_loopinfo (&loop);
 
   /* Calculate the size of temporary needed by the mask-expr.  */
-  inner_size = compute_inner_temp_size (me, me, block, &lss, &rss);
+  gfc_init_block (&inner_size_body);
+  inner_size = compute_inner_temp_size (me, me, &inner_size_body, &lss, &rss);
+
+  /* Calculate the total size of temporary needed.  */
+  size = compute_overall_iter_number (nested_forall_info, inner_size,
+				      &inner_size_body, block);
 
   /* Allocate temporary for where mask.  */
-  tmp = allocate_temp_for_forall_nest (nested_forall_info, boolean_type_node,
-                                       inner_size, block, &ptemp1);
+  tmp = allocate_temp_for_forall_nest_1 (boolean_type_node, size, block,
+					 &ptemp1);
   /* Record the temporary address in order to free it later.  */
   if (ptemp1)
     {
@@ -2592,8 +2633,8 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
     }
 
   /* Allocate temporary for !mask.  */
-  ntmp = allocate_temp_for_forall_nest (nested_forall_info, boolean_type_node,
-                                        inner_size, block, &ptemp2);
+  ntmp = allocate_temp_for_forall_nest_1 (boolean_type_node, size, block,
+					  &ptemp2);
   /* Record the temporary  in order to free it later.  */
   if (ptemp2)
     {
@@ -2676,8 +2717,22 @@ gfc_evaluate_where_mask (gfc_expr * me, forall_info * nested_forall_info,
   tmp1 = gfc_finish_block (&body);
   /* If the WHERE construct is inside FORALL, fill the full temporary.  */
   if (nested_forall_info != NULL)
-    tmp1 = gfc_trans_nested_forall_loop (nested_forall_info, tmp1, 1, 1);
+    {
+      forall_info *forall_tmp;
+      tree maskindex;
 
+      /* Initialize the maskindexes.  */
+      forall_tmp = nested_forall_info;
+      while (forall_tmp != NULL)
+	{
+	  maskindex = forall_tmp->maskindex;
+	  if (forall_tmp->mask)
+	    gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
+	  forall_tmp = forall_tmp->next_nest;
+	}
+
+      tmp1 = gfc_trans_nested_forall_loop (nested_forall_info, tmp1, 1, 1);
+    }
 
   gfc_add_expr_to_block (block, tmp1);
 
@@ -2998,6 +3053,9 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
                                                 nested_forall_info, block);
                   else
                     {
+		      forall_info *forall_tmp;
+		      tree maskindex;
+
                       /* Variables to control maskexpr.  */
                       count1 = gfc_create_var (gfc_array_index_type, "count1");
                       count2 = gfc_create_var (gfc_array_index_type, "count2");
@@ -3006,6 +3064,18 @@ gfc_trans_where_2 (gfc_code * code, tree mask, tree pmask,
 
                       tmp = gfc_trans_where_assign (expr1, expr2, mask, count1,
                                                     count2);
+
+		      /* Initialize the maskindexes.  */
+		      forall_tmp = nested_forall_info;
+		      while (forall_tmp != NULL)
+			{
+			  maskindex = forall_tmp->maskindex;
+			  if (forall_tmp->mask)
+			    gfc_add_modify_expr (block, maskindex,
+						 gfc_index_zero_node);
+			  forall_tmp = forall_tmp->next_nest;
+			}
+
                       tmp = gfc_trans_nested_forall_loop (nested_forall_info,
                                                           tmp, 1, 1);
                       gfc_add_expr_to_block (block, tmp);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c9f0b74de21..2e99a3620b4 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2005-05-17  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/15080
+	* gfortran.fortran-torture/execute/forall_3.f90: Remove comment
+	about the test failing.
+	* gfortran.fortran-torture/execute/where_7.f90: New test.
+	* gfortran.fortran-torture/execute/where_8.f90: New test.
+
 2005-05-16  Richard Henderson  <rth@redhat.com>
 
 	* lib/target-supports.exp (check_effective_target_vect_int_mul): Add
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/forall_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/forall_3.f90
index 4858d3e7eda..cab07579539 100644
--- a/gcc/testsuite/gfortran.fortran-torture/execute/forall_3.f90
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/forall_3.f90
@@ -1,6 +1,5 @@
+! PR fortran/15080
 ! Really test forall with temporary
-! This test fails (2004-06-28).  See PR15080.  I'd XFAIL it,
-! but there doesn't seem to be an easy way to do this for torture tests.
 program evil_forall
   implicit none
   type t
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where_7.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where_7.f90
new file mode 100644
index 00000000000..49dc5952a9f
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/where_7.f90
@@ -0,0 +1,53 @@
+! Really test where inside forall with temporary
+program evil_where
+  implicit none
+  type t
+    logical valid
+    integer :: s
+    integer, dimension(:), pointer :: p
+  end type
+  type (t), dimension (5) :: v
+  integer i
+
+  allocate (v(1)%p(2))
+  allocate (v(2)%p(8))
+  v(3)%p => NULL()
+  allocate (v(4)%p(8))
+  allocate (v(5)%p(2))
+
+  v(:)%valid = (/.true., .true., .false., .true., .true./)
+  v(:)%s = (/1, 8, 999, 6, 2/)
+  v(1)%p(:) = (/9, 10/)
+  v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/)
+  v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/)
+  v(5)%p(:) = (/11, 12/)
+
+  forall (i=1:5,v(i)%valid)
+    where (v(i)%p(1:v(i)%s).gt.4)
+      v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s)
+    end where
+  end forall
+
+  if (any(v(1)%p(:) .ne. (/11, 10/))) call abort
+  if (any(v(2)%p(:) .ne. (/1, 2, 3, 4, 17, 18, 19, 20/))) call abort
+  if (any(v(4)%p(:) .ne. (/1, 2, 3, 4, 5, 6, 19, 20/))) call abort
+  if (any(v(5)%p(:) .ne. (/9, 10/))) call abort
+
+  v(1)%p(:) = (/9, 10/)
+  v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/)
+  v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/)
+  v(5)%p(:) = (/11, 12/)
+
+  forall (i=1:5,v(i)%valid)
+    where (v(i)%p(1:v(i)%s).le.4)
+      v(i)%p(1:v(i)%s) = v(6-i)%p(1:v(i)%s)
+    end where
+  end forall
+
+  if (any(v(1)%p(:) .ne. (/9, 10/))) call abort
+  if (any(v(2)%p(:) .ne. (/13, 14, 15, 16, 5, 6, 7, 8/))) call abort
+  if (any(v(4)%p(:) .ne. (/13, 14, 15, 16, 17, 18, 19, 20/))) call abort
+  if (any(v(5)%p(:) .ne. (/11, 12/))) call abort
+
+  ! I should really free the memory I've allocated.
+end program
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/where_8.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/where_8.f90
new file mode 100644
index 00000000000..58a26bd3483
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/where_8.f90
@@ -0,0 +1,28 @@
+program where_8
+  implicit none
+  type t
+    logical valid
+    integer :: s
+    integer, dimension(8) :: p
+  end type
+  type (t), dimension (5) :: v
+  integer i
+
+  v(:)%valid = (/.true., .true., .false., .true., .true./)
+  v(:)%s = (/1, 8, 999, 6, 2/)
+  v(1)%p(:) = (/9, 10, 0, 0, 0, 0, 0, 0/)
+  v(2)%p(:) = (/1, 2, 3, 4, 5, 6, 7, 8/)
+  v(4)%p(:) = (/13, 14, 15, 16, 17, 18, 19, 20/)
+  v(5)%p(:) = (/11, 12, 0, 0, 0, 0, 0, 0/)
+
+  forall (i=1:5,v(i)%valid)
+    where (v(i)%p(1:v(i)%s).gt.4)
+      v(i)%p(1:v(i)%s) = 21
+    end where
+  end forall
+
+  if (any(v(1)%p(:) .ne. (/21, 10, 0, 0, 0, 0, 0, 0/))) call abort
+  if (any(v(2)%p(:) .ne. (/1, 2, 3, 4, 21, 21, 21, 21/))) call abort
+  if (any(v(4)%p(:) .ne. (/21, 21, 21, 21, 21, 21, 19, 20/))) call abort
+  if (any(v(5)%p(:) .ne. (/21, 21, 0, 0, 0, 0, 0, 0/))) call abort
+end program