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 <tkoe...@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 <tkoe...@gcc.gnu.org>
PR fortran/50690
* gfortran.dg/gomp/workshare2.f90: New test.
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;
! { 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
