From: Thomas Schwinge Date: Thu, 28 Feb 2019 20:31:01 +0000 (+0100) Subject: [PR72741, PR89433] Accept intrinsic symbols in Fortran OpenACC 'routine' directives X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=6f87db2d7823ff70eca4fa76950aafe8a98d7356;p=gcc.git [PR72741, PR89433] Accept intrinsic symbols in Fortran OpenACC 'routine' directives gcc/fortran/ PR fortran/72741 PR fortran/89433 * openmp.c (gfc_match_oacc_routine): Accept intrinsic symbols. gcc/testsuite/ PR fortran/72741 PR fortran/89433 * gfortran.dg/goacc/routine-6.f90: Update * gfortran.dg/goacc/routine-intrinsic-1.f: New file. * gfortran.dg/goacc/routine-intrinsic-2.f: Likewise. Co-Authored-By: Cesar Philippidis From-SVN: r269285 --- diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 85ce5bce560..78c6324d1b8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,10 @@ +2019-02-28 Thomas Schwinge + Cesar Philippidis + + PR fortran/72741 + PR fortran/89433 + * openmp.c (gfc_match_oacc_routine): Accept intrinsic symbols. + 2019-02-26 Harald Anlauf PR fortran/89492 diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c index dfd4be86d50..6999ac34a1a 100644 --- a/gcc/fortran/openmp.c +++ b/gcc/fortran/openmp.c @@ -2275,8 +2275,9 @@ match gfc_match_oacc_routine (void) { locus old_loc; - gfc_symbol *sym = NULL; match m; + gfc_intrinsic_sym *isym = NULL; + gfc_symbol *sym = NULL; gfc_omp_clauses *c = NULL; gfc_oacc_routine_name *n = NULL; @@ -2296,12 +2297,19 @@ gfc_match_oacc_routine (void) if (m == MATCH_YES) { char buffer[GFC_MAX_SYMBOL_LEN + 1]; - gfc_symtree *st; m = gfc_match_name (buffer); if (m == MATCH_YES) { - st = gfc_find_symtree (gfc_current_ns->sym_root, buffer); + gfc_symtree *st = NULL; + + /* First look for an intrinsic symbol. */ + isym = gfc_find_function (buffer); + if (!isym) + isym = gfc_find_subroutine (buffer); + /* If no intrinsic symbol found, search the current namespace. */ + if (!isym) + st = gfc_find_symtree (gfc_current_ns->sym_root, buffer); if (st) { sym = st->n.sym; @@ -2310,7 +2318,7 @@ gfc_match_oacc_routine (void) sym = NULL; } - if (st == NULL + if ((isym == NULL && st == NULL) || (sym && !sym->attr.external && !sym->attr.function @@ -2344,7 +2352,19 @@ gfc_match_oacc_routine (void) != MATCH_YES)) return MATCH_ERROR; - if (sym != NULL) + if (isym != NULL) + { + /* Diagnose any OpenACC 'routine' directive that doesn't match the + (implicit) one with a 'seq' clause. */ + if (c && (c->gang || c->worker || c->vector)) + { + gfc_error ("Intrinsic symbol specified in !$ACC ROUTINE ( NAME )" + " at %C marked with incompatible GANG, WORKER, or VECTOR" + " clause"); + goto cleanup; + } + } + else if (sym != NULL) { n = gfc_get_oacc_routine_name (); n->sym = sym; @@ -2364,6 +2384,9 @@ gfc_match_oacc_routine (void) gfc_current_ns->proc_name->attr.oacc_routine_lop = gfc_oacc_routine_lop (c); } + else + /* Something has gone wrong, possibly a syntax error. */ + goto cleanup; if (n) n->clauses = c; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 79de60324e3..c45e7b7546a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2019-02-28 Thomas Schwinge + Cesar Philippidis + + PR fortran/72741 + PR fortran/89433 + * gfortran.dg/goacc/routine-6.f90: Update + * gfortran.dg/goacc/routine-intrinsic-1.f: New file. + * gfortran.dg/goacc/routine-intrinsic-2.f: Likewise. + 2019-02-28 Jakub Jelinek PR c/89521 diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 index 10943cff304..0201b8d1fee 100644 --- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 +++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 @@ -1,3 +1,4 @@ +! Check for invalid syntax with !$ACC ROUTINE. module m integer m1int @@ -45,6 +46,12 @@ program main !$acc end parallel end program main +! Ensure that we recover from 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" } + subroutine subr1 (x) !$acc routine integer, intent(inout) :: x diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-intrinsic-1.f b/gcc/testsuite/gfortran.dg/goacc/routine-intrinsic-1.f new file mode 100644 index 00000000000..5dab573a996 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-intrinsic-1.f @@ -0,0 +1,21 @@ +! Check for valid clauses with intrinsic symbols specified in OpenACC +! 'routine' directives. + + SUBROUTINE sub_1 + IMPLICIT NONE +!$ACC ROUTINE (ABORT) +!$ACC ROUTINE (ABORT) SEQ + + CALL ABORT + END SUBROUTINE sub_1 + + MODULE m_w_1 + IMPLICIT NONE +!$ACC ROUTINE (ABORT) SEQ +!$ACC ROUTINE (ABORT) + + CONTAINS + SUBROUTINE sub_2 + CALL ABORT + END SUBROUTINE sub_2 + END MODULE m_w_1 diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-intrinsic-2.f b/gcc/testsuite/gfortran.dg/goacc/routine-intrinsic-2.f new file mode 100644 index 00000000000..22524cc1645 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/goacc/routine-intrinsic-2.f @@ -0,0 +1,23 @@ +! Check for invalid clauses with intrinsic symbols specified in OpenACC +! 'routine' directives. + + SUBROUTINE sub_1 + IMPLICIT NONE +!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\) marked with incompatible GANG, WORKER, or VECTOR clause" } +!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\) marked with incompatible GANG, WORKER, or VECTOR clause" } +!$ACC ROUTINE (ABORT) VECTOR ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\) marked with incompatible GANG, WORKER, or VECTOR clause" } + + CALL ABORT + END SUBROUTINE sub_1 + + MODULE m_w_1 + IMPLICIT NONE +!$ACC ROUTINE (ABORT) VECTOR ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\) marked with incompatible GANG, WORKER, or VECTOR clause" } +!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\) marked with incompatible GANG, WORKER, or VECTOR clause" } +!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\) marked with incompatible GANG, WORKER, or VECTOR clause" } + + CONTAINS + SUBROUTINE sub_2 + CALL ABORT + END SUBROUTINE sub_2 + END MODULE m_w_1