diff options
| author | Thomas Schwinge <thomas@codesourcery.com> | 2019-03-21 21:02:42 +0100 |
|---|---|---|
| committer | Thomas Schwinge <tschwinge@gcc.gnu.org> | 2019-03-21 21:02:42 +0100 |
| commit | f6bf4bc14d8ab24acad0b0d42cde5e08d1c3a879 (patch) | |
| tree | 73785376b5214f7593d237e5753362e5df843f49 /gcc/fortran/openmp.c | |
| parent | 8ced98c6431c67b4f11b3eb4997b955b97472dc4 (diff) | |
[PR89773] Fortran OpenACC 'routine' directive refuses procedures with implicit EXTERNAL attribute
gcc/fortran/
PR fortran/89773
* gfortran.h (gfc_oacc_routine_name): Add loc member.
(gfc_resolve_oacc_routines): Declare.
* openmp.c (gfc_match_oacc_routine): Move some error checking
into...
(gfc_resolve_oacc_routines): ... this new function.
* resolve.c (resolve_codes): Call it.
gcc/testsuite/
PR fortran/89773
* gfortran.dg/goacc/pr89773.f90: New file.
* gfortran.dg/goacc/pr77765.f90: Adjust.
* gfortran.dg/goacc/routine-6.f90: Adjust, and extend.
From-SVN: r269857
Diffstat (limited to 'gcc/fortran/openmp.c')
| -rw-r--r-- | gcc/fortran/openmp.c | 33 |
1 files changed, 25 insertions, 8 deletions
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index 1b1a0b4108f..983b83db4a7 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2322,15 +2322,10 @@ gfc_match_oacc_routine (void) sym = NULL; } - if ((isym == NULL && st == NULL) - || (sym - && !sym->attr.external - && !sym->attr.function - && !sym->attr.subroutine)) + if (isym == NULL && st == NULL) { - gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, " - "invalid function name %s", - (sym) ? sym->name : buffer); + gfc_error ("Invalid NAME %qs in !$ACC ROUTINE ( NAME ) at %C", + buffer); gfc_current_locus = old_loc; return MATCH_ERROR; } @@ -2400,6 +2395,7 @@ gfc_match_oacc_routine (void) n->sym = sym; n->clauses = c; n->next = gfc_current_ns->oacc_routine_names; + n->loc = old_loc; gfc_current_ns->oacc_routine_names = n; } } @@ -6072,6 +6068,27 @@ gfc_resolve_oacc_declare (gfc_namespace *ns) } } + +void +gfc_resolve_oacc_routines (gfc_namespace *ns) +{ + for (gfc_oacc_routine_name *orn = ns->oacc_routine_names; + orn; + orn = orn->next) + { + gfc_symbol *sym = orn->sym; + if (!sym->attr.external + && !sym->attr.function + && !sym->attr.subroutine) + { + gfc_error ("NAME %qs does not refer to a subroutine or function" + " in !$ACC ROUTINE ( NAME ) at %L", sym->name, &orn->loc); + continue; + } + } +} + + void gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED) { |