2014-08-11 Cesar Philippidis 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. diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 91e00c4..2c91597 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -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; diff --git a/gcc/testsuite/gfortran.dg/goacc/private-1.f95 b/gcc/testsuite/gfortran.dg/goacc/private-1.f95 new file mode 100644 index 0000000..4eaec4f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/private-1.f95 @@ -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" } }