From 82358e093f3e4d3884140c0d316ccdcd4a70e8ee Mon Sep 17 00:00:00 2001 From: Thomas Koenig Date: Thu, 21 Apr 2011 19:23:34 +0000 Subject: [PATCH] re PR fortran/48405 (Handle expressions in DO loops for front-end optimization) 2011-04-21 Thomas Koenig 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-21 Thomas Koenig PR fortran/48405 * gfortran.dg/function_optimize_6.f90: New test. From-SVN: r172838 --- gcc/fortran/ChangeLog | 8 + gcc/fortran/frontend-passes.c | 222 +++++++++--------- gcc/testsuite/ChangeLog | 5 + .../gfortran.dg/function_optimize_6.f90 | 16 ++ 4 files changed, 140 insertions(+), 111 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/function_optimize_6.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 25ef329b75a..bbe8624a9ab 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,11 @@ +2011-04-21 Thomas Koenig + + 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-21 Tobias Burnus PR fortran/18918 diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index d70435dc384..fbe5d1c0fee 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -140,12 +140,6 @@ cfe_register_funcs (gfc_expr **e, int *walk_subtrees ATTRIBUTE_UNUSED, 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; @@ -956,31 +950,37 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, { gfc_code *b; gfc_actual_arglist *a; + gfc_code *co; + + /* There might be statement insertions before the current code, + which must not affect the expression walker. */ + + co = *c; - switch ((*c)->op) + 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) @@ -996,7 +996,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, 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; } @@ -1004,7 +1004,7 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, 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); @@ -1015,110 +1015,110 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, } 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: @@ -1131,21 +1131,21 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn, 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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0520b0f74dc..304ecb695ca 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-04-21 Thomas Koenig + + PR fortran/48405 + * gfortran.dg/function_optimize_6.f90: New test. + 2011-04-21 Easwaran Raman * gcc.dg/stack-layout-2.c: New test. diff --git a/gcc/testsuite/gfortran.dg/function_optimize_6.f90 b/gcc/testsuite/gfortran.dg/function_optimize_6.f90 new file mode 100644 index 00000000000..cda7ab06283 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/function_optimize_6.f90 @@ -0,0 +1,16 @@ +! { 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" } } + + -- 2.30.2