re PR fortran/86837 (Optimization breaks an unformatted read with implicit loop)

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-24  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/86837
	* gfortran.dg/implied_do_io_6.f90: New test.

From-SVN: r263838

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c58e12c45ec1d1800adb141920761005e0274afb..0d81a496017833bc7cfb2124f0c32753a5a5e7c5 100644 (file)
--- 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 f9dcddcb156931533679ba84f55fdf30ac7c6e0b..0a5e8937015e87eac93ba0a4c945d676734747cd 100644 (file)
--- 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 004f332be80ffef6f0e2898be7a5f74baddd80c7..064d8ec75e825b0fb40c5372a0763602a6c16f8e 100644 (file)
--- 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 (file)
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