From: Thomas Koenig <tkoenig@gcc.gnu.org>
Date: Fri, 24 Aug 2018 17:26:57 +0000 (+0000)
Subject: re PR fortran/86837 (Optimization breaks an unformatted read with implicit loop)
X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=3413d168824e022555c8246095dfdea297b4c4cc;p=gcc.git

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 c58e12c45ec..0d81a496017 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 f9dcddcb156..0a5e8937015 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 004f332be80..064d8ec75e8 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 00000000000..ebc99b234d1
--- /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