diff mbox series

[PR72741,PR89433] Accept intrinsic symbols in Fortran OpenACC 'routine' directives

Message ID 877edjodoz.fsf@euler.schwinge.homeip.net
State New
Headers show
Series [PR72741,PR89433] Accept intrinsic symbols in Fortran OpenACC 'routine' directives | expand

Commit Message

Thomas Schwinge Feb. 28, 2019, 8:33 p.m. UTC
Hi!

On Fri, 12 Aug 2016 18:13:43 +0200, I wrote:
> Let me actually break this out of the other pending patches; this should
> be uncontroversial.  Originally by Cesar, extended by me.  OK for trunk?
> 
> commit a0fee96c0f204814e87ddf6635f9cbec2afc6887
> Author: Thomas Schwinge <thomas@codesourcery.com>
> Date:   Fri Aug 12 17:19:05 2016 +0200
> 
>     [PR fortran/72741] Handle intrinsic functions specified in !$ACC ROUTINE ( NAME )

Re-worked a bit, and committed to trunk in r269285 "[PR72741, PR89433]
Accept intrinsic symbols in Fortran OpenACC 'routine' directives", as
attached.


Grüße
 Thomas
diff mbox series

Patch

From 1d86d0eb3e7b6c3d799c91fad4bc12da572160fd Mon Sep 17 00:00:00 2001
From: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 28 Feb 2019 20:31:01 +0000
Subject: [PATCH 1/3] [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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@269285 138bc75d-0d04-0410-961f-82ee72b054a4
---
 gcc/fortran/ChangeLog                         |  7 ++++
 gcc/fortran/openmp.c                          | 33 ++++++++++++++++---
 gcc/testsuite/ChangeLog                       |  9 +++++
 gcc/testsuite/gfortran.dg/goacc/routine-6.f90 |  7 ++++
 .../gfortran.dg/goacc/routine-intrinsic-1.f   | 21 ++++++++++++
 .../gfortran.dg/goacc/routine-intrinsic-2.f   | 23 +++++++++++++
 6 files changed, 95 insertions(+), 5 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-intrinsic-1.f
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-intrinsic-2.f

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 85ce5bce5604..78c6324d1b83 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@ 
+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>
 
 	PR fortran/89492
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index dfd4be86d50e..6999ac34a1a9 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 79de60324e3b..c45e7b7546a9 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,12 @@ 
+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>
 
 	PR c/89521
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
index 10943cff3045..0201b8d1fee5 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 000000000000..5dab573a9966
--- /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 000000000000..22524cc16451
--- /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
-- 
2.17.1