diff mbox

[PR,fortran/72741] Handle intrinsic functions specified in !$ACC ROUTINE ( NAME )

Message ID 87y442ge2w.fsf@hertz.schwinge.homeip.net
State New
Headers show

Commit Message

Thomas Schwinge Aug. 12, 2016, 4:13 p.m. UTC 
Hi!

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 )
    
    	gcc/fortran/
    	* openmp.c (gfc_match_oacc_routine): Handle intrinsic functions.
    	gcc/testsuite/
    	* gfortran.dg/goacc/pr72741-intrinsic-1.f: New file.
    	* gfortran.dg/goacc/pr72741-intrinsic-2.f: Likewise.
---
 gcc/fortran/openmp.c                               |   26 ++++++++++++++++----
 .../gfortran.dg/goacc/pr72741-intrinsic-1.f        |   20 +++++++++++++++
 .../gfortran.dg/goacc/pr72741-intrinsic-2.f        |   22 +++++++++++++++++
 3 files changed, 63 insertions(+), 5 deletions(-)



Grüße
 Thomas
diff mbox

Patch

diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 9fff994..dc8197e 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1748,8 +1748,9 @@  match
 gfc_match_oacc_routine (void)
 {
   locus old_loc;
+  match m;
+  gfc_intrinsic_sym *isym = NULL;
   gfc_symbol *sym = NULL;
-  match m;
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
 
@@ -1769,12 +1770,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;
@@ -1782,7 +1785,7 @@  gfc_match_oacc_routine (void)
 	        sym = NULL;
 	    }
 
