From f6bf4bc14d8ab24acad0b0d42cde5e08d1c3a879 Mon Sep 17 00:00:00 2001 From: Thomas Schwinge Date: Thu, 21 Mar 2019 21:02:42 +0100 Subject: [PATCH] [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 --- gcc/fortran/ChangeLog | 8 +++++ gcc/fortran/gfortran.h | 2 ++ gcc/fortran/openmp.c | 33 ++++++++++++----- gcc/fortran/resolve.c | 1 + gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/goacc/pr77765.f90 | 2 +- gcc/testsuite/gfortran.dg/goacc/pr89773.f90 | 36 +++++++++++++++++++ gcc/testsuite/gfortran.dg/goacc/routine-6.f90 | 21 +++++++++-- 8 files changed, 96 insertions(+), 12 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr89773.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 111e3a266e9..7ce67eb46fe 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,13 @@ 2019-03-21 Thomas Schwinge + 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. + PR fortran/72741 * openmp.c (gfc_match_oacc_routine): Clarify. diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index 2f55b9c387a..caf5e528c7e 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -1739,6 +1739,7 @@ typedef struct gfc_oacc_routine_name struct gfc_symbol *sym; struct gfc_omp_clauses *clauses; struct gfc_oacc_routine_name *next; + locus loc; } gfc_oacc_routine_name; @@ -3210,6 +3211,7 @@ 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_routines (gfc_namespace *); /* expr.c */ void gfc_free_actual_arglist (gfc_actual_arglist *); 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) { diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index 7539aa7038c..e1cd2007e59 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -16818,6 +16818,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); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0c94f6bcacf..e771a874319 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,5 +1,10 @@ 2019-03-21 Thomas Schwinge + 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. + PR fortran/72741 * gfortran.dg/goacc/routine-module-mod-1.f90: Update. diff --git a/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 b/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 index afa0a56a632..e0ea391b9a6 100644 --- a/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/pr77765.f90 @@ -14,5 +14,5 @@ end module m ! { dg-error "Procedure 'f' at .1. is already defined" "" { target *-*-* } 8 } ! { dg-error ".1." "" { target *-*-* } 10 } -! { dg-error "Syntax error in ..ACC ROUTINE . NAME . at .1., invalid function name f" "" { target *-*-* } 11 } +! { dg-error "Invalid NAME 'f' in \\!\\\$ACC ROUTINE \\( NAME \\)" "" { target *-*-* } 11 } ! { dg-error "Expecting END MODULE statement" "" { target *-*-* } 12 } diff --git a/gcc/testsuite/gfortran.dg/goacc/pr89773.f90 b/gcc/testsuite/gfortran.dg/goacc/pr89773.f90 new file mode 100644 index 00000000000..e0e5c4f6af5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/pr89773.f90 @@ -0,0 +1,36 @@ +! Valid usage of 'external' procedures with OpenACC 'routine' directives. + +! { dg-additional-options "-fdump-tree-optimized-raw" } + + subroutine test (x) + implicit none + integer, intent(inout) :: x + !$acc routine (test) + + integer, external :: f_1 + !$acc routine (f_1) + + integer f_2 ! No explicit EXTERNAL attribute. + !$acc routine (f_2) + + external s_1 + !$acc routine (s_1) + + ! 's_2' will be an external subroutine without explicit EXTERNAL + ! attribute, but we don't have a handle for it yet... + !!$acc routine (s_2) ..., so can't specify this, here. + + if (x < 1) then + x = 1 + else + x = x * x - 1 + f_1(f_2(x)) + call s_1(x) + call s_2(x) + end if + end subroutine test + +! { dg-final { scan-tree-dump-times "gimple_call" 4 "optimized" } } +! { dg-final { scan-tree-dump-times "gimple_call