Hello world,
here is a fix for PR 50690, pretty self-explanatory. Regression-tested.
OK for trunk?
Thomas
2011-10-15 Thomas Koenig <[email protected]>
PR fortran/50690
* frontend-passes.c (omp_level): New variable.
(create_var): If we are within an OMP block, put
the variable in the enclosing namespace and set
the threadprivate attribute.
(optimize_namespace): Initialize omp_level.
(gfc_code_walker): Keep track of omp level.
2011-10-15 Thomas Koenig <[email protected]>
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
Index: frontend-passes.c
===================================================================
--- frontend-passes.c (Revision 179770)
+++ frontend-passes.c (Arbeitskopie)
@@ -66,6 +66,11 @@ gfc_namespace *current_ns;
static int forall_level;
+/* Keep track of the OMP statements, to make sure we can
+ mark variables introduced by optimizations as threadprivate. */
+
+static int omp_level;
+
/* Entry point - run all passes for a namespace. So far, only an
optimization pass is run. */
@@ -245,9 +250,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 +321,9 @@ create_var (gfc_expr * e)
symbol->attr.flavor = FL_VARIABLE;
symbol->attr.referenced = 1;
symbol->attr.dimension = e->rank > 0;
+ if (omp_level > 0)
+ symbol->attr.threadprivate = 1;
+
gfc_commit_symbol (symbol);
result = gfc_get_expr ();
@@ -504,6 +520,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 +1160,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 +1345,9 @@ 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;
+ omp_level ++;
if (co->ext.omp_clauses)
{
WALK_SUBEXPR (co->ext.omp_clauses->if_expr);
@@ -1352,6 +1374,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;
