diff mbox

[fortran] PR 48405 - Front end expressions in DO loops

Message ID 4DADD5D5.80803@netcologne.de
State New
Headers show

Commit Message

Thomas Koenig April 19, 2011, 6:35 p.m. UTC 
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  <tkoenig@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  <tkoenig@gcc.gnu.org>

         PR fortran/48405
         * gfortran.dg/function_optimize_6.f90:  New test.
! { 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" } }

Comments

Thomas Koenig April 21, 2011, 2:02 p.m. UTC | #1 
Am 19.04.2011 20:35, schrieb Thomas Koenig:
> 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?

Regression-testing passed.  Ping ** 0.25?

	Thomas
Mikael Morin April 21, 2011, 2:17 p.m. UTC | #2 
On Thursday 21 April 2011 16:02:18 Thomas Koenig wrote:
> Am 19.04.2011 20:35, schrieb Thomas Koenig:
> > 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?
> 
> Regression-testing passed.  Ping ** 0.25?
> 
> 	Thomas

OK. Thanks

Mikael
Thomas Koenig April 21, 2011, 7:24 p.m. UTC | #3 
Hi Mikael,

>> Regression-testing passed.  Ping ** 0.25?
>>
>> 	Thomas
>
> OK. Thanks


Waiting for Emacs...
Sende          fortran/ChangeLog
Sende          fortran/frontend-passes.c
Sende          testsuite/ChangeLog
Hinzufügen     testsuite/gfortran.dg/function_optimize_6.f90
Übertrage Daten ....
Revision 172838 übertragen.

Thanks for the review!

	Thomas
diff mbox

Patch

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);