FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

trans-stmt.c (gfc_trans_forall_loop): Clear maskindex before the outermost loop.

Browse source 
* 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 2005-07-11 09:34:33 +02:00 • committed by Jakub Jelinek
parent 15362b89f0
commit fcf3be37e2
4 changed files with 116 additions and 118 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

8
gcc/fortran/ChangeLog
View file

@ -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

134
gcc/fortran/trans-stmt.c
View file

@ -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);

4
gcc/testsuite/ChangeLog
View file

@ -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.

88
gcc/testsuite/gfortran.fortran-torture/execute/forall_7.f90 Normal file
View file

@ -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