diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/openmp.c | 8 | ||||
| -rw-r--r-- | gcc/fortran/parse.c | 28 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures-2.f90 | 27 |
3 files changed, 50 insertions, 13 deletions
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index b246308..94522d1 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2525,6 +2525,14 @@ gfc_match_oacc_routine (void) /* Something has gone wrong, possibly a syntax error. */ goto cleanup; + if (gfc_pure (NULL) && c && (c->gang || c->worker || c->vector)) + { + gfc_error ("!$ACC ROUTINE with GANG, WORKER, or VECTOR clause is not " + "permitted in PURE procedure at %C"); + goto cleanup; + } + + if (n) n->clauses = c; else if (gfc_current_ns->oacc_routine) diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 46e1e1b..3671513 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -639,20 +639,10 @@ decode_oacc_directive (void) gfc_matching_function = false; - if (gfc_pure (NULL)) - { - gfc_error_now ("OpenACC directives at %C may not appear in PURE " - "procedures"); - gfc_error_recovery (); - return ST_NONE; - } - if (gfc_current_state () == COMP_FUNCTION && gfc_current_block ()->result->ts.kind == -1) spec_only = true; - gfc_unset_implicit_pure (NULL); - old_locus = gfc_current_locus; /* General OpenACC directive matching: Instead of testing every possible @@ -663,6 +653,21 @@ decode_oacc_directive (void) switch (c) { + case 'r': + matcha ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE); + break; + } + + gfc_unset_implicit_pure (NULL); + if (gfc_pure (NULL)) + { + gfc_error_now ("OpenACC directives other than ROUTINE may not appear in PURE " + "procedures at %C"); + goto error_handling; + } + + switch (c) + { case 'a': matcha ("atomic", gfc_match_oacc_atomic, ST_OACC_ATOMIC); break; @@ -705,9 +710,6 @@ decode_oacc_directive (void) case 'l': matcha ("loop", gfc_match_oacc_loop, ST_OACC_LOOP); break; - case 'r': - match ("routine", gfc_match_oacc_routine, ST_OACC_ROUTINE); - break; case 's': matcha ("serial loop", gfc_match_oacc_serial_loop, ST_OACC_SERIAL_LOOP); matcha ("serial", gfc_match_oacc_serial, ST_OACC_SERIAL); diff --git a/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures-2.f90 b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures-2.f90 new file mode 100644 index 0000000..97d92c3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pure-elemental-procedures-2.f90 @@ -0,0 +1,27 @@ +pure elemental subroutine foo() +!$acc routine vector ! { dg-error "ROUTINE with GANG, WORKER, or VECTOR clause is not permitted in PURE procedure" } +end + +elemental subroutine foo2() +!$acc routine (myfoo2) gang ! { dg-error "Invalid NAME 'myfoo2' in" } +end + +elemental subroutine foo2a() +!$acc routine gang ! { dg-error "ROUTINE with GANG, WORKER, or VECTOR clause is not permitted in PURE procedure" } +end + +pure subroutine foo3() +!$acc routine vector ! { dg-error "ROUTINE with GANG, WORKER, or VECTOR clause is not permitted in PURE procedure" } +end + +elemental impure subroutine foo4() +!$acc routine vector ! OK: impure +end + +pure subroutine foo5() +!$acc routine seq ! OK: seq +end + +pure subroutine foo6() +!$acc routine ! OK (implied 'seq') +end |