diff options
| -rw-r--r-- | gcc/fortran/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/fortran/frontend-passes.c | 31 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/implied_do_io_6.f90 | 39 |
4 files changed, 81 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c58e12c..0d81a49 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2018-08-24 Thomas Koenig <tkoenig@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 Janne Blomqvist <blomqvist.janne@gmail.com> * trans-intrinsic.c (gfc_conv_intrinsic_minmaxval): Delete diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index f9dcddc..0a5e893 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -1104,6 +1104,31 @@ convert_elseif (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED, 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_reached, gfc_code *prev) 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; } } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 004f332..064d8ec 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-08-24 Thomas Koenig <tkoenig@gcc.gnu.org> + + PR fortran/86837 + * gfortran.dg/implied_do_io_6.f90: New test. + 2018-08-24 H.J. Lu <hongjiu.lu@intel.com> PR middle-end/87092 diff --git a/gcc/testsuite/gfortran.dg/implied_do_io_6.f90 b/gcc/testsuite/gfortran.dg/implied_do_io_6.f90 new file mode 100644 index 0000000..ebc99b2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/implied_do_io_6.f90 @@ -0,0 +1,39 @@ +! { 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 |