* trans-stmt.c (gfc_trans_forall_loop): Clear maskindex before

	the outermost loop.
	(gfc_trans_assign_need_temp, gfc_trans_pointer_assign_need_temp,
	gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_where_2):
	Don't clear maskindexes here.

	* gfortran.fortran-torture/execute/forall_7.f90: New test.

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 4d6a44b..2ccc249 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,11 @@
+2005-07-11  Jakub Jelinek  <jakub@redhat.com>
+
+       * trans-stmt.c (gfc_trans_forall_loop): Clear maskindex before
+       the outermost loop.
+       (gfc_trans_assign_need_temp, gfc_trans_pointer_assign_need_temp,
+       gfc_trans_forall_1, gfc_evaluate_where_mask, gfc_trans_where_2):
+       Don't clear maskindexes here.
+
 2005-07-08  Daniel Berlin  <dberlin@dberlin.org>
        
        * trans-decl.c (create_function_arglist): DECL_ARG_TYPE_AS_WRITTEN

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 8fda557..0ec029f 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -1331,7 +1331,7 @@ gfc_trans_forall_loop (forall_info *forall_tmp, int nvar, tree body, int mask_fl
   stmtblock_t block;
   tree exit_label;
   tree count;
-  tree var, start, end, step, mask, maskindex;
+  tree var, start, end, step;
   iter_info *iter;
 
   iter = forall_tmp->this_loop;
@@ -1366,17 +1366,14 @@ gfc_trans_forall_loop (forall_info *forall_tmp, int nvar, tree body, int mask_fl
 
       /* Advance to the next mask element.  Only do this for the
         innermost loop.  */
-      if (n == 0 && mask_flag)
-        {
-          mask = forall_tmp->mask;
-          maskindex = forall_tmp->maskindex;
-          if (mask)
-            {
-              tmp = build2 (PLUS_EXPR, gfc_array_index_type,
-                           maskindex, gfc_index_one_node);
-              gfc_add_modify_expr (&block, maskindex, tmp);
-            }
-        }
+      if (n == 0 && mask_flag && forall_tmp->mask)
+       {
+         tree maskindex = forall_tmp->maskindex;
+         tmp = build2 (PLUS_EXPR, gfc_array_index_type,
+                       maskindex, gfc_index_one_node);
+         gfc_add_modify_expr (&block, maskindex, tmp);
+       }
+
       /* Decrement the loop counter.  */
       tmp = build2 (MINUS_EXPR, TREE_TYPE (var), count, gfc_index_one_node);
       gfc_add_modify_expr (&block, count, tmp);
@@ -1387,6 +1384,12 @@ gfc_trans_forall_loop (forall_info *forall_tmp, int nvar, tree body, int mask_fl
       gfc_init_block (&block);
       gfc_add_modify_expr (&block, var, start);
 
+      /* Initialize maskindex counter.  Only do this before the
+        outermost loop.  */
+      if (n == nvar - 1 && mask_flag && forall_tmp->mask)
+       gfc_add_modify_expr (&block, forall_tmp->maskindex,
+                            gfc_index_zero_node);
+
       /* Initialize the loop counter.  */
       tmp = fold_build2 (MINUS_EXPR, TREE_TYPE (var), step, start);
       tmp = fold_build2 (PLUS_EXPR, TREE_TYPE (var), end, tmp);
@@ -1930,8 +1933,6 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
   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
@@ -1964,17 +1965,6 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
   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;
-  while (forall_tmp != NULL)
-    {
-      mask = forall_tmp->mask;
-      maskindex = forall_tmp->maskindex;
-      if (mask)
-        gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
-      forall_tmp = forall_tmp->next_nest;
-    }
-
   /* Generate codes to copy rhs to the temporary .  */
   tmp = generate_loop_for_rhs_to_temp (expr2, tmp1, count, count1, lss, rss,
                                       wheremask);
@@ -1987,17 +1977,6 @@ gfc_trans_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2, tree wheremask,
   /* Reset count1.  */
   gfc_add_modify_expr (block, count1, gfc_index_zero_node);
 
-  /* Reset maskindexed.  */
-  forall_tmp = nested_forall_info;
-  while (forall_tmp != NULL)
-    {
-      mask = forall_tmp->mask;
-      maskindex = forall_tmp->maskindex;
-      if (mask)
-        gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
-      forall_tmp = forall_tmp->next_nest;
-    }
-
   /* Reset count.  */
   if (wheremask)
     gfc_add_modify_expr (block, count, gfc_index_zero_node);
@@ -2040,8 +2019,6 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
   stmtblock_t body;
   tree count;
   tree tmp, tmp1, ptemp1;
-  tree mask, maskindex;
-  forall_info *forall_tmp;
 
   count = gfc_create_var (gfc_array_index_type, "count");
   gfc_add_modify_expr (block, count, gfc_index_zero_node);
@@ -2075,17 +2052,6 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
 
       tmp = gfc_finish_block (&body);
 
-      /* Initialize the maskindexes.  */
-      forall_tmp = nested_forall_info;
-      while (forall_tmp != NULL)
-        {
-          mask = forall_tmp->mask;
-          maskindex = forall_tmp->maskindex;
-          if (mask)
-            gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
-          forall_tmp = forall_tmp->next_nest;
-        }
-
       /* Generate body and loops according to the information in
          nested_forall_info.  */
       tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1, 1);
@@ -2094,16 +2060,6 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       /* Reset count.  */
       gfc_add_modify_expr (block, count, gfc_index_zero_node);
 
-      /* Reset maskindexes.  */
-      forall_tmp = nested_forall_info;
-      while (forall_tmp != NULL)
-        {
-          mask = forall_tmp->mask;
-          maskindex = forall_tmp->maskindex;
-          if (mask)
-            gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
-          forall_tmp = forall_tmp->next_nest;
-        }
       gfc_start_block (&body);
       gfc_init_se (&lse, NULL);
       gfc_init_se (&rse, NULL);
@@ -2164,17 +2120,6 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
 
       tmp = gfc_finish_block (&body);
 
-      /* Initialize the maskindexes.  */
-      forall_tmp = nested_forall_info;
-      while (forall_tmp != NULL)
-        {
-          mask = forall_tmp->mask;
-          maskindex = forall_tmp->maskindex;
-          if (mask)
-            gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
-          forall_tmp = forall_tmp->next_nest;
-        }
-
       /* Generate body and loops according to the information in
          nested_forall_info.  */
       tmp = gfc_trans_nested_forall_loop (nested_forall_info, tmp, 1, 1);
@@ -2183,16 +2128,6 @@ gfc_trans_pointer_assign_need_temp (gfc_expr * expr1, gfc_expr * expr2,
       /* Reset count.  */
       gfc_add_modify_expr (block, count, gfc_index_zero_node);
 
-      /* Reset maskindexes.  */
-      forall_tmp = nested_forall_info;
-      while (forall_tmp != NULL)
-        {
-          mask = forall_tmp->mask;
-          maskindex = forall_tmp->maskindex;
-          if (mask)
-            gfc_add_modify_expr (block, maskindex, gfc_index_zero_node);
-          forall_tmp = forall_tmp->next_nest;
-        }
       parm = gfc_build_array_ref (tmp1, count);
       lss = gfc_walk_expr (expr1);
       gfc_init_se (&lse, NULL);
@@ -2487,10 +2422,6 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
               /* Use the normal assignment copying routines.  */
               assign = gfc_trans_assignment (c->expr, c->expr2);
 
-              /* Reset the mask index.  */
-              if (mask)
-                gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node);
-
               /* Generate body and loops.  */
               tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign, 1, 1);
               gfc_add_expr_to_block (&block, tmp);
@@ -2532,10 +2463,6 @@ gfc_trans_forall_1 (gfc_code * code, forall_info * nested_forall_info)
               /* Use the normal assignment copying routines.  */
               assign = gfc_trans_pointer_assignment (c->expr, c->expr2);
 
-              /* Reset the mask index.  */
-              if (mask)
-                gfc_add_modify_expr (&block, maskindex, gfc_index_zero_node);
-
               /* Generate body and loops.  */
               tmp = gfc_trans_nested_forall_loop (nested_forall_info, assign,
                                                   1, 1);
@@ -2723,22 +2650,7 @@ 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)
-    {
-      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);
-    }
+    tmp1 = gfc_trans_nested_forall_loop (nested_forall_info, tmp1, 1, 1);
 
   gfc_add_expr_to_block (block, tmp1);
 
