[patch, fortran] Fix PR 86837, wrong code regression in implied do loop in i/o

[patch, fortran] Fix PR 86837, wrong code regression in implied do loop in i/o

[Thomas König]

[-- Attachment #1: Type: text/plain, Size: 738 bytes --]

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

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

[-- Attachment #2: p1.diff --]
[-- Type: text/x-patch, Size: 1446 bytes --]

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;
 	    }		  
 	}

[-- Attachment #3: implied_do_io_6.f90 --]
[-- Type: text/x-fortran, Size: 1010 bytes --]

! { 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

Re: [patch, fortran] Fix PR 86837, wrong code regression in implied do loop in i/o

[Jerry DeLisle]

On 08/23/2018 01:12 PM, Thomas König wrote:
> 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
> 

Very OK Thomas.

Thanks for patch.

Jerry