[openacc] Check clauses with intrinsic function specified in !$ACC ROUTINE ( NAME )

Message ID d3c4538d-8702-26d0-5846-615440c5836f@codesourcery.com
State New
Headers show
Series
  • [openacc] Check clauses with intrinsic function specified in !$ACC ROUTINE ( NAME )
Related show

Commit Message

Cesar Philippidis Oct. 2, 2018, 2:57 p.m.
This patch allows Fortran intrinsic functions to be declared as acc
routines. For instance, abort can now be called from acc within
offloaded regions.

Given that intrinsic functions like sin and cos are important for
offloaded functions, I wonder if there is a better way to accomplish to
enabling this. Maybe certain intrinsic functions should default to
having an implied acc routine directive. But I suppose that's something
for another patch.

Is this OK for trunk? I bootstrapped and regtested it for x86_64 Linux
with nvptx offloading.

Thanks,
Cesar

Patch

[PR fortran/72741] Check clauses with intrinsic function specified in !$ACC ROUTINE ( NAME )

2018-XX-YY  Cesar Philippidis  <cesar@codesourcery.com>

	gcc/fortran/
	* openmp.c (gfc_match_oacc_routine): Check clauses of intrinsic
	functions.

	gcc/testsuite/
	* gfortran.dg/goacc/fixed-1.f: Update test.
	* gfortran.dg/goacc/pr72741-2.f: New test.
	* gfortran.dg/goacc/pr72741-intrinsic-1.f: New test.
	* gfortran.dg/goacc/pr72741-intrinsic-2.f: New test.
	* gfortran.dg/goacc/pr72741.f90: Update test.

	libgomp/
	* testsuite/libgomp.oacc-fortran/abort-1.f90: Update test.
	* testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f: Update test.

(cherry picked from gomp-4_0-branch r239422)
(cherry picked from gomp-4_0-branch r239515, and r247954)
---
 gcc/fortran/openmp.c                          | 41 +++++++++++++++----
 gcc/testsuite/gfortran.dg/goacc/fixed-1.f     |  2 +
 gcc/testsuite/gfortran.dg/goacc/pr72741-2.f   | 39 ++++++++++++++++++
 .../gfortran.dg/goacc/pr72741-intrinsic-1.f   | 16 ++++++++
 .../gfortran.dg/goacc/pr72741-intrinsic-2.f   | 22 ++++++++++
 gcc/testsuite/gfortran.dg/goacc/pr72741.f90   | 20 +++++++--
 .../libgomp.oacc-fortran/abort-1.f90          |  1 +
 .../libgomp.oacc-fortran/acc_on_device-1-2.f  |  1 +
 8 files changed, 130 insertions(+), 12 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr72741-2.f
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 60ecaf54523..58cbe0ae90c 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2288,8 +2288,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;
   oacc_function dims;
