trans-stmt.c (gfc_trans_forall_loop): Clear maskindex before the outermost loop.
* 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. From-SVN: r101865
This commit is contained in:
Jakub Jelinek
Jakub Jelinek
parent
15362b89f0
commit
fcf3be37e2
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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.
|
||||
|
|
|
|||
|
|
@ -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
|
||||
Loading…
Reference in New Issue