Patchwork [Fortran] Fix PR 50564

login
register
mail settings
Submitter Thomas Koenig
Date Oct. 9, 2011, 5:52 p.m.
Message ID <4E91DF48.5010704@netcologne.de>
Download mbox | patch
Permalink /patch/118606/
State New
Headers show

Comments

Thomas Koenig - Oct. 9, 2011, 5:52 p.m.
Hello world,

the attached patch fixes the PR by removing common function elimination
in FORALL statements.

In the course of fixing this PR, I had originally fixed the ICE only to
find that the transformation (where f is a function)

forall (i=1:2)
   a(i) = f(i) + f(i)
end forall

to

forall (i=1:2)
   tmp = f(i)
   a(i) = tmp
end forall

did the Wrong Thing.  Oh well...

Regression-tested. OK for tunk?

	Thomas

2011-10-09  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  Thomas Koenig  <tkoenig@gcc.gnu.org>

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

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 179709)
+++ frontend-passes.c	(Arbeitskopie)
@@ -62,6 +62,10 @@  static gfc_code *inserted_block, **changed_stateme
 
 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_subtre
 	  || (*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,7 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t code
 		    WALK_SUBEXPR (fa->end);
 		    WALK_SUBEXPR (fa->stride);
 		  }
+		forall_level ++;
 		break;
 	      }
 
@@ -1335,6 +1347,10 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	      WALK_SUBEXPR (b->expr2);
 	      WALK_SUBCODE (b->next);
 	    }
+
+	  if (co->op == EXEC_FORALL || co->op == EXEC_DO_CONCURRENT)
+	    forall_level --;
+
 	}
     }
   return 0;