diff mbox series

[PR72741,PR89433] Repeated use of the Fortran OpenACC 'routine' directive

Message ID 874l8nodj2.fsf@euler.schwinge.homeip.net
State New
Headers show
Series [PR72741,PR89433] Repeated use of the Fortran OpenACC 'routine' directive | expand

Commit Message

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

On Mon, 15 Aug 2016 18:54:49 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
> [...]
> 
> Note that besides for checking for multiple acc routine directives, this
> patch also handles the case where the optional name argument in 'acc
> routine (NAME)' is the name of the current procedure. This was a TODO
> item in gomp4.

> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c

> @@ -1969,6 +1971,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
>          {

I re-worked the code a bit, didn't find this necessary.

>    dims = gfc_oacc_routine_dims (c);
>    if (dims == OACC_FUNCTION_NONE)
>      {
>        gfc_error ("Multiple loop axes specified in !$ACC ROUTINE at %C");
> -      goto cleanup;
> +
> +      /* Don't abort early, because it's important to let the user
> +	 know of any potential duplicate routine directives.  */
> +      seen_error = true;
>      }

Same for this.

> +      bool needs_entry = true;
> +      
> +      /* Scan for any repeated routine directives on 'sym' and report
> +	 an error if necessary.  TODO: Extend this function to scan
> +	 for compatible DEVICE_TYPE dims.  */
> +      for (n = gfc_current_ns->oacc_routine_names; n; n = n->next)
> +	if (n->sym == sym)
> +	  {
> +	    needs_entry = false;
> +	    if (dims != gfc_oacc_routine_dims (n->clauses))
> +	      {
> +		gfc_error ("$!ACC ROUTINE already applied at %C");
> +		goto cleanup;
> +	      }
> +	  }
> +
> +      if (needs_entry)
> +	{
> +	  n = gfc_get_oacc_routine_name ();

This would leave us with a stray non-NULL 'n' in the '!needs_entry' case
(which potentially could confuse later processing?).

> +	  n->next = NULL;
> +
> +	  if (gfc_current_ns->oacc_routine_names != NULL)
> +	    n->next = gfc_current_ns->oacc_routine_names;

That's just 'n->next = gfc_current_ns->oacc_routine_names;'.  ;-)

>    else if (gfc_current_ns->proc_name)
>      {
> +      if (gfc_current_ns->proc_name->attr.oacc_function != OACC_FUNCTION_NONE
> +	  && !seen_error)
> +	{
> +	  gfc_error ("!$ACC ROUTINE already applied at %C");
> +	  goto cleanup;
> +	}

That need not emit an error if the previous is equal to current clause
specifying the level of parallelism.

> --- a/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
> +++ b/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
> @@ -1,17 +1,13 @@
> -! Check for valid clauses with intrinsic function specified in !$ACC ROUTINE ( NAME ).
> -
>        SUBROUTINE sub_1
>        IMPLICIT NONE
> -!$ACC ROUTINE (ABORT)
> -!$ACC ROUTINE (ABORT) SEQ
> +!$ACC ROUTINE (ABORT) SEQ VECTOR ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible clauses specifying the level of parallelism" }

That changes what this test cases is supposed to be testing.

All that re-worked, and now committed to trunk in r269287 "[PR72741,
PR89433] Repeated use of the Fortran OpenACC 'routine' directive", as
attached.


Grüße
 Thomas

Comments

Thomas Schwinge March 21, 2019, 7:57 p.m. UTC | #1 
Hi!

On Thu, 28 Feb 2019 21:37:21 +0100, I wrote:
> On Mon, 15 Aug 2016 18:54:49 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
> > [...]
> > 
> > Note that besides for checking for multiple acc routine directives, this
> > patch also handles the case where the optional name argument in 'acc
> > routine (NAME)' is the name of the current procedure. This was a TODO
> > item in gomp4.
> 
> > --- a/gcc/fortran/openmp.c
> > +++ b/gcc/fortran/openmp.c
> 
> > @@ -1969,6 +1971,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
> >          {
> 
> I re-worked the code a bit, didn't find this necessary.

Specifically, a very similar check has already been present, comparing to
'sym->name' instead of 'buffer'.  (Not sure, if one is to be preferred
over the other, when/if they would ever be different.  It feels like
instead of these strings, we should be comparing some kind of symbolic
"resolved" handle, "sym".  And, as it should turn out, I have a cleanup
patch for next GCC development stage 1 to clean up that and other stuff
in 'gfc_match_oacc_routine'.)

Anyway, to clarify, I committed to trunk r269856 "[PR72741] The name in a
Fortran OpenACC 'routine' directive refers to the containing subroutine
or function", see attached.


Grüße
 Thomas
From 467b1bdb6c33711416a3ca270ac51b2b99f2f85b Mon Sep 17 00:00:00 2001
From: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 21 Mar 2019 19:54:51 +0000
Subject: [PATCH] [PR72741] The name in a Fortran OpenACC 'routine' directive
 refers to the containing subroutine or function

	gcc/fortran/
	PR fortran/72741
	* openmp.c (gfc_match_oacc_routine): Clarify.
	gcc/testsuite/
	PR fortran/72741
	* gfortran.dg/goacc/routine-module-mod-1.f90: Update.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@269856 138bc75d-0d04-0410-961f-82ee72b054a4
---
 gcc/fortran/ChangeLog                                    | 3 +++
 gcc/fortran/openmp.c                                     | 3 +++
 gcc/testsuite/ChangeLog                                  | 3 +++
 gcc/testsuite/gfortran.dg/goacc/routine-module-mod-1.f90 | 4 ++--
 4 files changed, 11 insertions(+), 2 deletions(-)

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 2afab3920bda..111e3a266e9b 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,8 @@
 2019-03-21  Thomas Schwinge  <thomas@codesourcery.com>
 
+	PR fortran/72741
+	* openmp.c (gfc_match_oacc_routine): Clarify.
+
 	PR fortran/72741
 	* module.c (verify_OACC_ROUTINE_LOP_NONE): New function.
 	(enum ab_attribute): Add AB_OACC_ROUTINE_LOP_GANG,
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 7a06eb58f5cf..1b1a0b4108fd 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2314,6 +2314,9 @@ gfc_match_oacc_routine (void)
 	  if (st)
 	    {
 	      sym = st->n.sym;
+	      /* If the name in a 'routine' directive refers to the containing
+		 subroutine or function, then make sure that we'll later handle
+		 this accordingly.  */
 	      if (gfc_current_ns->proc_name != NULL
 		  && strcmp (sym->name, gfc_current_ns->proc_name->name) == 0)
 	        sym = NULL;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8afdf3e980e9..0c94f6bcacf8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,5 +1,8 @@
 2019-03-21  Thomas Schwinge  <thomas@codesourcery.com>
 
+	PR fortran/72741
+	* gfortran.dg/goacc/routine-module-mod-1.f90: Update.
+
 	PR fortran/72741
 	* gfortran.dg/goacc/routine-module-1.f90: New file.
 	* gfortran.dg/goacc/routine-module-2.f90: Likewise.
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-module-mod-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-module-mod-1.f90
index 3855b8c88596..23c673fe3bd1 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-module-mod-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-module-mod-1.f90
@@ -18,7 +18,7 @@ contains
 
   subroutine s_2
     implicit none
-    !$acc routine seq
+    !$acc routine (s_2) seq
 
     integer :: i
 
@@ -41,7 +41,7 @@ contains
 
   subroutine w_1
     implicit none
-    !$acc routine worker
+    !$acc routine (w_1) worker
 
     integer :: i
diff mbox series

Patch

From 35e99d5d3bd98eb2e2cee5d94ba09b6166dbeab2 Mon Sep 17 00:00:00 2001
From: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 28 Feb 2019 20:31:36 +0000
Subject: [PATCH 3/3] [PR72741, PR89433] Repeated use of the Fortran OpenACC
 'routine' directive

	gcc/fortran/
	PR fortran/72741
	PR fortran/89433
	* openmp.c (gfc_match_oacc_routine): Handle repeated use of the
	Fortran OpenACC 'routine' directive.
	gcc/testsuite/
	PR fortran/72741
	PR fortran/89433
	* gfortran.dg/goacc/routine-multiple-directives-1.f90: New file.
	* gfortran.dg/goacc/routine-multiple-directives-2.f90: Likewise.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@269287 138bc75d-0d04-0410-961f-82ee72b054a4
---
 gcc/fortran/ChangeLog                         |  5 ++
 gcc/fortran/openmp.c                          | 43 ++++++++--
 gcc/testsuite/ChangeLog                       |  5 ++
 .../goacc/routine-multiple-directives-1.f90   | 58 +++++++++++++
 .../goacc/routine-multiple-directives-2.f90   | 82 +++++++++++++++++++
 5 files changed, 185 insertions(+), 8 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-1.f90
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-2.f90

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 1c8f71252980..6adb90aa4c01 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,6 +1,11 @@ 
 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): Handle repeated use of the
+	Fortran OpenACC 'routine' directive.
+
 	PR fortran/72741
 	* gfortran.h (enum oacc_routine_lop): Add OACC_ROUTINE_LOP_ERROR.
 	* openmp.c (gfc_oacc_routine_lop, gfc_match_oacc_routine): Use it.
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 50b91f2150ab..7a06eb58f5cf 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2374,17 +2374,44 @@  gfc_match_oacc_routine (void)
     }
   else if (sym != NULL)
     {
-      n = gfc_get_oacc_routine_name ();
-      n->sym = sym;
-      n->clauses = NULL;
-      n->next = NULL;
-      if (gfc_current_ns->oacc_routine_names != NULL)
-	n->next = gfc_current_ns->oacc_routine_names;
-
-      gfc_current_ns->oacc_routine_names = n;
+      bool add = true;
+
+      /* For a repeated OpenACC 'routine' directive, diagnose if it doesn't
+	 match the first one.  */
+      for (gfc_oacc_routine_name *n_p = gfc_current_ns->oacc_routine_names;
+	   n_p;
+	   n_p = n_p->next)
+	if (n_p->sym == sym)
+	  {
+	    add = false;
+	    if (lop != gfc_oacc_routine_lop (n_p->clauses))
+	      {
+		gfc_error ("!$ACC ROUTINE already applied at %C");
+		goto cleanup;
+	      }
+	  }
+
+      if (add)
+	{
+	  n = gfc_get_oacc_routine_name ();
+	  n->sym = sym;
+	  n->clauses = c;
+	  n->next = gfc_current_ns->oacc_routine_names;
+	  gfc_current_ns->oacc_routine_names = n;
+	}
     }
   else if (gfc_current_ns->proc_name)
     {
+      /* For a repeated OpenACC 'routine' directive, diagnose if it doesn't
+	 match the first one.  */
+      oacc_routine_lop lop_p = gfc_current_ns->proc_name->attr.oacc_routine_lop;
+      if (lop_p != OACC_ROUTINE_LOP_NONE
+	  && lop != lop_p)
+	{
+	  gfc_error ("!$ACC ROUTINE already applied at %C");
+	  goto cleanup;
+	}
+
       if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
 				       gfc_current_ns->proc_name->name,
 				       &old_loc))
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 9f4c598951c3..8a36b1f802e1 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,6 +1,11 @@ 
 2019-02-28  Thomas Schwinge  <thomas@codesourcery.com>
 	    Cesar Philippidis  <cesar@codesourcery.com>
 
+	PR fortran/72741
+	PR fortran/89433
+	* gfortran.dg/goacc/routine-multiple-directives-1.f90: New file.
+	* gfortran.dg/goacc/routine-multiple-directives-2.f90: Likewise.
+
 	PR fortran/72741
 	* gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90: New file.
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-1.f90
new file mode 100644
index 000000000000..6e12ee92155c
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-1.f90
@@ -0,0 +1,58 @@ 
+! Check for valid cases of multiple OpenACC 'routine' directives.
+
+      SUBROUTINE s_1
+!$ACC ROUTINE(s_1)
+!$ACC ROUTINE(s_1) SEQ
+!$ACC ROUTINE SEQ
+      END SUBROUTINE s_1
+
+      SUBROUTINE s_2
+!$ACC ROUTINE
+!$ACC ROUTINE SEQ
+!$ACC ROUTINE(s_2)
+      END SUBROUTINE s_2
+
+      SUBROUTINE v_1
+!$ACC ROUTINE VECTOR
+!$ACC ROUTINE VECTOR
+!$ACC ROUTINE(v_1) VECTOR
+!$ACC ROUTINE VECTOR
+      END SUBROUTINE v_1
+
+      SUBROUTINE v_2
+!$ACC ROUTINE(v_2) VECTOR
+!$ACC ROUTINE VECTOR
+!$ACC ROUTINE(v_2) VECTOR
+      END SUBROUTINE v_2
+
+      SUBROUTINE sub_1
+      IMPLICIT NONE
+      EXTERNAL :: g_1
+!$ACC ROUTINE (g_1) GANG
+!$ACC ROUTINE (g_1) GANG
+!$ACC ROUTINE (g_1) GANG
+
+      CALL s_1
+      CALL s_2
+      CALL v_1
+      CALL v_2
+      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) WORKER
+
+      CONTAINS
+      SUBROUTINE sub_2
+      CALL s_1
+      CALL s_2
+      CALL v_1
+      CALL v_2
+      CALL w_1
+      CALL ABORT
+      END SUBROUTINE sub_2
+      END MODULE m_w_1
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-2.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-2.f90
new file mode 100644
index 000000000000..54365ae3f4eb
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-directives-2.f90
@@ -0,0 +1,82 @@ 
+! Check for invalid (and some valid) cases of multiple OpenACC 'routine'
+! directives.
+
+      SUBROUTINE s_1
+!$ACC ROUTINE VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE(s_1)
+!$ACC ROUTINE GANG ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE(s_1) SEQ
+!$ACC ROUTINE
+!$ACC ROUTINE(s_1) WORKER ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+      END SUBROUTINE s_1
+
+      SUBROUTINE s_2
+!$ACC ROUTINE(s_2) VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE
+!$ACC ROUTINE(s_2) GANG ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE SEQ
+!$ACC ROUTINE(s_2)
+!$ACC ROUTINE WORKER ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE(s_2) GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+      END SUBROUTINE s_2
+
+      SUBROUTINE v_1
+!$ACC ROUTINE VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE VECTOR
+!$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(v_1) VECTOR
+!$ACC ROUTINE WORKER ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+      END SUBROUTINE v_1
+
+      SUBROUTINE v_2
+!$ACC ROUTINE(v_2) VECTOR
+!$ACC ROUTINE(v_2) VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE(v_2) ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE VECTOR
+!$ACC ROUTINE(v_2) GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+      END SUBROUTINE v_2
+
+      SUBROUTINE sub_1
+      IMPLICIT NONE
+      EXTERNAL :: g_1
+!$ACC ROUTINE (g_1) GANG
+!$ACC ROUTINE (g_1) GANG WORKER ! { dg-error "Multiple loop axes specified for routine" }
+!$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) GANG
+!$ACC ROUTINE (g_1) ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+
+      CALL s_1
+      CALL s_2
+      CALL v_1
+      CALL v_2
+      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) WORKER SEQ ! { dg-error "Multiple loop axes specified for routine" }
+!$ACC ROUTINE (w_1) ! { dg-error "\\!\\\$ACC ROUTINE already applied" }
+!$ACC ROUTINE (w_1) WORKER
+!$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 s_1
+      CALL s_2
+      CALL v_1
+      CALL v_2
+      CALL w_1
+      CALL ABORT
+      END SUBROUTINE sub_2
+      END MODULE m_w_1
-- 
2.17.1