re PR fortran/50564 (Front-end optimization - ICE with FORALL)
2011-10-10 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/50564 * frontend-passes (forall_level): New variable. (cfe_register_funcs): Don't register functions if we are within a forall loop. (optimize_namespace): Set forall_level to 0 before entry. (gfc_code_walker): Increase/decrease forall_level. 2011-10-10 Thomas Koenig <tkoenig@gcc.gnu.org> PR fortran/50564 * gfortran.dg/forall_15.f90: New test case. From-SVN: r179770
This commit is contained in:
parent
50da34bb1b
commit
2855325f50
4 changed files with 57 additions and 0 deletions
|
@ -1,3 +1,12 @@
|
|||
2011-10-10 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/50564
|
||||
* frontend-passes (forall_level): New variable.
|
||||
(cfe_register_funcs): Don't register functions if we
|
||||
are within a forall loop.
|
||||
(optimize_namespace): Set forall_level to 0 before entry.
|
||||
(gfc_code_walker): Increase/decrease forall_level.
|
||||
|
||||
2011-10-09 Tobias Burnus <burnus@net-b.de>
|
||||
|
||||
PR fortran/45044
|
||||
|
|
|
@ -62,6 +62,10 @@ static gfc_code *inserted_block, **changed_statement;
|
|||
|
||||
gfc_namespace *current_ns;
|
||||
|
||||
/* If we are within any forall loop. */
|
||||
|
||||
static int forall_level;
|
||||
|
||||
/* Entry point - run all passes for a namespace. So far, only an
|
||||
optimization pass is run. */
|
||||
|
||||
|
@ -165,6 +169,12 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED,
|
|||
|| (*e)->ts.u.cl->length->expr_type != EXPR_CONSTANT))
|
||||
return 0;
|
||||
|
||||
/* We don't do function elimination within FORALL statements, it can
|
||||
lead to wrong-code in certain circumstances. */
|
||||
|
||||
if (forall_level > 0)
|
||||
return 0;
|
||||
|
||||
/* If we don't know the shape at compile time, we create an allocatable
|
||||
temporary variable to hold the intermediate result, but only if
|
||||
allocation on assignment is active. */
|
||||
|
@ -493,6 +503,7 @@ optimize_namespace (gfc_namespace *ns)
|
|||
{
|
||||
|
||||
current_ns = ns;
|
||||
forall_level = 0;
|
||||
|
||||
gfc_code_walker (&ns->code, convert_do_while, dummy_expr_callback, NULL);
|
||||
gfc_code_walker (&ns->code, cfe_code, cfe_expr_0, NULL);
|
||||
|
@ -1193,6 +1204,8 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
|
|||
WALK_SUBEXPR (fa->end);
|
||||
WALK_SUBEXPR (fa->stride);
|
||||
}
|
||||
if (co->op == EXEC_FORALL)
|
||||
forall_level ++;
|
||||
break;
|
||||
}
|
||||
|
||||
|
@ -1335,6 +1348,10 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
|
|||
WALK_SUBEXPR (b->expr2);
|
||||
WALK_SUBCODE (b->next);
|
||||
}
|
||||
|
||||
if (co->op == EXEC_FORALL)
|
||||
forall_level --;
|
||||
|
||||
}
|
||||
}
|
||||
return 0;
|
||||
|
|
|
@ -1,3 +1,8 @@
|
|||
2011-10-10 Thomas Koenig <tkoenig@gcc.gnu.org>
|
||||
|
||||
PR fortran/50564
|
||||
* gfortran.dg/forall_15.f90: New test case.
|
||||
|
||||
2011-10-10 Aldy Hernandez <aldyh@redhat.com>
|
||||
Andrew Macleod <amacleod@redhat.com>
|
||||
|
||||
|
|
26
gcc/testsuite/gfortran.dg/forall_15.f90
Normal file
26
gcc/testsuite/gfortran.dg/forall_15.f90
Normal file
|
@ -0,0 +1,26 @@
|
|||
! { dg-do run }
|
||||
! { dg-options "-ffrontend-optimize -fdump-tree-original" }
|
||||
! PR 50564 - this used to ICE with front end optimization.
|
||||
! Original test case by Andrew Benson.
|
||||
program test
|
||||
implicit none
|
||||
double precision, dimension(2) :: timeSteps, control
|
||||
integer :: iTime
|
||||
double precision :: ratio
|
||||
double precision :: a
|
||||
|
||||
ratio = 0.7d0
|
||||
control(1) = ratio**(dble(1)-0.5d0)-ratio**(dble(1)-1.5d0)
|
||||
control(2) = ratio**(dble(2)-0.5d0)-ratio**(dble(2)-1.5d0)
|
||||
forall(iTime=1:2)
|
||||
timeSteps(iTime)=ratio**(dble(iTime)-0.5d0)-ratio**(dble(iTime)-1.5d0)
|
||||
end forall
|
||||
if (any(abs(timesteps - control) > 1d-10)) call abort
|
||||
|
||||
! Make sure we still do the front-end optimization after a forall
|
||||
a = cos(ratio)*cos(ratio) + sin(ratio)*sin(ratio)
|
||||
if (abs(a-1.d0) > 1d-10) call abort
|
||||
end program test
|
||||
! { dg-final { scan-tree-dump-times "__builtin_cos" 1 "original" } }
|
||||
! { dg-final { scan-tree-dump-times "__builtin_sin" 1 "original" } }
|
||||
! { dg-final { cleanup-tree-dump "original" } }
|
Loading…
Add table
Reference in a new issue