@@ -2311,12 +2312,14 @@  gfc_match_oacc_routine (void)
   if (m == MATCH_YES)
     {
       char buffer[GFC_MAX_SYMBOL_LEN + 1];
-      gfc_symtree *st;
+      gfc_symtree *st = NULL;
 
       m = gfc_match_name (buffer);
       if (m == MATCH_YES)
 	{
-	  st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
+	  if ((isym = gfc_find_function (buffer)) == NULL
+	      && (isym = gfc_find_subroutine (buffer)) == NULL)
+	    st = gfc_find_symtree (gfc_current_ns->sym_root, buffer);
 	  if (st)
 	    {
 	      sym = st->n.sym;
@@ -2325,7 +2328,7 @@  gfc_match_oacc_routine (void)
 	        sym = NULL;
 	    }
 
-	  if (st == NULL
+	  if ((isym == NULL && st == NULL)
 	      || (sym
 		  && !sym->attr.external
 		  && !sym->attr.function
@@ -2337,6 +2340,13 @@  gfc_match_oacc_routine (void)
 	      gfc_current_locus = old_loc;
 	      return MATCH_ERROR;
 	    }
+
+	  /* Set sym to NULL if it matches the current procedure's
+	     name.  This will simplify the check for duplicate ACC
+	     ROUTINE attributes.  */
+	  if (gfc_current_ns->proc_name
+	      && !strcmp (buffer, gfc_current_ns->proc_name->name))
+	    sym = NULL;
 	}
       else
         {
@@ -2357,15 +2367,30 @@  gfc_match_oacc_routine (void)
 	  != MATCH_YES))
     return MATCH_ERROR;
 
+  /* Scan for invalid routine geometry.  */
   dims = gfc_oacc_routine_dims (c);
   if (dims == OACC_FUNCTION_NONE)
     {
-      gfc_error ("Multiple loop axes specified for routine %C");
-      gfc_current_locus = old_loc;
-      return MATCH_ERROR;
+      gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at %C");
+
+      /* Don't abort early, because it's important to let the user
+	 know of any potential duplicate routine directives.  */
+      seen_error = true;
     }
 
-  if (sym != NULL)
+  if (isym != NULL)
+    {
+      if (c && (c->gang || c->worker || c->vector))
+	{
+	  gfc_error ("Intrinsic symbol specified in !$ACC ROUTINE ( NAME ) "
+		     "at %C, with incompatible clauses specifying the level "
+		     "of parallelism");
+	  goto cleanup;
+	}
+      /* The intrinsic symbol has been marked with a SEQ, or with no clause at
+	 all, which is OK.  */
+    }
+  else if (sym != NULL)
     {
       bool needs_entry = true;
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/fixed-1.f b/gcc/testsuite/gfortran.dg/goacc/fixed-1.f
index 974f2702260..3a900c5b4e6 100644
--- a/gcc/testsuite/gfortran.dg/goacc/fixed-1.f
+++ b/gcc/testsuite/gfortran.dg/goacc/fixed-1.f
@@ -1,3 +1,5 @@ 
+!$ACC ROUTINE(ABORT) SEQ
+
       INTEGER :: ARGC
       ARGC = COMMAND_ARGUMENT_COUNT ()
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr72741-2.f b/gcc/testsuite/gfortran.dg/goacc/pr72741-2.f
new file mode 100644
index 00000000000..58651440d20
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr72741-2.f
@@ -0,0 +1,39 @@ 
+      SUBROUTINE v_1
+!$ACC ROUTINE
+!$ACC ROUTINE ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE GANG ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE SEQ ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE WORKER ! { dg-error "ACC ROUTINE already applied" }
+      END SUBROUTINE v_1
+
+      SUBROUTINE sub_1
+      IMPLICIT NONE
+      EXTERNAL :: g_1
+!$ACC ROUTINE (g_1) GANG
+!$ACC ROUTINE (g_1) VECTOR ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE (g_1) SEQ ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE (g_1) ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE (g_1) ! { dg-error "ACC ROUTINE already applied" }
+
+      CALL v_1
+      CALL g_1
+      CALL ABORT
+      END SUBROUTINE sub_1
+
+      MODULE m_w_1
+      IMPLICIT NONE
+      EXTERNAL :: w_1
+!$ACC ROUTINE (w_1) WORKER
+!$ACC ROUTINE (w_1) ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE (w_1) SEQ ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE (w_1) ! { dg-error "ACC ROUTINE already applied" }
+!$ACC ROUTINE (w_1) VECTOR ! { dg-error "ACC ROUTINE already applied" }
+
+      CONTAINS
+      SUBROUTINE sub_2
+      CALL v_1
+      CALL w_1
+      CALL ABORT
+      END SUBROUTINE sub_2
+      END MODULE m_w_1
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f b/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
new file mode 100644
index 00000000000..d84cdf9d0a8
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
@@ -0,0 +1,16 @@ 
+      SUBROUTINE sub_1
+      IMPLICIT NONE
+!$ACC ROUTINE (ABORT) SEQ VECTOR ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible clauses specifying the level of parallelism" }
+
+      CALL ABORT
+      END SUBROUTINE sub_1
+
+      MODULE m_w_1
+      IMPLICIT NONE
+!$ACC ROUTINE (ABORT) VECTOR GANG ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible clauses specifying the level of parallelism" }
+
+      CONTAINS
+      SUBROUTINE sub_2
+      CALL ABORT
+      END SUBROUTINE sub_2
+      END MODULE m_w_1
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f b/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
new file mode 100644
index 00000000000..e5e3794d1c5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
@@ -0,0 +1,22 @@ 
+! Check for invalid clauses with intrinsic function specified in !$ACC ROUTINE ( NAME ).
+
+      SUBROUTINE sub_1
+      IMPLICIT NONE
+!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible clauses specifying the level of parallelism" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible clauses specifying the level of parallelism" }
+!$ACC ROUTINE (ABORT) VECTOR ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible clauses specifying the level of parallelism" }
+
+      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\\), with incompatible clauses specifying the level of parallelism" }
+!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible clauses specifying the level of parallelism" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible clauses specifying the level of parallelism" }
+
+      CONTAINS
+      SUBROUTINE sub_2
+      CALL ABORT
+      END SUBROUTINE sub_2
+      END MODULE m_w_1
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr72741.f90 b/gcc/testsuite/gfortran.dg/goacc/pr72741.f90
index b295a4fcc59..3fbd94f6f7d 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr72741.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr72741.f90
@@ -1,13 +1,24 @@ 
 SUBROUTINE v_1
   !$ACC ROUTINE VECTOR WORKER ! { dg-error "Multiple loop axes" }
