procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

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

Browse source 
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
This commit is contained in:
Thomas Koenig 2018-08-24 17:26:57 +00:00
parent 01aa374826
commit 3413d16882
4 changed files with 81 additions and 3 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

9
gcc/fortran/ChangeLog
View file

@ -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

31
gcc/fortran/frontend-passes.c
View file

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

5
gcc/testsuite/ChangeLog
View file

@ -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

39
gcc/testsuite/gfortran.dg/implied_do_io_6.f90 Normal file
View file

@ -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