Hello world,
this patch fixes the enhancement PR, plus probably a few regressions.
The basic problem was that the code walker got confused when *c, the
pointer to the current gfc_code statement, was changed by inserting
additional code.
Currently regression-testing. OK for trunk if the tests pass?
Thomas
2011-04-18 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/48405
* frontend_passes (cfe_register_funcs): Remove workaround for DO
loops.
(gfc_code_walker): Make sure the pointer to the current
statement doen't change when other statements are inserted.
2011-04-18 Thomas Koenig <tkoe...@gcc.gnu.org>
PR fortran/48405
* gfortran.dg/function_optimize_6.f90: New test.
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 172607)
+++ frontend-passes.c (Arbeitskopie)
@@ -142,12 +142,6 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtre
void *data ATTRIBUTE_UNUSED)
{
- /* FIXME - there is a bug in the insertion code for DO loops. Bail
- out here. */
-
- if ((*current_code)->op == EXEC_DO)
- return 0;
-
if ((*e)->expr_type != EXPR_FUNCTION)
return 0;
@@ -958,31 +952,37 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
{
gfc_code *b;
gfc_actual_arglist *a;
+ gfc_code *co;
- switch ((*c)->op)
+ /* There might be statement insertions before the current code,
+ which must not affect the expression walker. */
+
+ co = *c;
+
+ switch (co->op)
{
case EXEC_DO:
- WALK_SUBEXPR ((*c)->ext.iterator->var);
- WALK_SUBEXPR ((*c)->ext.iterator->start);
- WALK_SUBEXPR ((*c)->ext.iterator->end);
- WALK_SUBEXPR ((*c)->ext.iterator->step);
+ WALK_SUBEXPR (co->ext.iterator->var);
+ WALK_SUBEXPR (co->ext.iterator->start);
+ WALK_SUBEXPR (co->ext.iterator->end);
+ WALK_SUBEXPR (co->ext.iterator->step);
break;
case EXEC_CALL:
case EXEC_ASSIGN_CALL:
- for (a = (*c)->ext.actual; a; a = a->next)
+ for (a = co->ext.actual; a; a = a->next)
WALK_SUBEXPR (a->expr);
break;
case EXEC_CALL_PPC:
- WALK_SUBEXPR ((*c)->expr1);
- for (a = (*c)->ext.actual; a; a = a->next)
+ WALK_SUBEXPR (co->expr1);
+ for (a = co->ext.actual; a; a = a->next)
WALK_SUBEXPR (a->expr);
break;
case EXEC_SELECT:
- WALK_SUBEXPR ((*c)->expr1);
- for (b = (*c)->block; b; b = b->block)
+ WALK_SUBEXPR (co->expr1);
+ for (b = co->block; b; b = b->block)
{
gfc_case *cp;
for (cp = b->ext.block.case_list; cp; cp = cp->next)
@@ -998,7 +998,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
case EXEC_DEALLOCATE:
{
gfc_alloc *a;
- for (a = (*c)->ext.alloc.list; a; a = a->next)
+ for (a = co->ext.alloc.list; a; a = a->next)
WALK_SUBEXPR (a->expr);
break;
}
@@ -1006,7 +1006,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
case EXEC_FORALL:
{
gfc_forall_iterator *fa;
- for (fa = (*c)->ext.forall_iterator; fa; fa = fa->next)
+ for (fa = co->ext.forall_iterator; fa; fa = fa->next)
{
WALK_SUBEXPR (fa->var);
WALK_SUBEXPR (fa->start);
@@ -1017,110 +1017,110 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
}
case EXEC_OPEN:
- WALK_SUBEXPR ((*c)->ext.open->unit);
- WALK_SUBEXPR ((*c)->ext.open->file);
- WALK_SUBEXPR ((*c)->ext.open->status);
- WALK_SUBEXPR ((*c)->ext.open->access);
- WALK_SUBEXPR ((*c)->ext.open->form);
- WALK_SUBEXPR ((*c)->ext.open->recl);
- WALK_SUBEXPR ((*c)->ext.open->blank);
- WALK_SUBEXPR ((*c)->ext.open->position);
- WALK_SUBEXPR ((*c)->ext.open->action);
- WALK_SUBEXPR ((*c)->ext.open->delim);
- WALK_SUBEXPR ((*c)->ext.open->pad);
- WALK_SUBEXPR ((*c)->ext.open->iostat);
- WALK_SUBEXPR ((*c)->ext.open->iomsg);
- WALK_SUBEXPR ((*c)->ext.open->convert);
- WALK_SUBEXPR ((*c)->ext.open->decimal);
- WALK_SUBEXPR ((*c)->ext.open->encoding);
- WALK_SUBEXPR ((*c)->ext.open->round);
- WALK_SUBEXPR ((*c)->ext.open->sign);
- WALK_SUBEXPR ((*c)->ext.open->asynchronous);
- WALK_SUBEXPR ((*c)->ext.open->id);
- WALK_SUBEXPR ((*c)->ext.open->newunit);
+ WALK_SUBEXPR (co->ext.open->unit);
+ WALK_SUBEXPR (co->ext.open->file);
+ WALK_SUBEXPR (co->ext.open->status);
+ WALK_SUBEXPR (co->ext.open->access);
+ WALK_SUBEXPR (co->ext.open->form);
+ WALK_SUBEXPR (co->ext.open->recl);
+ WALK_SUBEXPR (co->ext.open->blank);
+ WALK_SUBEXPR (co->ext.open->position);
+ WALK_SUBEXPR (co->ext.open->action);
+ WALK_SUBEXPR (co->ext.open->delim);
+ WALK_SUBEXPR (co->ext.open->pad);
+ WALK_SUBEXPR (co->ext.open->iostat);
+ WALK_SUBEXPR (co->ext.open->iomsg);
+ WALK_SUBEXPR (co->ext.open->convert);
+ WALK_SUBEXPR (co->ext.open->decimal);
+ WALK_SUBEXPR (co->ext.open->encoding);
+ WALK_SUBEXPR (co->ext.open->round);
+ WALK_SUBEXPR (co->ext.open->sign);
+ WALK_SUBEXPR (co->ext.open->asynchronous);
+ WALK_SUBEXPR (co->ext.open->id);
+ WALK_SUBEXPR (co->ext.open->newunit);
break;
case EXEC_CLOSE:
- WALK_SUBEXPR ((*c)->ext.close->unit);
- WALK_SUBEXPR ((*c)->ext.close->status);
- WALK_SUBEXPR ((*c)->ext.close->iostat);
- WALK_SUBEXPR ((*c)->ext.close->iomsg);
+ WALK_SUBEXPR (co->ext.close->unit);
+ WALK_SUBEXPR (co->ext.close->status);
+ WALK_SUBEXPR (co->ext.close->iostat);
+ WALK_SUBEXPR (co->ext.close->iomsg);
break;
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
case EXEC_FLUSH:
- WALK_SUBEXPR ((*c)->ext.filepos->unit);
- WALK_SUBEXPR ((*c)->ext.filepos->iostat);
- WALK_SUBEXPR ((*c)->ext.filepos->iomsg);
+ WALK_SUBEXPR (co->ext.filepos->unit);
+ WALK_SUBEXPR (co->ext.filepos->iostat);
+ WALK_SUBEXPR (co->ext.filepos->iomsg);
break;
case EXEC_INQUIRE:
- WALK_SUBEXPR ((*c)->ext.inquire->unit);
- WALK_SUBEXPR ((*c)->ext.inquire->file);
- WALK_SUBEXPR ((*c)->ext.inquire->iomsg);
- WALK_SUBEXPR ((*c)->ext.inquire->iostat);
- WALK_SUBEXPR ((*c)->ext.inquire->exist);
- WALK_SUBEXPR ((*c)->ext.inquire->opened);
- WALK_SUBEXPR ((*c)->ext.inquire->number);
- WALK_SUBEXPR ((*c)->ext.inquire->named);
- WALK_SUBEXPR ((*c)->ext.inquire->name);
- WALK_SUBEXPR ((*c)->ext.inquire->access);
- WALK_SUBEXPR ((*c)->ext.inquire->sequential);
- WALK_SUBEXPR ((*c)->ext.inquire->direct);
- WALK_SUBEXPR ((*c)->ext.inquire->form);
- WALK_SUBEXPR ((*c)->ext.inquire->formatted);
- WALK_SUBEXPR ((*c)->ext.inquire->unformatted);
- WALK_SUBEXPR ((*c)->ext.inquire->recl);
- WALK_SUBEXPR ((*c)->ext.inquire->nextrec);
- WALK_SUBEXPR ((*c)->ext.inquire->blank);
- WALK_SUBEXPR ((*c)->ext.inquire->position);
- WALK_SUBEXPR ((*c)->ext.inquire->action);
- WALK_SUBEXPR ((*c)->ext.inquire->read);
- WALK_SUBEXPR ((*c)->ext.inquire->write);
- WALK_SUBEXPR ((*c)->ext.inquire->readwrite);
- WALK_SUBEXPR ((*c)->ext.inquire->delim);
- WALK_SUBEXPR ((*c)->ext.inquire->encoding);
- WALK_SUBEXPR ((*c)->ext.inquire->pad);
- WALK_SUBEXPR ((*c)->ext.inquire->iolength);
- WALK_SUBEXPR ((*c)->ext.inquire->convert);
- WALK_SUBEXPR ((*c)->ext.inquire->strm_pos);
- WALK_SUBEXPR ((*c)->ext.inquire->asynchronous);
- WALK_SUBEXPR ((*c)->ext.inquire->decimal);
- WALK_SUBEXPR ((*c)->ext.inquire->pending);
- WALK_SUBEXPR ((*c)->ext.inquire->id);
- WALK_SUBEXPR ((*c)->ext.inquire->sign);
- WALK_SUBEXPR ((*c)->ext.inquire->size);
- WALK_SUBEXPR ((*c)->ext.inquire->round);
+ WALK_SUBEXPR (co->ext.inquire->unit);
+ WALK_SUBEXPR (co->ext.inquire->file);
+ WALK_SUBEXPR (co->ext.inquire->iomsg);
+ WALK_SUBEXPR (co->ext.inquire->iostat);
+ WALK_SUBEXPR (co->ext.inquire->exist);
+ WALK_SUBEXPR (co->ext.inquire->opened);
+ WALK_SUBEXPR (co->ext.inquire->number);
+ WALK_SUBEXPR (co->ext.inquire->named);
+ WALK_SUBEXPR (co->ext.inquire->name);
+ WALK_SUBEXPR (co->ext.inquire->access);
+ WALK_SUBEXPR (co->ext.inquire->sequential);
+ WALK_SUBEXPR (co->ext.inquire->direct);
+ WALK_SUBEXPR (co->ext.inquire->form);
+ WALK_SUBEXPR (co->ext.inquire->formatted);
+ WALK_SUBEXPR (co->ext.inquire->unformatted);
+ WALK_SUBEXPR (co->ext.inquire->recl);
+ WALK_SUBEXPR (co->ext.inquire->nextrec);
+ WALK_SUBEXPR (co->ext.inquire->blank);
+ WALK_SUBEXPR (co->ext.inquire->position);
+ WALK_SUBEXPR (co->ext.inquire->action);
+ WALK_SUBEXPR (co->ext.inquire->read);
+ WALK_SUBEXPR (co->ext.inquire->write);
+ WALK_SUBEXPR (co->ext.inquire->readwrite);
+ WALK_SUBEXPR (co->ext.inquire->delim);
+ WALK_SUBEXPR (co->ext.inquire->encoding);
+ WALK_SUBEXPR (co->ext.inquire->pad);
+ WALK_SUBEXPR (co->ext.inquire->iolength);
+ WALK_SUBEXPR (co->ext.inquire->convert);
+ WALK_SUBEXPR (co->ext.inquire->strm_pos);
+ WALK_SUBEXPR (co->ext.inquire->asynchronous);
+ WALK_SUBEXPR (co->ext.inquire->decimal);
+ WALK_SUBEXPR (co->ext.inquire->pending);
+ WALK_SUBEXPR (co->ext.inquire->id);
+ WALK_SUBEXPR (co->ext.inquire->sign);
+ WALK_SUBEXPR (co->ext.inquire->size);
+ WALK_SUBEXPR (co->ext.inquire->round);
break;
case EXEC_WAIT:
- WALK_SUBEXPR ((*c)->ext.wait->unit);
- WALK_SUBEXPR ((*c)->ext.wait->iostat);
- WALK_SUBEXPR ((*c)->ext.wait->iomsg);
- WALK_SUBEXPR ((*c)->ext.wait->id);
+ WALK_SUBEXPR (co->ext.wait->unit);
+ WALK_SUBEXPR (co->ext.wait->iostat);
+ WALK_SUBEXPR (co->ext.wait->iomsg);
+ WALK_SUBEXPR (co->ext.wait->id);
break;
case EXEC_READ:
case EXEC_WRITE:
- WALK_SUBEXPR ((*c)->ext.dt->io_unit);
- WALK_SUBEXPR ((*c)->ext.dt->format_expr);
- WALK_SUBEXPR ((*c)->ext.dt->rec);
- WALK_SUBEXPR ((*c)->ext.dt->advance);
- WALK_SUBEXPR ((*c)->ext.dt->iostat);
- WALK_SUBEXPR ((*c)->ext.dt->size);
- WALK_SUBEXPR ((*c)->ext.dt->iomsg);
- WALK_SUBEXPR ((*c)->ext.dt->id);
- WALK_SUBEXPR ((*c)->ext.dt->pos);
- WALK_SUBEXPR ((*c)->ext.dt->asynchronous);
- WALK_SUBEXPR ((*c)->ext.dt->blank);
- WALK_SUBEXPR ((*c)->ext.dt->decimal);
- WALK_SUBEXPR ((*c)->ext.dt->delim);
- WALK_SUBEXPR ((*c)->ext.dt->pad);
- WALK_SUBEXPR ((*c)->ext.dt->round);
- WALK_SUBEXPR ((*c)->ext.dt->sign);
- WALK_SUBEXPR ((*c)->ext.dt->extra_comma);
+ WALK_SUBEXPR (co->ext.dt->io_unit);
+ WALK_SUBEXPR (co->ext.dt->format_expr);
+ WALK_SUBEXPR (co->ext.dt->rec);
+ WALK_SUBEXPR (co->ext.dt->advance);
+ WALK_SUBEXPR (co->ext.dt->iostat);
+ WALK_SUBEXPR (co->ext.dt->size);
+ WALK_SUBEXPR (co->ext.dt->iomsg);
+ WALK_SUBEXPR (co->ext.dt->id);
+ WALK_SUBEXPR (co->ext.dt->pos);
+ WALK_SUBEXPR (co->ext.dt->asynchronous);
+ WALK_SUBEXPR (co->ext.dt->blank);
+ WALK_SUBEXPR (co->ext.dt->decimal);
+ WALK_SUBEXPR (co->ext.dt->delim);
+ WALK_SUBEXPR (co->ext.dt->pad);
+ WALK_SUBEXPR (co->ext.dt->round);
+ WALK_SUBEXPR (co->ext.dt->sign);
+ WALK_SUBEXPR (co->ext.dt->extra_comma);
break;
case EXEC_OMP_DO:
@@ -1133,21 +1133,21 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
case EXEC_OMP_WORKSHARE:
case EXEC_OMP_END_SINGLE:
case EXEC_OMP_TASK:
- if ((*c)->ext.omp_clauses)
+ if (co->ext.omp_clauses)
{
- WALK_SUBEXPR ((*c)->ext.omp_clauses->if_expr);
- WALK_SUBEXPR ((*c)->ext.omp_clauses->num_threads);
- WALK_SUBEXPR ((*c)->ext.omp_clauses->chunk_size);
+ WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
+ WALK_SUBEXPR (co->ext.omp_clauses->num_threads);
+ WALK_SUBEXPR (co->ext.omp_clauses->chunk_size);
}
break;
default:
break;
}
- WALK_SUBEXPR ((*c)->expr1);
- WALK_SUBEXPR ((*c)->expr2);
- WALK_SUBEXPR ((*c)->expr3);
- for (b = (*c)->block; b; b = b->block)
+ WALK_SUBEXPR (co->expr1);
+ WALK_SUBEXPR (co->expr2);
+ WALK_SUBEXPR (co->expr3);
+ for (b = co->block; b; b = b->block)
{
WALK_SUBEXPR (b->expr1);
WALK_SUBEXPR (b->expr2);
! { dg-do compile }
! { dg-options "-O -fdump-tree-original" }
! PR 48405 - function elimnination in a DO loop should work.
program main
interface
pure function mypure()
integer :: mypure
end function mypure
end interface
DO I=1,mypure() + mypure()
ENDDO
END program main
! { dg-final { scan-tree-dump-times "mypure" 1 "original" } }
! { dg-final { cleanup-tree-dump "original" } }
