Hello world,
this patch fixes a regression by correctly checking that
the innner start, step or end values of an implied do
loop do not depend on an outer loop variable.
The check was actually done before, but gfc_check_dependency
wasn't finding all relevant cases.
Regression-tested. OK for trunk and 8.x?
Regards
Thomas
2018-08-23 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/86837
* frontend-passes.c (var_in_expr_callback): New function.
(var_in_expr): New function.
(traverse_io_block): Use var_in_expr instead of
gfc_check_dependency for checking if the variable depends on the
previous interators.
2018-08-23 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/86837
* gfortran.dg/implied_do_io_6.f90: New test.
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 263752)
+++ frontend-passes.c (Arbeitskopie)
@@ -1104,6 +1104,31 @@ convert_elseif (gfc_code **c, int *walk_subtrees A
return 0;
}
+/* Callback function to var_in_expr - return true if expr1 and
+ expr2 are identical variables. */
+static int
+var_in_expr_callback (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
+ void *data)
+{
+ gfc_expr *expr1 = (gfc_expr *) data;
+ gfc_expr *expr2 = *e;
+
+ if (expr2->expr_type != EXPR_VARIABLE)
+ return 0;
+
+ return expr1->symtree->n.sym == expr2->symtree->n.sym;
+}
+
+/* Return true if expr1 is found in expr2. */
+
+static bool
+var_in_expr (gfc_expr *expr1, gfc_expr *expr2)
+{
+ gcc_assert (expr1->expr_type == EXPR_VARIABLE);
+
+ return gfc_expr_walker (&expr2, var_in_expr_callback, (void *) expr1);
+}
+
struct do_stack
{
struct do_stack *prev;
@@ -1256,9 +1281,9 @@ traverse_io_block (gfc_code *code, bool *has_reach
for (int j = i - 1; j < i; j++)
{
if (iters[j]
- && (gfc_check_dependency (var, iters[j]->start, true)
- || gfc_check_dependency (var, iters[j]->end, true)
- || gfc_check_dependency (var, iters[j]->step, true)))
+ && (var_in_expr (var, iters[j]->start)
+ || var_in_expr (var, iters[j]->end)
+ || var_in_expr (var, iters[j]->step)))
return false;
}
}
! { dg-do run }
! { dg-options "-ffrontend-optimize" }
! PR 86837 - this was mis-optimized by trying to turn this into an
! array I/O statement.
! Original test case by "Pascal".
Program read_loop
implicit none
integer :: i, j
! number of values per column
integer, dimension(3) :: nvalues
data nvalues / 1, 2, 4 /
! values in a 1D array
real, dimension(7) :: one_d
data one_d / 1, 11, 12, 21, 22, 23, 24 /
! where to store the data back
real, dimension(4, 3) :: two_d
! 1 - write our 7 values in one block
open(unit=10, file="loop.dta", form="unformatted")
write(10) one_d
close(unit=10)
! 2 - read them back in chosen cells of a 2D array
two_d = -9
open(unit=10, file="loop.dta", form="unformatted", status='old')
read(10) ((two_d(i,j), i=1,nvalues(j)), j=1,3)
close(unit=10, status='delete')
! 4 - print the whole array, just in case
if (any(reshape(two_d,[12]) /= [1.,-9.,-9.,-9.,11.,12.,-9.,-9.,21.,22.,23.,24.])) call abort
end Program read_loop