-	  if (st == NULL
+	  if ((isym == NULL && st == NULL)
 	      || (sym
 		  && !sym->attr.external
 		  && !sym->attr.function
@@ -1816,7 +1819,18 @@  gfc_match_oacc_routine (void)
 	  != MATCH_YES))
     return MATCH_ERROR;
 
-  if (sym != NULL)
+  if (isym != NULL)
+    {
+      if (c && (c->gang || c->worker || c->vector))
+	{
+	  gfc_error ("Intrinsic function specified in !$ACC ROUTINE ( NAME )"
+		     " at %C, with incompatible GANG, WORKER, or VECTOR clause");
+	  goto cleanup;
+	}
+      /* The intrinsic symbol has been marked with a SEQ, or with no clause at
+	 all, which is OK.  */
+    }
+  else if (sym != NULL)
     {
       n = gfc_get_oacc_routine_name ();
       n->sym = sym;
@@ -1836,6 +1850,8 @@  gfc_match_oacc_routine (void)
       gfc_current_ns->proc_name->attr.oacc_function
 	= gfc_oacc_routine_dims (c) + 1;
     }
+  else
+    gcc_unreachable ();
 
   if (n)
     n->clauses = c;
diff --git gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
new file mode 100644
index 0000000..4bff3e3
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
@@ -0,0 +1,20 @@ 
+! Check for valid clauses with intrinsic function specified in !$ACC ROUTINE ( NAME ).
+
+      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 gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
new file mode 100644
index 0000000..fed8e76
--- /dev/null
+++ 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 function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+!$ACC ROUTINE (ABORT) VECTOR ! { dg-error "Intrinsic function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), 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 function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+
+      CONTAINS
+      SUBROUTINE sub_2
+      CALL ABORT
+      END SUBROUTINE sub_2
+      END MODULE m_w_1


Already committed to gomp-4_0-branch in r239422:

commit 490d6fe982666a873ed30d1b2a011090980324e4
Author: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date:   Fri Aug 12 16:12:33 2016 +0000

    [PR fortran/72741] Check clauses with intrinsic function specified in !$ACC ROUTINE ( NAME )
    
    	gcc/fortran/
    	* openmp.c (gfc_match_oacc_routine): Check clauses of intrinsic
    	functions.
    	gcc/testsuite/
    	* gfortran.dg/goacc/pr72741-intrinsic-1.f: New file.
    	* gfortran.dg/goacc/pr72741-intrinsic-2.f: Likewise.
    
    git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gomp-4_0-branch@239422 138bc75d-0d04-0410-961f-82ee72b054a4
---
 gcc/fortran/ChangeLog.gomp                         |    7 ++++++
 gcc/fortran/openmp.c                               |   25 +++++++++++++-------
 gcc/testsuite/ChangeLog.gomp                       |    7 ++++++
 .../gfortran.dg/goacc/pr72741-intrinsic-1.f        |   20 ++++++++++++++++
 .../gfortran.dg/goacc/pr72741-intrinsic-2.f        |   22 +++++++++++++++++
 5 files changed, 73 insertions(+), 8 deletions(-)

diff --git gcc/fortran/ChangeLog.gomp gcc/fortran/ChangeLog.gomp
index 8744607..8b4ffc9 100644
--- gcc/fortran/ChangeLog.gomp
+++ gcc/fortran/ChangeLog.gomp
@@ -1,3 +1,10 @@ 
+2016-08-12  Cesar Philippidis  <cesar@codesourcery.com>
+	    Thomas Schwinge  <thomas@codesourcery.com>
+
+	PR fortran/72741
+	* openmp.c (gfc_match_oacc_routine): Check clauses of intrinsic
+	functions.
+
 2016-07-29  Chung-Lin Tang  <cltang@codesourcery.com>
 
 	PR fortran/70598
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index e463df7..80f46c0 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1919,11 +1919,11 @@  match
 gfc_match_oacc_routine (void)
 {
   locus old_loc;
+  match m;
+  gfc_intrinsic_sym *isym = NULL;
   gfc_symbol *sym = NULL;
-  match m;
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
-  gfc_intrinsic_sym *isym = NULL;
   oacc_function dims = OACC_FUNCTION_NONE;
 
   old_loc = gfc_current_locus;
@@ -1957,7 +1957,7 @@  gfc_match_oacc_routine (void)
 	        sym = NULL;
 	    }
 
-	  if ((st == NULL && isym == NULL)
+	  if ((isym == NULL && st == NULL)
 	      || (sym
 		  && !sym->attr.external
 		  && !sym->attr.function
@@ -1996,14 +1996,21 @@  gfc_match_oacc_routine (void)
   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");
+      goto cleanup;
     }
 
   if (isym != NULL)
-    /* There is nothing to do for intrinsic procedures.  */
-    ;
+    {
+      if (c && (c->gang || c->worker || c->vector))
+	{
+	  gfc_error ("Intrinsic function specified in !$ACC ROUTINE ( NAME )"
+		     " at %C, with incompatible GANG, WORKER, or VECTOR clause");
+	  goto cleanup;
+	}
+      /* The intrinsic symbol has been marked with a SEQ, or with no clause at
+	 all, which is OK.  */
+    }
   else if (sym != NULL)
     {
       n = gfc_get_oacc_routine_name ();
@@ -2025,6 +2032,8 @@  gfc_match_oacc_routine (void)
       gfc_current_ns->proc_name->attr.oacc_function_nohost
 	= c ? c->nohost : false;
     }
+  else
+    gcc_unreachable ();
 
   if (n)
     n->clauses = c;
diff --git gcc/testsuite/ChangeLog.gomp gcc/testsuite/ChangeLog.gomp
index 0b96504..8de44b6 100644
--- gcc/testsuite/ChangeLog.gomp
+++ gcc/testsuite/ChangeLog.gomp
@@ -1,3 +1,10 @@ 
+2016-08-12  Cesar Philippidis  <cesar@codesourcery.com>
+	    Thomas Schwinge  <thomas@codesourcery.com>
+
+	PR fortran/72741
+	* gfortran.dg/goacc/pr72741-intrinsic-1.f: New file.
+	* gfortran.dg/goacc/pr72741-intrinsic-2.f: Likewise.
+
 2016-08-04  Thomas Schwinge  <thomas@codesourcery.com>
 
 	* g++.dg/goacc/routine-2.C: Update.
diff --git gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
new file mode 100644
index 0000000..4bff3e3
--- /dev/null
+++ gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
@@ -0,0 +1,20 @@ 
+! Check for valid clauses with intrinsic function specified in !$ACC ROUTINE ( NAME ).
+
+      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 gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
new file mode 100644
index 0000000..fed8e76
--- /dev/null
+++ 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 function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+!$ACC ROUTINE (ABORT) VECTOR ! { dg-error "Intrinsic function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), 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 function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+!$ACC ROUTINE (ABORT) WORKER ! { dg-error "Intrinsic function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+!$ACC ROUTINE (ABORT) GANG ! { dg-error "Intrinsic function specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible GANG, WORKER, or VECTOR clause" }
+
+      CONTAINS
+      SUBROUTINE sub_2
+      CALL ABORT
+      END SUBROUTINE sub_2
+      END MODULE m_w_1