diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 2156e716bdb..64f58e85c2d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,12 @@ +2011-10-10 Thomas Koenig + + 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 PR fortran/45044 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 16053e0742a..dcbaf06d170 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index faa52acc03c..1be870bbd3d 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-10-10 Thomas Koenig + + PR fortran/50564 + * gfortran.dg/forall_15.f90: New test case. + 2011-10-10 Aldy Hernandez Andrew Macleod diff --git a/gcc/testsuite/gfortran.dg/forall_15.f90 b/gcc/testsuite/gfortran.dg/forall_15.f90 new file mode 100644 index 00000000000..c875e033312 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/forall_15.f90 @@ -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" } }