[OpenACC] Check for sufficient parallelism when calling acc routines in fortran
2018-XX-YY Cesar Philippidis <cesar@codesourcery.com>
gcc/fortran/
* gfortran.h (gfc_resolve_oacc_routine_call): Declare.
(gfc_resolve_oacc_routines): Declare.
* openmp.c (gfc_match_oacc_routine): Make error reporting more
precise. Defer rejection of non-function and subroutine symbols
until gfc_resolve_oacc_routines.
(struct fortran_omp_context): Add a dims member.
(gfc_resolve_oacc_blocks): Update ctx->dims.
(gfc_resolve_oacc_routine_call): New function.
(gfc_resolve_oacc_routines): New function.
* resolve.c (resolve_function): Call gfc_resolve_oacc_routine_call.
(resolve_call): Likewise.
(resolve_codes): Call gfc_resolve_oacc_routines.
gcc/testsuite/
* gfortran.dg/goacc/routine-10.f90: New test.
* gfortran.dg/goacc/routine-9.f90: New test.
* gfortran.dg/goacc/routine-nested-parallelism.f: New test.
* gfortran.dg/goacc/routine-nested-parallelism.f90: New test.
(cherry picked from gomp-4_0-branch r239784)
(cherry picked from gomp-4_0-branch r247353)
---
gcc/fortran/gfortran.h | 2 +
gcc/fortran/openmp.c | 108 +++++-
gcc/fortran/resolve.c | 11 +
.../gfortran.dg/goacc/routine-10.f90 | 6 +
gcc/testsuite/gfortran.dg/goacc/routine-9.f90 | 96 +++++
.../goacc/routine-nested-parallelism.f | 340 ++++++++++++++++++
.../goacc/routine-nested-parallelism.f90 | 340 ++++++++++++++++++
7 files changed, 887 insertions(+), 16 deletions(-)
create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-10.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-9.f90
create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-nested-parallelism.f
create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-nested-parallelism.f90
@@ -3166,6 +3166,8 @@ void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
void gfc_resolve_oacc_declare (gfc_namespace *);
void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *);
void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_routine_call (gfc_symbol *, locus *);
+void gfc_resolve_oacc_routines (gfc_namespace *);
/* expr.c */
void gfc_free_actual_arglist (gfc_actual_arglist *);
@@ -2319,7 +2319,13 @@ gfc_match_oacc_routine (void)
{
if ((isym = gfc_find_function (buffer)) == NULL
&& (isym = gfc_find_subroutine (buffer)) == NULL)
- st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
+ {
+ st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
+ if (st == NULL && gfc_current_ns->proc_name->attr.contained
+ && gfc_current_ns->parent)
+ st = gfc_find_symtree (gfc_current_ns->parent->sym_root,
+ buffer);
+ }
if (st)
{
sym = st->n.sym;
@@ -2327,18 +2333,12 @@ gfc_match_oacc_routine (void)
&& strcmp (sym->name, gfc_current_ns->proc_name->name) == 0)
sym = NULL;
}
-
- if ((isym == NULL && st == NULL)
- || (sym
- && !sym->attr.external
- && !sym->attr.function
- && !sym->attr.subroutine))
+ else if (isym == NULL)
{
- gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, "
- "invalid function name %s",
- (sym) ? sym->name : buffer);
- gfc_current_locus = old_loc;
- return MATCH_ERROR;
+ gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, "
+ "invalid function name %qs", &old_loc, buffer);\
+ goto cleanup;
+
}
/* Set sym to NULL if it matches the current procedure's
@@ -2371,20 +2371,27 @@ gfc_match_oacc_routine (void)
dims = gfc_oacc_routine_dims (c);
if (dims == OACC_FUNCTION_NONE)
{
- gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at %C");
+ gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at %L",
+ &old_loc);
/* Don't abort early, because it's important to let the user
know of any potential duplicate routine directives. */
seen_error = true;
}
+ else if (dims == OACC_FUNCTION_AUTO)
+ {
+ gfc_warning (0, "Expected one of %<gang%>, %<worker%>, %<vector%> or "
+ "%<seq%> clauses in !$ACC ROUTINE at %L", &old_loc);
+ dims = OACC_FUNCTION_SEQ;
+ }
if (isym != NULL)
{
if (c && (c->gang || c->worker || c->vector))
{
gfc_error ("Intrinsic symbol specified in !$ACC ROUTINE ( NAME ) "
- "at %C, with incompatible clauses specifying the level "
- "of parallelism");
+ "at %L, with incompatible clauses specifying the level "
+ "of parallelism", &old_loc);
goto cleanup;
}
/* The intrinsic symbol has been marked with a SEQ, or with no clause at
@@ -2429,7 +2436,8 @@ gfc_match_oacc_routine (void)
&old_loc))
goto cleanup;
- gfc_current_ns->proc_name->attr.oacc_function = dims;
+ gfc_current_ns->proc_name->attr.oacc_function
+ = seen_error ? OACC_FUNCTION_SEQ : dims;
gfc_current_ns->proc_name->attr.oacc_function_nohost
= c ? c->nohost : false;
@@ -5359,6 +5367,7 @@ static struct fortran_omp_context
hash_set<gfc_symbol *> *private_iterators;
struct fortran_omp_context *previous;
bool is_openmp;
+ oacc_function dims;
} *omp_current_ctx;
static gfc_code *omp_current_do_code;
static int omp_current_do_collapse;
@@ -6036,6 +6045,7 @@ void
gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
{
fortran_omp_context ctx;
+ oacc_function dims = OACC_FUNCTION_NONE;
resolve_oacc_loop_blocks (code);
@@ -6044,6 +6054,21 @@ gfc_resolve_oacc_blocks (gfc_code *code, gfc_namespace *ns)
ctx.private_iterators = new hash_set<gfc_symbol *>;
ctx.previous = omp_current_ctx;
ctx.is_openmp = false;
+
+ if (code->ext.omp_clauses->gang)
+ dims = OACC_FUNCTION_GANG;
+ if (code->ext.omp_clauses->worker)
+ dims = OACC_FUNCTION_WORKER;
+ if (code->ext.omp_clauses->vector)
+ dims = OACC_FUNCTION_VECTOR;
+ if (code->ext.omp_clauses->seq)
+ dims = OACC_FUNCTION_SEQ;
+
+ if (dims == OACC_FUNCTION_NONE && ctx.previous != NULL
+ && !ctx.previous->is_openmp)
+ dims = ctx.previous->dims;
+
+ ctx.dims = dims;
omp_current_ctx = &ctx;
gfc_resolve_blocks (code->block, ns);
@@ -6401,3 +6426,54 @@ gfc_resolve_omp_udrs (gfc_symtree *st)
for (omp_udr = st->n.omp_udr; omp_udr; omp_udr = omp_udr->next)
gfc_resolve_omp_udr (omp_udr);
}
+
+/* Ensure that any calls to OpenACC routines respects the current
+ level of parallelism of the innermost loop. */
+
+void
+gfc_resolve_oacc_routine_call (gfc_symbol *sym, locus *loc)
+{
+ gfc_oacc_routine_name *n = NULL;
+ oacc_function loop_dims = OACC_FUNCTION_NONE;
+ oacc_function routine_dims;
+
+ if (!omp_current_ctx)
+ return;
+
+ loop_dims = omp_current_ctx->dims;
+
+ if (omp_current_ctx->is_openmp || loop_dims == OACC_FUNCTION_NONE)
+ return;
+
+ for (n = gfc_current_ns->oacc_routine_names; n; n = n->next)
+ if (n->sym == sym)
+ break;
+
+ if (n == NULL)
+ return;
+
+ routine_dims = gfc_oacc_routine_dims (n->clauses);
+
+ if (routine_dims == OACC_FUNCTION_SEQ)
+ return;
+ if (routine_dims <= loop_dims)
+ gfc_error ("Insufficient !$ACC LOOP parallelism available to call "
+ "%qs at %L", sym->name, loc);
+}
+
+void
+gfc_resolve_oacc_routines (gfc_namespace *ns)
+{
+ gfc_oacc_routine_name *routines = NULL;
+
+ for (routines = ns->oacc_routine_names; routines; routines = routines->next)
+ {
+ gfc_symbol *sym = routines->sym;
+
+ if (!sym->attr.external
+ && !sym->attr.function
+ && !sym->attr.subroutine)
+ gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, "
+ "invalid function name %qs", &routines->loc, sym->name);
+ }
+}
@@ -3337,6 +3337,11 @@ resolve_function (gfc_expr *expr)
/* typebound procedure: Assume the worst. */
gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+ /* Calls to OpenACC routines have imposed restrictions on gang,
+ worker and vector parallelism. */
+ if (sym)
+ gfc_resolve_oacc_routine_call (sym, &expr->where);
+
return t;
}
@@ -3680,6 +3685,11 @@ resolve_call (gfc_code *c)
/* Typebound procedure: Assume the worst. */
gfc_current_ns->proc_name->attr.array_outer_dependency = 1;
+ /* Calls to OpenACC routines have imposed restrictions on gang,
+ worker and vector parallelism. */
+ if (csym)
+ gfc_resolve_oacc_routine_call (csym, &c->loc);
+
return t;
}
@@ -16645,6 +16655,7 @@ resolve_codes (gfc_namespace *ns)
bitmap_obstack_initialize (&labels_obstack);
gfc_resolve_oacc_declare (ns);
+ gfc_resolve_oacc_routines (ns);
gfc_resolve_omp_local_vars (ns);
gfc_resolve_code (ns->code, ns);
new file mode 100644
@@ -0,0 +1,6 @@
+! Ensure that GFortran doesn't ICE with incomplete function
+! definitions.
+
+integer function f1 ! { dg-error "Expected formal argument list in function definition" }
+ !$acc routine ! { dg-error "Unclassifiable OpenACC directive" }
+end function f1 ! { dg-error "Expecting END PROGRAM statement" }
new file mode 100644
@@ -0,0 +1,96 @@
+! Check for late resolver errors caused by invalid ACC ROUTINE
+! directives.
+
+module m
+ integer m1int
+contains
+ subroutine subr5 (x)
+ implicit none
+ integer extfunc
+ !$acc routine (subr5)
+ !$acc routine (extfunc)
+ !$acc routine (m1int) ! { dg-error "invalid function name" }
+ integer, intent(inout) :: x
+ if (x < 1) then
+ x = 1
+ else
+ x = x * x - 1 + extfunc(2)
+ end if
+ end subroutine subr5
+end module m
+
+program main
+ implicit none
+ interface
+ function subr6 (x)
+ integer, intent (in) :: x
+ integer :: subr6
+ end function subr6
+ end interface
+ integer, parameter :: n = 10
+ integer :: a(n), i
+ !$acc routine (subr1) ! { dg-error "invalid function name" }
+ external :: subr2
+ !$acc routine (subr2)
+
+ external :: R1, R2
+ !$acc routine (R1)
+ !$acc routine (R2)
+
+ !$acc parallel
+ !$acc loop
+ do i = 1, n
+ call subr1 (i)
+ call subr2 (i)
+ end do
+ !$acc end parallel
+end program main
+
+subroutine subr1 (x)
+ !$acc routine
+ integer, intent(inout) :: x
+ if (x < 1) then
+ x = 1
+ else
+ x = x * x - 1
+ end if
+end subroutine subr1
+
+subroutine subr2 (x)
+ integer, intent(inout) :: x
+ if (x < 1) then
+ x = 1
+ else
+ x = x * x - 1
+ end if
+end subroutine subr2
+
+subroutine subr3 (x)
+ !$acc routine (subr3)
+ integer, intent(inout) :: x
+ if (x < 1) then
+ x = 1
+ else
+ call subr4 (x)
+ end if
+end subroutine subr3
+
+subroutine subr4 (x)
+ !$acc routine (subr4)
+ integer, intent(inout) :: x
+ if (x < 1) then
+ x = 1
+ else
+ x = x * x - 1
+ end if
+end subroutine subr4
+
+subroutine subr10 (x)
+ !$acc routine (subr10) device ! { dg-error "Unclassifiable OpenACC directive" }
+ integer, intent(inout) :: x
+ if (x < 1) then
+ x = 1
+ else
+ x = x * x - 1
+ end if
+end subroutine subr10
new file mode 100644
@@ -0,0 +1,340 @@
+! Validate calls to ACC ROUTINES. Ensure that the loop containing the
+! call has sufficient parallelism to for the routine.
+
+ subroutine sub
+ implicit none
+ integer, parameter :: n = 100
+ integer :: a(n), i, j
+ external gangr, workerr, vectorr, seqr
+!$acc routine (gangr) gang
+!$acc routine (workerr) worker
+!$acc routine (vectorr) vector
+!$acc routine (seqr) seq
+
+!
+! Test subroutine calls inside nested loops.
+!
+
+!$acc parallel loop
+ do i = 1, n
+ !$acc loop
+ do j = 1, n
+ call workerr (a, n)
+ end do
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop
+ do i = 1, n
+!$acc loop gang
+ do j = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ end do
+!$acc end parallel loop
+
+!
+! Test calls to seq routines
+!
+
+!$acc parallel loop
+ do i = 1, n
+ call seqr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop gang
+ do i = 1, n
+ call seqr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop worker
+ do i = 1, n
+ call seqr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop vector
+ do i = 1, n
+ call seqr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop seq
+ do i = 1, n
+ call seqr (a, n)
+ end do
+!$acc end parallel loop
+
+!
+! Test calls to gang routines
+!
+
+!$acc parallel loop
+ do i = 1, n
+ call gangr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop gang
+ do i = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop worker
+ do i = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop vector
+ do i = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop seq
+ do i = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!
+! Test calls to worker routines
+!
+
+!$acc parallel loop
+ do i = 1, n
+ call workerr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop gang
+ do i = 1, n
+ call workerr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop worker
+ do i = 1, n
+ call workerr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop vector
+ do i = 1, n
+ call workerr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop seq
+ do i = 1, n
+ call workerr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!
+! Test calls to vector routines
+!
+
+!$acc parallel loop
+ do i = 1, n
+ call vectorr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop gang
+ do i = 1, n
+ call vectorr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop worker
+ do i = 1, n
+ call vectorr (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop vector
+ do i = 1, n
+ call vectorr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop seq
+ do i = 1, n
+ call vectorr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+ end subroutine sub
+
+ subroutine func
+ implicit none
+ integer, parameter :: n = 100
+ integer :: a(n), i, j
+ integer gangf, workerf, vectorf, seqf
+!$acc routine (gangf) gang
+!$acc routine (workerf) worker
+!$acc routine (vectorf) vector
+!$acc routine (seqf) seq
+
+!
+! Test subroutine calls inside nested loops.
+!
+
+!$acc parallel loop
+ do i = 1, n
+!$acc loop
+ do j = 1, n
+ a(1) = workerf (a, n)
+ end do
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop
+ do i = 1, n
+!$acc loop gang
+ do j = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ end do
+!$acc end parallel loop
+
+!
+! Test calls to seq routines
+!
+
+!$acc parallel loop
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop gang
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop worker
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop vector
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop seq
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+!$acc end parallel loop
+
+!
+! Test calls to gang routines
+!
+
+!$acc parallel loop
+ do i = 1, n
+ a(1) = gangf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop gang
+ do i = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop worker
+ do i = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop vector
+ do i = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop seq
+ do i = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!
+! Test calls to worker routines
+!
+
+!$acc parallel loop
+ do i = 1, n
+ a(1) = workerf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop gang
+ do i = 1, n
+ a(1) = workerf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop worker
+ do i = 1, n
+ a(1) = workerf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop vector
+ do i = 1, n
+ a(1) = workerf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop seq
+ do i = 1, n
+ a(1) = workerf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!
+! Test calls to vector routines
+!
+
+!$acc parallel loop
+ do i = 1, n
+ a(1) = vectorf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop gang
+ do i = 1, n
+ a(1) = vectorf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop worker
+ do i = 1, n
+ a(1) = vectorf (a, n)
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop vector
+ do i = 1, n
+ a(1) = vectorf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+
+!$acc parallel loop seq
+ do i = 1, n
+ a(1) = vectorf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+!$acc end parallel loop
+ end subroutine func
new file mode 100644
@@ -0,0 +1,340 @@
+! Validate calls to ACC ROUTINES. Ensure that the loop containing the
+! call has sufficient parallelism to for the routine.
+
+subroutine sub
+ implicit none
+ integer, parameter :: n = 100
+ integer :: a(n), i, j
+ external gangr, workerr, vectorr, seqr
+ !$acc routine (gangr) gang
+ !$acc routine (workerr) worker
+ !$acc routine (vectorr) vector
+ !$acc routine (seqr) seq
+
+ !
+ ! Test subroutine calls inside nested loops.
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ !$acc loop
+ do j = 1, n
+ call workerr (a, n)
+ end do
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop
+ do i = 1, n
+ !$acc loop gang
+ do j = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ end do
+ !$acc end parallel loop
+
+ !
+ ! Test calls to seq routines
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ call seqr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop gang
+ do i = 1, n
+ call seqr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop worker
+ do i = 1, n
+ call seqr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop vector
+ do i = 1, n
+ call seqr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop seq
+ do i = 1, n
+ call seqr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !
+ ! Test calls to gang routines
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ call gangr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop gang
+ do i = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop worker
+ do i = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop vector
+ do i = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop seq
+ do i = 1, n
+ call gangr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !
+ ! Test calls to worker routines
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ call workerr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop gang
+ do i = 1, n
+ call workerr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop worker
+ do i = 1, n
+ call workerr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop vector
+ do i = 1, n
+ call workerr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop seq
+ do i = 1, n
+ call workerr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !
+ ! Test calls to vector routines
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ call vectorr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop gang
+ do i = 1, n
+ call vectorr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop worker
+ do i = 1, n
+ call vectorr (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop vector
+ do i = 1, n
+ call vectorr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop seq
+ do i = 1, n
+ call vectorr (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+end subroutine sub
+
+subroutine func
+ implicit none
+ integer, parameter :: n = 100
+ integer :: a(n), i, j
+ integer gangf, workerf, vectorf, seqf
+ !$acc routine (gangf) gang
+ !$acc routine (workerf) worker
+ !$acc routine (vectorf) vector
+ !$acc routine (seqf) seq
+
+ !
+ ! Test subroutine calls inside nested loops.
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ !$acc loop
+ do j = 1, n
+ a(1) = workerf (a, n)
+ end do
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop
+ do i = 1, n
+ !$acc loop gang
+ do j = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ end do
+ !$acc end parallel loop
+
+ !
+ ! Test calls to seq routines
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop gang
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop worker
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop vector
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop seq
+ do i = 1, n
+ a(1) = seqf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !
+ ! Test calls to gang routines
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ a(1) = gangf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop gang
+ do i = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop worker
+ do i = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop vector
+ do i = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop seq
+ do i = 1, n
+ a(1) = gangf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !
+ ! Test calls to worker routines
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ a(1) = workerf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop gang
+ do i = 1, n
+ a(1) = workerf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop worker
+ do i = 1, n
+ a(1) = workerf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop vector
+ do i = 1, n
+ a(1) = workerf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop seq
+ do i = 1, n
+ a(1) = workerf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !
+ ! Test calls to vector routines
+ !
+
+ !$acc parallel loop
+ do i = 1, n
+ a(1) = vectorf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop gang
+ do i = 1, n
+ a(1) = vectorf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop worker
+ do i = 1, n
+ a(1) = vectorf (a, n)
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop vector
+ do i = 1, n
+ a(1) = vectorf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+
+ !$acc parallel loop seq
+ do i = 1, n
+ a(1) = vectorf (a, n) ! { dg-error "Insufficient ..ACC LOOP parallelism" }
+ end do
+ !$acc end parallel loop
+end subroutine func
--
2.17.1