On 08/11/2014 04:55 PM, Cesar Philippidis wrote:
> According to section 2.6.1 in the openacc spec, fortran loop variables
> should be implicitly private like in openmp. This patch does just so.
> Also, while working on this patch, I noticed that I made the check for
> variables appearing in multiple openacc clauses too strict. A private
> variable may also appear inside a reduction clause. I've also included a
> fix for this in this patch.
>
> Is this OK for gomp-4_0-branch?
I've updated this patch to properly handle loop nests inside openacc
data blocks. In the original patch, something like this
!$acc data copy(A)
do z = 1, 100
!$acc parallel
!$acc loop
do j=1,m-2
end do
!$acc end parallel
end do
would result in the loop variable 'z' being implicitly treated as
private. This occurs because gfc_resolve_oacc_blocks updates
oacc_current_ctx for both loop and data blocks. Originally
omp_current_ctx was only associated with do blocks, so
gfc_resolve_do_iterator didn't expect non-loop ctx's. This revised patch
makes gfc_resolve_do_iterator aware potential data blocks.
Is this OK for gomp-4_0-branch?
Thanks,
Cesar
2014-08-11 Cesar Philippidis <ce...@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.
* gfortran.dg/goacc/private-2.f95: New test.
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 91e00c4..4bbbf2f 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,19 @@ gfc_resolve_do_iterator (gfc_code *code, gfc_symbol *sym)
c = c->block->next;
}
- if (omp_current_ctx == NULL)
+ if (current_ctx == NULL)
+ return;
+
+ /* An openacc context may represent a data clause. Abort if so. */
+ if (openacc && !oacc_is_loop (current_ctx->code))
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 +4139,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,11 +4454,14 @@ 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;
gfc_resolve_blocks (code->block, ns);
+ pointer_set_destroy (ctx.private_iterators);
oacc_current_ctx = ctx.previous;
}
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..5aeee3b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/private-1.f95
@@ -0,0 +1,38 @@
+! { 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
+
+ !$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" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/private-2.f95 b/gcc/testsuite/gfortran.dg/goacc/private-2.f95
new file mode 100644
index 0000000..4b038f2
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/private-2.f95
@@ -0,0 +1,39 @@
+! { dg-do compile }
+
+! test for implicit private clauses in do loops
+
+program test
+ implicit none
+ integer :: i, j, k, a(10)
+
+ !$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 data copy(a)
+
+ if(mod(1,10) .eq. 0) write(*,'(i5)') i
+
+ do i = 1, 100
+ !$acc parallel
+ !$acc loop
+ do j = 1, 100
+ do k = 1, 100
+ end do
+ end do
+ !$acc end parallel
+ end do
+
+ !$acc end data
+
+end program test
