diff mbox

[Fortran] Fix PR 50690

Message ID 4E99B02C.4090401@netcologne.de
State New
Headers show

Commit Message

Thomas Koenig Oct. 15, 2011, 4:09 p.m. UTC 
Hi Jakub,

>I guess you want
> to create the var at function scope and add a private(that_temporary)
> clause to the nearest enclosing OpenMP directive.

Here is a patch which implements this.  Regression-tested, no new
failures.  OK for trunk?

	Thomas

2011-10-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/50690
         * frontend-passes.c (omp_level):  New variable.
         (omp_size):  New variable.
         (omp_block):  New variable.
         (create_var):  If we are within an OMP block, put
         the variable in the enclosing namespace and add it to
         the PRIVATE clause of the enclosing OMP block.
         (optimize_namespace):  Initialize omp_level.
         (gfc_code_walker):  Keep track of omp level.

2011-10-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

         PR fortran/50690
         * gfortran.dg/gomp/workshare2.f90:  New test.
! { dg-do run }
! { dg-options "-ffrontend-optimize" }
! PR 50690 - this used to ICE because workshare could not handle
! BLOCKs.
program foo
  implicit none
  real, parameter :: eps = 3e-7
  integer :: i
  real :: A(10), B(5), C(10)
  B(1) = 3.344
  call random_number(a)
  c = a
  !$omp parallel default(shared)
  !$omp workshare
   A(:) = A(:)*cos(B(1))+A(:)*cos(B(1))
  !$omp end workshare nowait
  !$omp end parallel ! sync is implied here
  c = c*cos(b(1)) + c*cos(b(1))
  if (any(abs(a-c) > eps)) call abort
end program foo
diff mbox

Patch

Index: frontend-passes.c
===================================================================
--- frontend-passes.c	(Revision 179770)
+++ frontend-passes.c	(Arbeitskopie)
@@ -66,6 +66,13 @@  gfc_namespace *current_ns;
 
 static int forall_level;
 
+/* Keep track of the OMP blocks, so we can mark variables introduced
+   by optimizations as private.  */
+
+static int omp_level;
+static int omp_size;
+static gfc_code **omp_block;
+
 /* Entry point - run all passes for a namespace.  So far, only an
    optimization pass is run.  */
 
@@ -76,12 +83,15 @@  gfc_run_passes (gfc_namespace *ns)
     {
       expr_size = 20;
       expr_array = XNEWVEC(gfc_expr **, expr_size);
+      omp_size = 20;
+      omp_block = XCNEWVEC(gfc_code *, omp_size);
 
       optimize_namespace (ns);
       if (gfc_option.dump_fortran_optimized)
 	gfc_dump_parse_tree (ns, stdout);
 
       XDELETEVEC (expr_array);
+      XDELETEVEC (omp_block);
     }
 }
 
@@ -245,9 +255,17 @@  create_var (gfc_expr * e)
   gfc_namespace *ns;
   int i;
 
-  /* If the block hasn't already been created, do so.  */
-  if (inserted_block == NULL)
+  /* If the block hasn't already been created, do so.  If we are within
+     an OMP construct, create the temporary variable in the current block.
+     This is to avoid problems with OMP workshare.  */
+
+  if (omp_level > 0)
     {
+      ns = current_ns;
+      changed_statement = current_code;
+    }
+  else if (inserted_block == NULL)
+    {
       inserted_block = XCNEW (gfc_code);
       inserted_block->op = EXEC_BLOCK;
       inserted_block->loc = (*current_code)->loc;
@@ -308,6 +326,20 @@  create_var (gfc_expr * e)
   symbol->attr.flavor = FL_VARIABLE;
   symbol->attr.referenced = 1;
   symbol->attr.dimension = e->rank > 0;
+
+  if (omp_level > 0)
+    {
+      /* Insert an OMP PRIVATE clause for the new variable.  */
+      gfc_omp_clauses *clauses;
+      gfc_namelist *nn;
+
+      clauses = omp_block[omp_level-1]->ext.omp_clauses;
+      nn = gfc_get_namelist ();
+      nn->sym = symbol;
+      nn->next = clauses->lists[OMP_LIST_PRIVATE];
+      clauses->lists[OMP_LIST_PRIVATE] = nn;
+    }
+
   gfc_commit_symbol (symbol);
 
   result = gfc_get_expr ();
@@ -504,6 +536,7 @@  optimize_namespace (gfc_namespace *ns)
 
   current_ns = ns;
   forall_level = 0;
+  omp_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);
@@ -1143,11 +1176,13 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	  gfc_code *b;
 	  gfc_actual_arglist *a;
 	  gfc_code *co;
+	  bool in_omp;
 
 	  /* There might be statement insertions before the current code,
 	     which must not affect the expression walker.  */
 
 	  co = *c;
+	  in_omp = false;
 
 	  switch (co->op)
 	    {
@@ -1326,6 +1361,18 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	    case EXEC_OMP_WORKSHARE:
 	    case EXEC_OMP_END_SINGLE:
 	    case EXEC_OMP_TASK:
+
+	      in_omp = 1;
+
+	      if (omp_level >= omp_size)
+		{
+		  omp_size += omp_size;
+		  omp_block = XRESIZEVEC(gfc_code *, omp_block, omp_size);
+		}
+
+	      omp_block[omp_level] = co;
+	      omp_level ++;
+
 	      if (co->ext.omp_clauses)
 		{
 		  WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
@@ -1352,6 +1399,9 @@  gfc_code_walker (gfc_code **c, walk_code_fn_t code
 	  if (co->op == EXEC_FORALL)
 	    forall_level --;
 
+	  if (in_omp)
+	    omp_level --;
+
 	}
     }
   return 0;