+  !$ACC ROUTINE VECTOR ! { dg-error "ACC ROUTINE already applied" }
+  !$ACC ROUTINE ! { dg-error "ACC ROUTINE already applied" }
+  !$ACC ROUTINE GANG VECTOR ! { dg-error "Multiple loop axes" }
 END SUBROUTINE v_1
 
+SUBROUTINE v_2
+  !$ACC ROUTINE(v_2) VECTOR WORKER ! { dg-error "Multiple loop axes" }
+  !$ACC ROUTINE(v_2) VECTOR ! { dg-error "ACC ROUTINE already applied" }
+  !$ACC ROUTINE(v_2) ! { dg-error "ACC ROUTINE already applied" }
+  !$ACC ROUTINE(v_2) GANG VECTOR ! { dg-error "Multiple loop axes" }
+END SUBROUTINE v_2
+
 SUBROUTINE sub_1
   IMPLICIT NONE
   EXTERNAL :: g_1
   !$ACC ROUTINE (g_1) GANG WORKER ! { dg-error "Multiple loop axes" }
-  !$ACC ROUTINE (ABORT) SEQ VECTOR ! { dg-error "Multiple loop axes" "" { xfail *-*-* } }
-! { dg-bogus "invalid function name abort" "" { xfail *-*-* } .-1 }
+  !$ACC ROUTINE (g_1) GANG ! { dg-error "ACC ROUTINE already applied" }
+  !$ACC ROUTINE (g_1) ! { dg-error "ACC ROUTINE already applied" }
+  !$ACC ROUTINE (g_1) VECTOR GANG ! { dg-error "Multiple loop axes" }
 
   CALL v_1
   CALL g_1
@@ -18,8 +29,9 @@  MODULE m_w_1
   IMPLICIT NONE
   EXTERNAL :: w_1
   !$ACC ROUTINE (w_1) WORKER SEQ ! { dg-error "Multiple loop axes" }
-  !$ACC ROUTINE (ABORT) VECTOR GANG ! { dg-error "Multiple loop axes" "" { xfail *-*-* } }
-! { dg-bogus "invalid function name abort" "" { xfail *-*-* } .-1 }
+  !$ACC ROUTINE (w_1) WORKER ! { dg-error "ACC ROUTINE already applied" }
+  !$ACC ROUTINE (w_1) ! { dg-error "ACC ROUTINE already applied" }
+  !$ACC ROUTINE (w_1) VECTOR WORKER ! { dg-error "Multiple loop axes" }
 
 CONTAINS
   SUBROUTINE sub_2
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
index fc0af7ff7d8..cfe505ecb76 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
@@ -3,6 +3,7 @@ 
 
 program main
   implicit none
+  !$acc routine(abort) seq
 
   print *, "CheCKpOInT"
   !$acc parallel
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
index 75e24509ce9..d81ff1bd9ab 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
+++ b/libgomp/testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f
@@ -6,6 +6,7 @@ 
 
       USE OPENACC
       IMPLICIT NONE
+!$ACC ROUTINE(ABORT) SEQ
 
 !Host.
 
-- 
2.17.1