@@ -3059,9 +2971,6 @@ 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");
@@ -3071,17 +2980,6 @@ 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 3f48f22..6dd7127 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2005-07-11  Jakub Jelinek  <jakub@redhat.com>
+
+       * gfortran.fortran-torture/execute/forall_7.f90: New test.
+
 2005-07-10  Richard Sandiford  <richard@codesourcery.com>
 
        * gcc.target/mips/mips.exp (is_gp32_flag): New procedure.

diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/forall_7.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/forall_7.f90
new file mode 100644 (file)
index 0000000..4a28928
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/forall_7.f90
@@ -0,0 +1,88 @@
+! tests FORALL statements with a mask
+program forall_7
+  real, dimension (5, 5, 5, 5) :: a, b, c, d
+
+  a (:, :, :, :) = 4
+  forall (i = 1:5)
+    a (i, i, 6 - i, i) = 7
+  end forall
+  forall (i = 1:5)
+    a (i, 6 - i, i, i) = 7
+  end forall
+  forall (i = 1:5)
+    a (6 - i, i, i, i) = 7
+  end forall
+  forall (i = 1:5:2)
+    a (1, 2, 3, i) = 0
+  end forall
+
+  b = a
+  c = a
+  d = a
+
+  forall (i = 1:5, j = 1:5, k = 1:5, ((a (i, j, k, i) .gt. 6) .or. (a (i, j, k, j) .gt. 6)))
+    forall (l = 1:5, a (1, 2, 3, l) .lt. 2)
+      a (i, j, k, l) = i - j + k - l + 0.5
+    end forall
+  end forall
+
+  forall (l = 1:5, b (1, 2, 3, l) .lt. 2)
+    forall (i = 1:5, j = 1:5, k = 1:5, ((b (i, j, k, i) .gt. 6) .or. (b (i, j, k, j) .gt. 6)))
+      b (i, j, k, l) = i - j + k - l + 0.5
+    end forall
+  end forall
+
+  forall (i = 1:5, j = 1:5, k = 1:5, ((c (i, j, k, i) .gt. 6) .or. (c (i, j, k, j) .gt. 6)))
+    forall (l = 1:5, c (1, 2, 3, l) .lt. 2)
+      c (i, j, k, l) = i - j + k - l + 0.5 + c (l, k, j, i)
+    end forall
+  end forall
+
+  forall (l = 1:5, d (1, 2, 3, l) .lt. 2)
+    forall (i = 1:5, j = 1:5, k = 1:5, ((d (i, j, k, i) .gt. 6) .or. (d (i, j, k, j) .gt. 6)))
+      d (i, j, k, l) = i - j + k - l + 0.5 + d (l, k, j, i)
+    end forall
+  end forall
+
+  do i = 1, 5
+    do j = 1, 5
+      do k = 1, 5
+       do l = 1, 5
+         r = 4
+         if ((i == j .and. k == 6 - i) .or. (i == k .and. j == 6 - i)) then
+           if (l /= 2 .and. l /= 4) then
+             r = 1
+           elseif (l == i) then
+             r = 7
+           end if
+         elseif (j == k .and. i == 6 - j) then
+           if (l /= 2 .and. l /= 4) then
+             r = 1
+           elseif (l == j) then
+             r = 7
+           end if
+         elseif (i == 1 .and. j == 2 .and. k == 3 .and. l /= 2 .and. l /= 4) then
+           r = 0
+         end if
+         s = r
+         if (r == 1) then
+           r = i - j + k - l + 0.5
+           if (((l == k .and. j == 6 - l) .or. (l == j .and. k == 6 - l)) .and. (i == l)) then
+             s = r + 7
+           elseif (k == j .and. l == 6 - k .and. i == k) then
+             s = r + 7
+           elseif (l /= 1 .or. k /= 2 .or. j /= 3 .or. i == 2 .or. i == 4) then
+             s = r + 4
+           else
+             s = r
+           end if
+         end if
+         if (a (i, j, k, l) /= r) call abort ()
+         if (c (i, j, k, l) /= s) call abort ()
+       end do
+      end do
+    end do
+  end do
+
+  if (any (a /= b .or. c /= d)) call abort ()
+end