2014-08-11 Cesar Philippidis <cesar@codesourcery.com>
gcc/fortran/
* openmp.c (oacc_compatible_clauses): New function.
(resolve_omp_clauses): Use it.
(oacc_current_ctx): Move it near omp_current_ctx.
(gfc_resolve_do_iterator): Handle OpenACC index variables.
(gfc_resolve_oacc_blocks): Initialize ctx.share_clauses and
ctx.private_iterators.
gcc/testsuite/
* gfortran.dg/goacc/private-1.f95: New test.
@@ -2713,6 +2713,29 @@ resolve_omp_udr_clause (gfc_omp_namelist *n, gfc_namespace *ns,
return copy;
}
+/* Returns true if clause in list 'list' is compatible with any of
+ of the clauses in lists [0..list-1]. E.g., a reduction variable may
+ appear in both reduction and private clauses, so this function
+ will return true in this case. */
+
+static bool
+oacc_compatible_clauses (gfc_omp_clauses *clauses, int list,
+ gfc_symbol *sym, bool openacc)
+{
+ gfc_omp_namelist *n;
+
+ if (!openacc)
+ return false;
+
+ if (list != OMP_LIST_REDUCTION)
+ return false;
+
+ for (n = clauses->lists[OMP_LIST_PRIVATE]; n; n = n->next)
+ if (n->sym == sym)
+ return true;
+
+ return false;
+}
/* OpenMP directive resolving routines. */
@@ -2826,7 +2849,8 @@ resolve_omp_clauses (gfc_code *code, locus *where,
&& list != OMP_LIST_TO)
for (n = omp_clauses->lists[list]; n; n = n->next)
{
- if (n->sym->mark)
+ if (n->sym->mark && !oacc_compatible_clauses (omp_clauses, list,
+ n->sym, openacc))
gfc_error ("Symbol '%s' present on multiple clauses at %L",
n->sym->name, where);
else
@@ -3791,6 +3815,9 @@ struct omp_context
static gfc_code *omp_current_do_code;
static int omp_current_do_collapse;
+typedef struct omp_context oacc_context;
+oacc_context *oacc_current_ctx;
+
void
gfc_resolve_omp_do_blocks (gfc_code *code, gfc_namespace *ns)
{
@@ -3906,6 +3933,8 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
{
int i = omp_current_do_collapse;
gfc_code *c = omp_current_do_code;
+ bool openacc = omp_current_ctx == NULL;
+ omp_context *current_ctx = openacc ? oacc_current_ctx : omp_current_ctx;
if (sym->attr.threadprivate)
return;
@@ -3922,15 +3951,15 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
c = c->block->next;
}
- if (omp_current_ctx == NULL)
+ if (current_ctx == NULL)
return;
- if (pointer_set_contains (omp_current_ctx->sharing_clauses, sym))
+ if (!openacc && pointer_set_contains (current_ctx->sharing_clauses, sym))
return;
- if (! pointer_set_insert (omp_current_ctx->private_iterators, sym))
+ if (! pointer_set_insert (current_ctx->private_iterators, sym))
{
- gfc_omp_clauses *omp_clauses = omp_current_ctx->code->ext.omp_clauses;
+ gfc_omp_clauses *omp_clauses = current_ctx->code->ext.omp_clauses;
gfc_omp_namelist *p;
p = gfc_get_omp_namelist ();
@@ -4106,9 +4135,6 @@ resolve_omp_do (gfc_code *code)
}
}
-typedef struct omp_context oacc_context;
-oacc_context *oacc_current_ctx;
-
static bool
oacc_is_parallel (gfc_code *code)
{
@@ -4424,6 +4450,8 @@ gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
resolve_oacc_loop_blocks (code);
ctx.code = code;
+ ctx.sharing_clauses = NULL;
+ ctx.private_iterators = pointer_set_create ();
ctx.previous = oacc_current_ctx;
oacc_current_ctx = &ctx;
new file mode 100644
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! { dg-additional-options "-fdump-tree-omplower" }
+
+! test for implicit private clauses in do loops
+
+program test
+ implicit none
+ integer :: i, j, k
+ logical :: l
+
+ !$acc parallel
+ !$acc loop
+ do i = 1, 100
+ end do
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc loop
+ do i = 1, 100
+ do j = 1, 100
+ end do
+ end do
+ !$acc end parallel
+
+ !$acc parallel
+ !$acc loop
+ do i = 1, 100
+ do j = 1, 100
+ do k = 1, 100
+ end do
+ end do
+ end do
+ !$acc end parallel
+end program test
+! { dg-prune-output "unimplemented" }
+! { dg-final { scan-tree-dump-times "pragma acc parallel" 3 "omplower" } }
+! { dg-final { scan-tree-dump-times "private\\(i\\)" 3 "omplower" } }
+! { dg-final { scan-tree-dump-times "private\\(j\\)" 2 "omplower" } }
+! { dg-final { scan-tree-dump-times "private\\(k\\)" 1 "omplower" } }