[PATCH] Fix gfortran.dg/forall_1.f90 (take 2)
Jakub Jelinek
jakub@redhat.com
Wed Jun 8 13:18:00 GMT 2005
On Tue, Jun 07, 2005 at 10:08:01PM +0200, Tobias Schl?ter wrote:
> Jakub Jelinek wrote:
> > Of course we only want to increment it in the innermost loop which
> > contains the load of the mask. Here is a fix, tested with no check-f95
> > failures on x86_64-linux. Ok for HEAD and 4.0.2?
> >
> > Alternatively, the increment could be moved to gfc_trans_nested_forall_loop
> > and body passed as stmtblock_t instead of tree. This change is shorter
> > though...
>
> The patch is ok for both provided you add more tests, the testcase I added is
> not really sufficient, because it doesn't have multi-dimensional masks or
> non-trivial dependencies between the mask and the assignments.
Gotta stop somewhere. Clearly there are more bugs in the forall/where
handling lurking.
The problem with the (earlier) forall_7.f90 testcase was that if
LHS in the nested forall did not depend on RHS, only one of the 2
maskindexes was cleared between the setup of the mask temp arrays
and their use. There are 10 calls to gfc_trans_nested_forall_loop
in trans-stmt.c which set mask_flag to 1, 8 of them were clearing
all maskindexes for nested forall statements, but the remaining
2 were just clearing the innermost one.
Fixed by moving the clearing into gfc_trans_nested_forall_loop,
so that it is not duplicated 10 times and done right in all cases.
I then enhanced the forall_7.f90 testcase and further bug showed up
- it is not enough to clear the maskindexes before the loops,
we need to clear it before each set of loops corresponding to
one nested FORALL stmt, otherwise we are walking over uninitialized
memory again. E.g. in forall_2.f90 testcase we got around this by pure
luck (the outer mask was .true. only in one case).
The patch below fixes the forall_7.f90 testcase included in the patch
(and incorporates the patch from yesterday as well).
Ok for HEAD/4.0?
Now, forall_8.f90 and forall_9.f90 tests attached separately still fail,
but I must work on other stuff as well now, so if anyone wants to
continue... forall_9.f90 is forall_7.f90, just that it uses any ()
in the mask expr and causes ICE. forall_8.f90 compiles, but aborts
at runtime. From quick skimming of the gimple dump the bug seems to be
that unlike forall_7.f90 (and all other current testcases), some inner
masks in forall_8.f90 are dependent on the control variables of (some of
the) outer forall statements. But gfortran does not take that into account
and precomputes temp array of size just 5, using whatever value the
control variables ended up having after the loop.
So for:
forall (i = 1:5, j = 1:5, a (i, j, 1, 1) .lt. 8)
forall (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
end forall
gfortran essentially compiles:
forall (i = 1:5, j = 1:5, a (i, j, 1, 1) .lt. 8)
forall (k = 1:5, ((a (6, 6, k, 6) .gt. 6) .or. (a (6, 6, k, 6) .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
end forall
(6 is the value both i and j variables have after computing the 5x5 temp
mask array for the outermost forall loop).
Assuming the above is valid fortran code, I'm afraid gfc_forall_1 needs
to test dependence of the mask expression on the control variables of
outer FORALL statements and if there is any, increase the dimensions
of the temp mask array and iterate over the loops.
Jakub
-------------- next part --------------
2005-06-08 Jakub Jelinek <jakub@redhat.com>
* trans-stmt.c (gfc_trans_forall_loop): Only increment maskindex
in the innermost loop. Clear maskindex before 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.
--- gcc/fortran/trans-stmt.c.jj 2005-06-07 12:35:06.000000000 +0200
+++ gcc/fortran/trans-stmt.c 2005-06-08 13:12:27.000000000 +0200
@@ -1332,7 +1332,7 @@ gfc_trans_forall_loop (forall_info *fora
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;
@@ -1365,18 +1365,16 @@ gfc_trans_forall_loop (forall_info *fora
tmp = build2 (PLUS_EXPR, TREE_TYPE (var), var, step);
gfc_add_modify_expr (&block, var, tmp);
- /* Advance to the next mask element. */
- if (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);
- }
- }
+ /* Advance to the next mask element. Only do this for the
+ innermost loop. */
+ 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 +1385,12 @@ gfc_trans_forall_loop (forall_info *fora
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 +1934,6 @@ gfc_trans_assign_need_temp (gfc_expr * e
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 +1966,6 @@ gfc_trans_assign_need_temp (gfc_expr * e
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 +1978,6 @@ gfc_trans_assign_need_temp (gfc_expr * e
/* 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 +2020,6 @@ gfc_trans_pointer_assign_need_temp (gfc_
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 +2053,6 @@ gfc_trans_pointer_assign_need_temp (gfc_
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 +2061,6 @@ gfc_trans_pointer_assign_need_temp (gfc_
/* 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 +2121,6 @@ gfc_trans_pointer_assign_need_temp (gfc_
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 +2129,6 @@ gfc_trans_pointer_assign_need_temp (gfc_
/* 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);
@@ -2481,10 +2417,6 @@ gfc_trans_forall_1 (gfc_code * code, for
/* 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);
@@ -2526,10 +2458,6 @@ gfc_trans_forall_1 (gfc_code * code, for
/* 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);
@@ -2717,22 +2645,7 @@ gfc_evaluate_where_mask (gfc_expr * me,
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);
@@ -3053,9 +2966,6 @@ gfc_trans_where_2 (gfc_code * code, tree
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");
@@ -3065,17 +2975,6 @@ gfc_trans_where_2 (gfc_code * code, tree
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);
--- gcc/testsuite/gfortran.fortran-torture/execute/forall_7.f90.jj 2005-06-08 14:38:05.000000000 +0200
+++ gcc/testsuite/gfortran.fortran-torture/execute/forall_7.f90 2005-06-08 14:38:02.000000000 +0200
@@ -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
-------------- next part --------------
! tests FORALL statements with a mask
program forall_8
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, a (i, j, 1, 1) .lt. 8)
forall (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
end forall
forall (i = 1:5, k = 1:5, b (i, k, 1, 1) .ge. 0)
forall (l = 1:5, b (1, 2, 3, l) .lt. 2)
forall (j = 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
end forall
forall (i = 1:5, j = 1:5, c (i, j, 1, 1) .lt. 8)
forall (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
end forall
forall (i = 1:5, k = 1:5, d (i, k, 1, 1) .ge. 0)
forall (l = 1:5, d (1, 2, 3, l) .lt. 2)
forall (j = 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
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
-------------- next part --------------
! tests FORALL statements with a mask
program forall_9
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, any (a (i, j, k, :) .gt. 6))
forall (l = 1:5, any (a (:, :, :, l) .lt. 2))
a (i, j, k, l) = i - j + k - l + 0.5
end forall
end forall
forall (l = 1:5, any (b (:, :, :, l) .lt. 2))
forall (i = 1:5, j = 1:5, k = 1:5, any (b (i, j, k, :) .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, any (c (i, j, k, :) .gt. 6))
forall (l = 1:5, any (c (:, :, :, 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, any (d (:, :, :, l) .lt. 2))
forall (i = 1:5, j = 1:5, k = 1:5, any (d (i, j, k, :) .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
More information about the Gcc-patches
mailing list