Commit 6f87db2d by Thomas Schwinge Committed by Thomas Schwinge

[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 <cesar@codesourcery.com>

From-SVN: r269285
parent 80f52b40
2019-02-28 Thomas Schwinge <thomas@codesourcery.com>
Cesar Philippidis <cesar@codesourcery.com>
PR fortran/72741
PR fortran/89433
* openmp.c (gfc_match_oacc_routine): Accept intrinsic symbols.
2019-02-26 Harald Anlauf <anlauf@gmx.de> 2019-02-26 Harald Anlauf <anlauf@gmx.de>
PR fortran/89492 PR fortran/89492
......
...@@ -2275,8 +2275,9 @@ match ...@@ -2275,8 +2275,9 @@ match
gfc_match_oacc_routine (void) gfc_match_oacc_routine (void)
{ {
locus old_loc; locus old_loc;
gfc_symbol *sym = NULL;
match m; match m;
gfc_intrinsic_sym *isym = NULL;
gfc_symbol *sym = NULL;
gfc_omp_clauses *c = NULL; gfc_omp_clauses *c = NULL;
gfc_oacc_routine_name *n = NULL; gfc_oacc_routine_name *n = NULL;
...@@ -2296,12 +2297,19 @@ gfc_match_oacc_routine (void) ...@@ -2296,12 +2297,19 @@ gfc_match_oacc_routine (void)
if (m == MATCH_YES) if (m == MATCH_YES)
{ {
char buffer[GFC_MAX_SYMBOL_LEN + 1]; char buffer[GFC_MAX_SYMBOL_LEN + 1];
gfc_symtree *st;
m = gfc_match_name (buffer); m = gfc_match_name (buffer);
if (m == MATCH_YES) 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) if (st)
{ {
sym = st->n.sym; sym = st->n.sym;
...@@ -2310,7 +2318,7 @@ gfc_match_oacc_routine (void) ...@@ -2310,7 +2318,7 @@ gfc_match_oacc_routine (void)
sym = NULL; sym = NULL;
} }
if (st == NULL if ((isym == NULL && st == NULL)
|| (sym || (sym
&& !sym->attr.external && !sym->attr.external
&& !sym->attr.function && !sym->attr.function
...@@ -2344,7 +2352,19 @@ gfc_match_oacc_routine (void) ...@@ -2344,7 +2352,19 @@ gfc_match_oacc_routine (void)
!= MATCH_YES)) != MATCH_YES))
return MATCH_ERROR; 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 = gfc_get_oacc_routine_name ();
n->sym = sym; n->sym = sym;
...@@ -2364,6 +2384,9 @@ gfc_match_oacc_routine (void) ...@@ -2364,6 +2384,9 @@ gfc_match_oacc_routine (void)
gfc_current_ns->proc_name->attr.oacc_routine_lop gfc_current_ns->proc_name->attr.oacc_routine_lop
= gfc_oacc_routine_lop (c); = gfc_oacc_routine_lop (c);
} }
else
/* Something has gone wrong, possibly a syntax error. */
goto cleanup;
if (n) if (n)
n->clauses = c; n->clauses = c;
......
2019-02-28 Thomas Schwinge <thomas@codesourcery.com>
Cesar Philippidis <cesar@codesourcery.com>
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 <jakub@redhat.com> 2019-02-28 Jakub Jelinek <jakub@redhat.com>
PR c/89521 PR c/89521
......
! Check for invalid syntax with !$ACC ROUTINE.
module m module m
integer m1int integer m1int
...@@ -45,6 +46,12 @@ program main ...@@ -45,6 +46,12 @@ program main
!$acc end parallel !$acc end parallel
end program main 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) subroutine subr1 (x)
!$acc routine !$acc routine
integer, intent(inout) :: x integer, intent(inout) :: x
......
! 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
! 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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment