public inbox for fortran@gcc.gnu.org
 help / color / mirror / Atom feed
* [PATCH] OpenACC routines in fortran modules
@ 2016-07-01 20:41   ` Cesar Philippidis
  2016-07-28  9:55     ` Tobias Burnus
  2016-08-11 15:19     ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling (was: [PATCH] OpenACC routines in fortran modules) Thomas Schwinge
  0 siblings, 2 replies; 15+ messages in thread
From: Cesar Philippidis @ 2016-07-01 20:41 UTC (permalink / raw)
  To: gcc-patches, Fortran List, Jakub Jelinek

[-- Attachment #1: Type: text/plain, Size: 987 bytes --]

It turns out that the acc routine parallelism isn't being recorded in
fortran .mod files. This is a problem because then the ME can't validate
if a routine has compatible parallelism with the call site. This patch
does two things:

 1. Encode gang, worker, vector and seq level parallelism in module
    files. This introduces a new oacc_function enum, which I ended
    up using to record the parallelism of standalone acc routines too.

 2. Extends gfc_match_oacc_routine to add acc routine directive support
    for intrinsic procedures such as abort.

Is this patch OK for trunk? I included support for intrinsic procedures
because it was necessary with my previous patch which treated all calls
to non-acc routines from within an OpenACC offloaded region as errors.
Now that it has been determined that those patches should be link time
errors, we technically don't need to add acc routine support for
intrinsic procedures. So I can drop that part of the patch if necessary.

Cesar

[-- Attachment #2: fortran-module-routines.diff --]
[-- Type: text/x-patch, Size: 13869 bytes --]

2016-07-01  Cesar Philippidis  <cesar@codesourcery.com>

	gcc/fortran/
	* gfortran.h (enum oacc_function): Define.
	(oacc_function_type): Declare.
	(symbol_attribute): Change the type of oacc_function from unsigned
	to an ENUM_BITFIELD.
	* module.c (oacc_function): New DECL_MIO_NAME.
	(mio_symbol_attribute): Set the oacc_function attribute.
	* openmp.c (gfc_oacc_routine_dims): Change the return type from
	int to oacc_function.
	(gfc_match_oacc_routine): Handle intrinsic procedures.
	* symbol.c (oacc_function_types): Define.
	* trans-decl.c (add_attributes_to_decl): Update to handle the
	retyped oacc_function attribute.

	gcc/testsuite/
	* gfortran.dg/goacc/fixed-1.f: Add test coverage.
	* gfortran.dg/goacc/routine-7.f90: New test.

	libgomp/
	* testsuite/libgomp.oacc-fortran/abort-1.f90: Test acc routine
	on intrinsic abort.
	* testsuite/libgomp.oacc-fortran/acc_on_device-1-2.f: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-7.f90: Likewise.

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 0bb71cb..fac94ca 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -303,6 +303,15 @@ enum save_state
 { SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
 };
 
+/* Flags to keep track of ACC routine states.  */
+enum oacc_function
+{ OACC_FUNCTION_NONE = 0,
+  OACC_FUNCTION_SEQ,
+  OACC_FUNCTION_GANG,
+  OACC_FUNCTION_WORKER,
+  OACC_FUNCTION_VECTOR
+};
+
 /* Strings for all symbol attributes.  We use these for dumping the
    parse tree, in error messages, and also when reading and writing
    modules.  In symbol.c.  */
@@ -312,6 +321,7 @@ extern const mstring intents[];
 extern const mstring access_types[];
 extern const mstring ifsrc_types[];
 extern const mstring save_status[];
+extern const mstring oacc_function_types[];
 
 /* Enumeration of all the generic intrinsic functions.  Used by the
    backend for identification of a function.  */
@@ -862,7 +872,7 @@ typedef struct
   unsigned oacc_declare_link:1;
 
   /* This is an OpenACC acclerator function at level N - 1  */
-  unsigned oacc_function:3;
+  ENUM_BITFIELD (oacc_function) oacc_function:3;
 
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 4d664f0..267858f 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2095,6 +2095,7 @@ DECL_MIO_NAME (procedure_type)
 DECL_MIO_NAME (ref_type)
 DECL_MIO_NAME (sym_flavor)
 DECL_MIO_NAME (sym_intent)
+DECL_MIO_NAME (oacc_function)
 #undef DECL_MIO_NAME
 
 /* Symbol attributes are stored in list with the first three elements
@@ -2116,6 +2117,8 @@ mio_symbol_attribute (symbol_attribute *attr)
   attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures);
   attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types);
   attr->save = MIO_NAME (save_state) (attr->save, save_status);
+  attr->oacc_function = MIO_NAME (oacc_function) (attr->oacc_function,
+						  oacc_function_types);
 
   ext_attr = attr->ext_attr;
   mio_integer ((int *) &ext_attr);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 865e0d9..10b880c 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1714,21 +1714,31 @@ gfc_match_oacc_cache (void)
 
 /* Determine the loop level for a routine.   */
 
-static int
+static oacc_function
 gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
 {
   int level = -1;
+  oacc_function ret = OACC_FUNCTION_SEQ;
 
   if (clauses)
     {
       unsigned mask = 0;
 
       if (clauses->gang)
-	level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+	{
+	  level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+	  ret = OACC_FUNCTION_GANG;
+	}
       if (clauses->worker)
-	level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+	{
+	  level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+	  ret = OACC_FUNCTION_WORKER;
+	}
       if (clauses->vector)
-	level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+	{
+	  level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+	  ret = OACC_FUNCTION_VECTOR;
+	}
       if (clauses->seq)
 	level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
 
@@ -1736,10 +1746,7 @@ gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
 	gfc_error ("Multiple loop axes specified for routine");
     }
 
-  if (level < 0)
-    level = GOMP_DIM_MAX;
-
-  return level;
+  return ret;
 }
 
 match
@@ -1750,6 +1757,7 @@ gfc_match_oacc_routine (void)
   match m;
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
+  gfc_intrinsic_sym *isym = NULL;
 
   old_loc = gfc_current_locus;
 
@@ -1767,12 +1775,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;
@@ -1780,7 +1790,7 @@ gfc_match_oacc_routine (void)
 	        sym = NULL;
 	    }
 
-	  if (st == NULL
+	  if ((st == NULL && isym == NULL)
 	      || (sym
 		  && !sym->attr.external
 		  && !sym->attr.function
@@ -1814,7 +1824,10 @@ gfc_match_oacc_routine (void)
 	  != MATCH_YES))
     return MATCH_ERROR;
 
-  if (sym != NULL)
+  if (isym != NULL)
+    /* There is nothing to do for intrinsic procedures.  */
+    ;
+  else if (sym != NULL)
     {
       n = gfc_get_oacc_routine_name ();
       n->sym = sym;
@@ -1832,7 +1845,7 @@ gfc_match_oacc_routine (void)
 				       &old_loc))
 	goto cleanup;
       gfc_current_ns->proc_name->attr.oacc_function
-	= gfc_oacc_routine_dims (c) + 1;
+	= gfc_oacc_routine_dims (c);
     }
 
   if (n)
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 0ee7dec..b1dd32b 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -87,6 +87,15 @@ const mstring save_status[] =
     minit ("IMPLICIT-SAVE", SAVE_IMPLICIT),
 };
 
+const mstring oacc_function_types[] =
+{
+  minit ("NONE", OACC_FUNCTION_NONE),
+  minit ("OACC_FUNCTION_SEQ", OACC_FUNCTION_SEQ),
+  minit ("OACC_FUNCTION_GANG", OACC_FUNCTION_GANG),
+  minit ("OACC_FUNCTION_WORKER", OACC_FUNCTION_WORKER),
+  minit ("OACC_FUNCTION_VECTOR", OACC_FUNCTION_VECTOR)
+};
+
 /* This is to make sure the backend generates setup code in the correct
    order.  */
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 2f5e434..04f9860 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1327,11 +1327,26 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
     list = tree_cons (get_identifier ("omp declare target"),
 		      NULL_TREE, list);
 
-  if (sym_attr.oacc_function)
+  if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
     {
       tree dims = NULL_TREE;
       int ix;
-      int level = sym_attr.oacc_function - 1;
+      int level = GOMP_DIM_MAX;
+
+      switch (sym_attr.oacc_function)
+	{
+	case OACC_FUNCTION_GANG:
+	  level = GOMP_DIM_GANG;
+	  break;
+	case OACC_FUNCTION_WORKER:
+	  level = GOMP_DIM_WORKER;
+	  break;
+	case OACC_FUNCTION_VECTOR:
+	  level = GOMP_DIM_VECTOR;
+	  break;
+	case OACC_FUNCTION_SEQ:
+	default:;
+	}
 
       for (ix = GOMP_DIM_MAX; ix--;)
 	dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
diff --git a/gcc/testsuite/gfortran.dg/goacc/fixed-1.f b/gcc/testsuite/gfortran.dg/goacc/fixed-1.f
index 6a454190..0c0fb98 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/routine-7.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-7.f90
new file mode 100644
index 0000000..e1e0ab7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-7.f90
@@ -0,0 +1,69 @@
+! Test acc routines inside modules.
+
+! { dg-additional-options "-O0" }
+
+module routines
+contains
+  subroutine vector
+    implicit none
+    !$acc routine vector
+  end subroutine vector
+
+  subroutine worker
+    implicit none
+    !$acc routine worker
+  end subroutine worker
+
+  subroutine gang
+    implicit none
+    !$acc routine gang
+  end subroutine gang
+
+  subroutine seq
+    implicit none
+    !$acc routine seq
+  end subroutine seq
+end module routines
+
+program main
+  use routines
+  implicit none
+
+  integer :: i
+
+  !$acc parallel loop gang
+  do i = 1, 10
+     call gang ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call worker
+     call vector
+     call seq
+  end do
+  !$acc end parallel loop
+
+  !$acc parallel loop worker
+  do i = 1, 10
+     call gang ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call worker ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call vector
+     call seq
+  end do
+  !$acc end parallel loop
+
+  !$acc parallel loop vector
+  do i = 1, 10
+     call gang ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call worker ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call vector ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call seq
+  end do
+  !$acc end parallel loop
+
+  !$acc parallel loop seq
+  do i = 1, 10
+     call gang
+     call worker
+     call vector
+     call seq
+  end do
+  !$acc end parallel loop
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
index b38303d..48ebc38 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
@@ -1,5 +1,6 @@
 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 a19045b..cbd1dd9 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.
 
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
index 200188e..07cd6d9 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
@@ -1,121 +1,95 @@
+! Test acc routines inside modules.
 
 ! { dg-do run }
-! { dg-additional-options "-cpp" }
 
-#define M 8
-#define N 32
+module routines
+  integer, parameter :: N = 32
 
-program main
-  integer :: i
-  integer :: a(N)
-  integer :: b(M * N)
-
-  do i = 1, N
-    a(i) = 0
-  end do
+contains
+  subroutine vector (a)
+    implicit none
+    !$acc routine vector
+    integer, intent (inout) :: a(N)
+    integer :: i
 
-  !$acc parallel copy (a)
-  !$acc loop seq
+    !$acc loop vector
     do i = 1, N
-      call seq (a)
+       a(i) = 1
     end do
-  !$acc end parallel
+  end subroutine vector
 
-  do i = 1, N
-    if (a(i) .ne.N) call abort
-  end do
+  subroutine worker (a)
+    implicit none
+    !$acc routine worker
+    integer, intent (inout) :: a(N)
+    integer :: i
 
-  !$acc parallel copy (a)
-  !$acc loop seq
-    do i = 1, N 
-      call gang (a)
+    !$acc loop worker
+    do i = 1, N
+       a(i) = 2
     end do
-  !$acc end parallel
-
-  do i = 1, N
-    if (a(i) .ne. (N + (N * (-1 * i)))) call abort
-  end do
+  end subroutine worker
 
-  do i = 1, N
-    b(i) = i
-  end do
+  subroutine gang (a)
+    implicit none
+    !$acc routine gang
+    integer, intent (inout) :: a(N)
+    integer :: i
 
-  !$acc parallel copy (b)
-  !$acc loop seq
+    !$acc loop gang
     do i = 1, N
-      call worker (b)
+       a(i) = 3
     end do
-  !$acc end parallel
+  end subroutine gang
 
-  do i = 1, N
-    if (b(i) .ne. N + i) call abort
-  end do
+  subroutine seq (a)
+    implicit none
+    !$acc routine seq
+    integer, intent (inout) :: a(N)
+    integer :: i
 
-  do i = 1, N
-    a(i) = i
-  end do
-
-  !$acc parallel copy (a)
-  !$acc loop seq
     do i = 1, N
-      call vector (a)
+       a(i) = 4
     end do
-  !$acc end parallel
-
-  do i = 1, N
-    if (a(i) .ne. 0) call abort
-  end do
+  end subroutine seq
+end module routines
 
-contains
+program main
+  use routines
+  implicit none
 
-subroutine vector (a)
-  !$acc routine vector
-  integer, intent (inout) :: a(N)
   integer :: i
+  integer :: a(N)
+
+  !$acc parallel
+  call seq (a)
+  !$acc end parallel
 
-  !$acc loop vector
   do i = 1, N
-    a(i) = a(i) - a(i) 
+    if (a(i) .ne. 4) call abort
   end do
 
-end subroutine vector
-
-subroutine worker (b)
-  !$acc routine worker
-  integer, intent (inout) :: b(M*N)
-  integer :: i, j
+  !$acc parallel
+  call gang (a)
+  !$acc end parallel
 
-  !$acc loop worker
   do i = 1, N
-  !$acc loop vector
-    do j = 1, M
-      b(j + ((i - 1) * M)) = b(j + ((i - 1) * M)) + 1
-    end do
+    if (a(i) .ne. 3) call abort
   end do
 
-end subroutine worker
-
-subroutine gang (a)
-  !$acc routine gang
-  integer, intent (inout) :: a(N)
-  integer :: i
+  !$acc parallel
+  call worker (a)
+  !$acc end parallel
 
-  !$acc loop gang
   do i = 1, N
-    a(i) = a(i) - i 
+    if (a(i) .ne. 2) call abort
   end do
 
-end subroutine gang
-
-subroutine seq (a)
-  !$acc routine seq
-  integer, intent (inout) :: a(M)
-  integer :: i
+  !$acc parallel
+  call vector (a)
+  !$acc end parallel
 
   do i = 1, N
-    a(i) = a(i) + 1
+    if (a(i) .ne. 1) call abort
   end do
-
-end subroutine seq
-
 end program main

^ permalink raw reply	[flat|nested] 15+ messages in thread

* [gomp4] encode acc routine clauses inside fortran module files
@ 2016-07-28  2:54 Cesar Philippidis
  2016-07-29  4:21 ` [gomp4] Fix PR72741 Cesar Philippidis
  0 siblings, 1 reply; 15+ messages in thread
From: Cesar Philippidis @ 2016-07-28  2:54 UTC (permalink / raw)
  To: gcc-patches, Fortran List

[-- Attachment #1: Type: text/plain, Size: 704 bytes --]

This patch contains the following changes:

* Enhance support for OpenACC routine clauses inside fortran module
  files. Also, allow the routine directive to be applied to intrinsic
  procedures. The trunk patch can be found here:

  https://gcc.gnu.org/ml/gcc-patches/2016-07/msg00063.html

* Change an LTO wrapper assert failure to an error when it detects
  missing symbols. This situation can arise in offloading code, e.g.
  when the user forgets to declare a global variable as offloadable.
  The trunk patch can be found here. Part of this patch was already
  present in gomp-4_0-branch.

  https://gcc.gnu.org/ml/gcc-patches/2016-07/msg00043.html

I've applied this patch gomp-4_0-branch.

Cesar

[-- Attachment #2: gomp4-fortran-routines.diff --]
[-- Type: text/x-patch, Size: 11282 bytes --]

2016-07-27  Cesar Philippidis  <cesar@codesourcery.com>

	gcc/fortran/
	* gfortran.h (enum oacc_function): Define.
	(oacc_function_type): Declare.
	(symbol_attribute): Change the type of oacc_function from unsigned
	to an ENUM_BITFIELD.
	* module.c (oacc_function): New DECL_MIO_NAME.
	(mio_symbol_attribute): Set the oacc_function attribute.
	* openmp.c (gfc_oacc_routine_dims): Change the return type from
	int to oacc_function.
	(gfc_match_oacc_routine): Handle intrinsic procedures.
	* symbol.c (oacc_function_types): Define.
	* trans-decl.c (add_attributes_to_decl): Update to handle the
	retyped oacc_function attribute.

	gcc/
	* lto-cgraph.c (input_overwrite_node): Change the assertion to an
	error for missing symbols.

	gcc/testsuite/
	* gfortran.dg/goacc/fixed-1.f: Add test coverage.
	* gfortran.dg/goacc/routine-7.f90: New test.

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

diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2327b13..7784e93 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -292,6 +292,15 @@ enum save_state
 { SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
 };
 
+/* Flags to keep track of ACC routine states.  */
+enum oacc_function
+{ OACC_FUNCTION_NONE = 0,
+  OACC_FUNCTION_SEQ,
+  OACC_FUNCTION_GANG,
+  OACC_FUNCTION_WORKER,
+  OACC_FUNCTION_VECTOR
+};
+
 /* Strings for all symbol attributes.  We use these for dumping the
    parse tree, in error messages, and also when reading and writing
    modules.  In symbol.c.  */
@@ -301,6 +310,7 @@ extern const mstring intents[];
 extern const mstring access_types[];
 extern const mstring ifsrc_types[];
 extern const mstring save_status[];
+extern const mstring oacc_function_types[];
 
 /* Enumeration of all the generic intrinsic functions.  Used by the
    backend for identification of a function.  */
@@ -851,7 +861,7 @@ typedef struct
   unsigned oacc_declare_link:1;
 
   /* This is an OpenACC acclerator function at level N - 1  */
-  unsigned oacc_function:3;
+  ENUM_BITFIELD (oacc_function) oacc_function:3;
   unsigned oacc_function_nohost:1;
 
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c
index 32ee526..6ee81c3 100644
--- a/gcc/fortran/module.c
+++ b/gcc/fortran/module.c
@@ -2095,6 +2095,7 @@ DECL_MIO_NAME (procedure_type)
 DECL_MIO_NAME (ref_type)
 DECL_MIO_NAME (sym_flavor)
 DECL_MIO_NAME (sym_intent)
+DECL_MIO_NAME (oacc_function)
 #undef DECL_MIO_NAME
 
 /* Symbol attributes are stored in list with the first three elements
@@ -2116,6 +2117,8 @@ mio_symbol_attribute (symbol_attribute *attr)
   attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures);
   attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types);
   attr->save = MIO_NAME (save_state) (attr->save, save_status);
+  attr->oacc_function = MIO_NAME (oacc_function) (attr->oacc_function,
+						  oacc_function_types);
 
   ext_attr = attr->ext_attr;
   mio_integer ((int *) &ext_attr);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 52c0309..c20a0a3 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1879,21 +1879,31 @@ gfc_match_oacc_cache (void)
 
 /* Determine the loop level for a routine.   */
 
-static int
+static oacc_function
 gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
 {
   int level = -1;
+  oacc_function ret = OACC_FUNCTION_SEQ;
 
   if (clauses)
     {
       unsigned mask = 0;
 
       if (clauses->gang)
-	level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+	{
+	  level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
+	  ret = OACC_FUNCTION_GANG;
+	}
       if (clauses->worker)
-	level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+	{
+	  level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
+	  ret = OACC_FUNCTION_WORKER;
+	}
       if (clauses->vector)
-	level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+	{
+	  level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
+	  ret = OACC_FUNCTION_VECTOR;
+	}
       if (clauses->seq)
 	level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
 
@@ -1901,10 +1911,7 @@ gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
 	gfc_error ("Multiple loop axes specified for routine");
     }
 
-  if (level < 0)
-    level = GOMP_DIM_MAX;
-
-  return level;
+  return ret;
 }
 
 match
@@ -1915,6 +1922,7 @@ gfc_match_oacc_routine (void)
   match m;
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
+  gfc_intrinsic_sym *isym = NULL;
 
   old_loc = gfc_current_locus;
 
@@ -1932,12 +1940,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;
@@ -1945,7 +1955,7 @@ gfc_match_oacc_routine (void)
 	        sym = NULL;
 	    }
 
-	  if (st == NULL
+	  if ((st == NULL && isym == NULL)
 	      || (sym
 		  && !sym->attr.external
 		  && !sym->attr.function
@@ -1981,7 +1991,10 @@ gfc_match_oacc_routine (void)
 	  != MATCH_YES))
     return MATCH_ERROR;
 
-  if (sym != NULL)
+  if (isym != NULL)
+    /* There is nothing to do for intrinsic procedures.  */
+    ;
+  else if (sym != NULL)
     {
       n = gfc_get_oacc_routine_name ();
       n->sym = sym;
@@ -1999,7 +2012,7 @@ gfc_match_oacc_routine (void)
 				       &old_loc))
 	goto cleanup;
       gfc_current_ns->proc_name->attr.oacc_function
-	= gfc_oacc_routine_dims (c) + 1;
+	= gfc_oacc_routine_dims (c);
       gfc_current_ns->proc_name->attr.oacc_function_nohost
 	= c ? c->nohost : false;
     }
diff --git a/gcc/fortran/symbol.c b/gcc/fortran/symbol.c
index 8efd12c..3ef3276 100644
--- a/gcc/fortran/symbol.c
+++ b/gcc/fortran/symbol.c
@@ -86,6 +86,15 @@ const mstring save_status[] =
     minit ("IMPLICIT-SAVE", SAVE_IMPLICIT),
 };
 
+const mstring oacc_function_types[] =
+{
+  minit ("NONE", OACC_FUNCTION_NONE),
+  minit ("OACC_FUNCTION_SEQ", OACC_FUNCTION_SEQ),
+  minit ("OACC_FUNCTION_GANG", OACC_FUNCTION_GANG),
+  minit ("OACC_FUNCTION_WORKER", OACC_FUNCTION_WORKER),
+  minit ("OACC_FUNCTION_VECTOR", OACC_FUNCTION_VECTOR)
+};
+
 /* This is to make sure the backend generates setup code in the correct
    order.  */
 
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 1feee82..5271268 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1327,11 +1327,26 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
 		      NULL_TREE, list);
 #endif
 
-  if (sym_attr.oacc_function)
+  if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
     {
       tree dims = NULL_TREE;
       int ix;
-      int level = sym_attr.oacc_function - 1;
+      int level = GOMP_DIM_MAX;
+
+      switch (sym_attr.oacc_function)
+	{
+	case OACC_FUNCTION_GANG:
+	  level = GOMP_DIM_GANG;
+	  break;
+	case OACC_FUNCTION_WORKER:
+	  level = GOMP_DIM_WORKER;
+	  break;
+	case OACC_FUNCTION_VECTOR:
+	  level = GOMP_DIM_VECTOR;
+	  break;
+	case OACC_FUNCTION_SEQ:
+	default:;
+	}
 
       for (ix = GOMP_DIM_MAX; ix--;)
 	dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
diff --git a/gcc/lto-cgraph.c b/gcc/lto-cgraph.c
index 60e73d6..857ce4d 100644
--- a/gcc/lto-cgraph.c
+++ b/gcc/lto-cgraph.c
@@ -1201,15 +1201,8 @@ input_overwrite_node (struct lto_file_decl_data *file_data,
 
   int success = flag_ltrans || (!node->in_other_partition
 				&& !node->used_from_other_partition);
-
   if (!success)
-    {
-      gcc_assert (flag_openacc);
-      if (TREE_CODE (node->decl) == FUNCTION_DECL)
-	error ("missing OpenACC %<routine%> function %qD", node->decl);
-      else
-	error ("missing OpenACC %<declare%> variable %qD", node->decl);
-    }
+    error ("Missing %<%s%>", node->name ());
 }
 
 /* Return string alias is alias of.  */
diff --git a/gcc/testsuite/gfortran.dg/goacc/fixed-1.f b/gcc/testsuite/gfortran.dg/goacc/fixed-1.f
index 6a454190..0c0fb98 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/routine-7.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-7.f90
new file mode 100644
index 0000000..c48269b
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-7.f90
@@ -0,0 +1,70 @@
+! Test acc routines inside modules.
+
+! { dg-additional-options "-O0" }
+
+module routines
+  integer a
+contains
+  subroutine vector ! { dg-warning "partitioned but does not contain" }
+    implicit none
+    !$acc routine vector
+  end subroutine vector
+
+  subroutine worker ! { dg-warning "partitioned but does not contain" }
+    implicit none
+    !$acc routine worker
+  end subroutine worker
+
+  subroutine gang ! { dg-warning "partitioned but does not contain" }
+    implicit none
+    !$acc routine gang
+  end subroutine gang
+
+  subroutine seq
+    implicit none
+    !$acc routine seq
+  end subroutine seq
+end module routines
+
+program main
+  use routines
+  implicit none
+
+  integer :: i
+
+  !$acc parallel loop gang
+  do i = 1, 10
+     call gang ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call worker
+     call vector
+     call seq
+  end do
+  !$acc end parallel loop
+
+  !$acc parallel loop worker
+  do i = 1, 10
+     call gang ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call worker ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call vector
+     call seq
+  end do
+  !$acc end parallel loop
+
+  !$acc parallel loop vector
+  do i = 1, 10
+     call gang ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call worker ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call vector ! { dg-error "routine call uses same OpenACC parallelism as containing loop" }
+     call seq
+  end do
+  !$acc end parallel loop
+
+  !$acc parallel loop seq
+  do i = 1, 10
+     call gang
+     call worker
+     call vector
+     call seq
+  end do
+  !$acc end parallel loop
+end program main
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
index b38303d..48ebc38 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/abort-1.f90
@@ -1,5 +1,6 @@
 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 a19045b..cbd1dd9 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.
 

^ permalink raw reply	[flat|nested] 15+ messages in thread

* Re: [PATCH] OpenACC routines in fortran modules
  2016-07-01 20:41   ` [PATCH] OpenACC routines in fortran modules Cesar Philippidis
@ 2016-07-28  9:55     ` Tobias Burnus
  2016-07-28 21:33       ` Cesar Philippidis
  2016-08-11 15:19     ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling (was: [PATCH] OpenACC routines in fortran modules) Thomas Schwinge
  1 sibling, 1 reply; 15+ messages in thread
From: Tobias Burnus @ 2016-07-28  9:55 UTC (permalink / raw)
  To: Cesar Philippidis, gcc-patches, fortran, Jakub Jelinek

Cesar Philippidis wrote:
> It turns out that the acc routine parallelism isn't being recorded in
> fortran .mod files. This is a problem because then the ME can't validate
> if a routine has compatible parallelism with the call site. 

Nothing against saving such information in .mod files. However, I wonder
whether it can happen that one places such an 'acc routine' outside of a
module in one file - and still accesses it from another file. In the simple
non-ACC case, one can have:

!----- one.f90 ----
subroutine foo()
  print *, "abc"
end subroutine foo

!---- two.f90 ---
program example
  call foo()
end program example

where "foo()" is torn in without any information about it (except that it
is a subroutine, does not require an explicit interface, and takes no
arguments).

I don't know whether the ACC spec requires an explicit interface in that
case (i.e. for acc routines); I bet it does - or at least should. In that
case, something like the following would be valid - and should be supported
as well. (I don't know whether it currently is.)

!----- one.f90 ----
subroutine foo()
  !$acc routine gang
  .... ! something
end subroutine foo

!---- two.f90 ---
program example
  INTERFACE
    subroutine foo()
      !$acc routine gang
      ! Nothing here
    end subroutine foo
  END INTERFACE

  call foo()
end program example

Namely, a replication of the declaration of the procedure, including
the "acc routine", in the 'interface'.
(If one concats the two files, I would also expect an error with -fopenacc,
if the "acc routine" doesn't match between "foo" and the "foo" in the
"interface" block.)


Otherwise: Have you checked whether an unmodified gfortran still accepts the
.mod file written by the patched gfortran - and vice versa? Especially if
-fopenacc is not used, backward compatibility of .mod files is a goal.
(Even though we often have to bump the .mod version for major releases.)

Cheers,

Tobias

^ permalink raw reply	[flat|nested] 15+ messages in thread

* Re: [PATCH] OpenACC routines in fortran modules
  2016-07-28  9:55     ` Tobias Burnus
@ 2016-07-28 21:33       ` Cesar Philippidis
  0 siblings, 0 replies; 15+ messages in thread
From: Cesar Philippidis @ 2016-07-28 21:33 UTC (permalink / raw)
  To: Tobias Burnus, gcc-patches, fortran, Jakub Jelinek

On 07/28/2016 02:55 AM, Tobias Burnus wrote:
> Cesar Philippidis wrote:
>> It turns out that the acc routine parallelism isn't being recorded in
>> fortran .mod files. This is a problem because then the ME can't validate
>> if a routine has compatible parallelism with the call site. 
> 
> Nothing against saving such information in .mod files. However, I wonder
> whether it can happen that one places such an 'acc routine' outside of a
> module in one file - and still accesses it from another file. In the simple
> non-ACC case, one can have:
> 
> !----- one.f90 ----
> subroutine foo()
>   print *, "abc"
> end subroutine foo
> 
> !---- two.f90 ---
> program example
>   call foo()
> end program example
> 
> where "foo()" is torn in without any information about it (except that it
> is a subroutine, does not require an explicit interface, and takes no
> arguments).
> 
> I don't know whether the ACC spec requires an explicit interface in that
> case (i.e. for acc routines); I bet it does - or at least should. In that

Jakub and I discussed this issue a while ago. There were two major
problems with treating calls to non-acc routines as errors. 1) What do
we do about intrinsic procedures, and 2) how should builtin and
libc/libm functions get handled? Jakub and I came to the conclusion that
the linker should resolve those issues, hence this patch
<https://gcc.gnu.org/ml/gcc-patches/2016-07/msg00043.html> which teaches
the lto wrapper to error when it encounters missing symbols. From a
compiler standpoint, if the user does something like this

!$acc parallel
...
call foo()
...
!$acc end parallel

and if foo isn't marked as an acc routine, then the compiler will treat
that function as having an implicit 'acc routine seq'.

Note that trunk currently generates an error if the user tries apply an
acc routine directive on an intrinsic routine. This patch teaches
gfortran to accept acc routine directives on those procedures. However,
note that those routines aren't automatically parallelized though, i.e.
they are effectively implemented as 'acc routine seq'.

> case, something like the following would be valid - and should be supported
> as well. (I don't know whether it currently is.)
>
> !----- one.f90 ----
> subroutine foo()
>   !$acc routine gang
>   .... ! something
> end subroutine foo
> 
> !---- two.f90 ---
> program example
>   INTERFACE
>     subroutine foo()
>       !$acc routine gang
>       ! Nothing here
>     end subroutine foo
>   END INTERFACE
> 
>   call foo()
> end program example
> 
> Namely, a replication of the declaration of the procedure, including
> the "acc routine", in the 'interface'.
> (If one concats the two files, I would also expect an error with -fopenacc,
> if the "acc routine" doesn't match between "foo" and the "foo" in the
> "interface" block.)

I tested this case and it works. There is, however, a problem with
mismatched routine clauses. See PR72741 that Thomas filed recently.

> Otherwise: Have you checked whether an unmodified gfortran still accepts the
> .mod file written by the patched gfortran - and vice versa? Especially if
> -fopenacc is not used, backward compatibility of .mod files is a goal.
> (Even though we often have to bump the .mod version for major releases.)

I just tested this situation, and neither backward or forward compatible
isn't preserved. Basically, this patch introduces a mandatory
OACC_FUNCTION_ field inside the module file. Perhaps I should make that
field optional. At least that way we'd maintain backwards compatibility.
Is there something I can do to maintain forward compatibility?

Cesar

^ permalink raw reply	[flat|nested] 15+ messages in thread

* [gomp4] Fix PR72741
@ 2016-07-29  4:21 ` Cesar Philippidis
  2016-07-01 20:41   ` [PATCH] OpenACC routines in fortran modules Cesar Philippidis
  2019-02-28 20:35   ` [PR72741] For all Fortran OpenACC 'routine' directive variants check for multiple clauses specifying the level of parallelism Thomas Schwinge
  0 siblings, 2 replies; 15+ messages in thread
From: Cesar Philippidis @ 2016-07-29  4:21 UTC (permalink / raw)
  To: gcc-patches, Fortran List

[-- Attachment #1: Type: text/plain, Size: 708 bytes --]

Thomas found a bug in the fortran routine parser where errors involving
invalid combinations of gang, worker, vector and seq clauses were
getting suppressed. This patch does two things:

  1) It moves the error handling into gfc_match_oacc_routine. So now
     gfc_oacc_routine_dims returns OACC_FUNCTION_NONE when it detects
     an error. That's fine because it's ok for routines to default to
     OACC_FUNCTION_SEQ.

  2) It makes gfc_match_oacc_routine return a MATCH_ERROR when an error
     has been detected in gfc_oacc_routine_dims.

This bug is also present in trunk, but I'd like to see my other fortran
module patch go in first. In the meantime, I'll commit this patch to
gomp-4_0-branch.

Cesar

[-- Attachment #2: gomp4-pr72741.diff --]
[-- Type: text/x-patch, Size: 3023 bytes --]

2016-07-28  Cesar Philippidis  <cesar@codesourcery.com>

	PR fortran/72741
	gcc/fortran/
	* openmp.c (gfc_oacc_routine_dims): Move gfc_error to
	gfc_match_oacc_routine.  Return OACC_FUNCTION_NONE on error.
	(gfc_match_oacc_routine): Call gfc_oacc_routine_dims for all
	routines directives.  Propagate error as appropriate.

	gcc/testsuite/
	* gfortran.dg/goacc/pr72741.f90: New test.


diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index c20a0a3..3c39836 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1877,7 +1877,8 @@ gfc_match_oacc_cache (void)
   return MATCH_YES;
 }
 
-/* Determine the loop level for a routine.   */
+/* Determine the loop level for a routine.  Returns OACC_FUNCTION_NONE if
+   any error is detected.  */
 
 static oacc_function
 gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
@@ -1908,7 +1909,7 @@ gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
 	level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
 
       if (mask != (mask & -mask))
-	gfc_error ("Multiple loop axes specified for routine");
+	ret = OACC_FUNCTION_NONE;
     }
 
   return ret;
@@ -1923,6 +1924,7 @@ gfc_match_oacc_routine (void)
   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;
 
@@ -1991,6 +1993,14 @@ gfc_match_oacc_routine (void)
 	  != MATCH_YES))
     return MATCH_ERROR;
 
+  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;
+    }
+
   if (isym != NULL)
     /* There is nothing to do for intrinsic procedures.  */
     ;
@@ -2011,8 +2021,7 @@ gfc_match_oacc_routine (void)
 				       gfc_current_ns->proc_name->name,
 				       &old_loc))
 	goto cleanup;
-      gfc_current_ns->proc_name->attr.oacc_function
-	= gfc_oacc_routine_dims (c);
+      gfc_current_ns->proc_name->attr.oacc_function = dims;
       gfc_current_ns->proc_name->attr.oacc_function_nohost
 	= c ? c->nohost : false;
     }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr72741.f90 b/gcc/testsuite/gfortran.dg/goacc/pr72741.f90
new file mode 100644
index 0000000..cf89727
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/pr72741.f90
@@ -0,0 +1,28 @@
+SUBROUTINE v_1
+  !$ACC ROUTINE VECTOR WORKER ! { dg-error "Multiple loop axes" }
+END SUBROUTINE v_1
+
+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" }
+
+  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 SEQ ! { dg-error "Multiple loop axes" }
+  !$ACC ROUTINE (ABORT) VECTOR GANG ! { dg-error "Multiple loop axes" }
+
+CONTAINS
+  SUBROUTINE sub_2
+    CALL v_1
+    CALL w_1
+    CALL ABORT
+  END SUBROUTINE sub_2
+END MODULE m_w_1

^ permalink raw reply	[flat|nested] 15+ messages in thread

* [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling (was: [PATCH] OpenACC routines in fortran modules)
  2016-07-01 20:41   ` [PATCH] OpenACC routines in fortran modules Cesar Philippidis
  2016-07-28  9:55     ` Tobias Burnus
@ 2016-08-11 15:19     ` Thomas Schwinge
  2016-08-11 15:40       ` Jakub Jelinek
  2016-08-11 16:44       ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling Cesar Philippidis
  1 sibling, 2 replies; 15+ messages in thread
From: Thomas Schwinge @ 2016-08-11 15:19 UTC (permalink / raw)
  To: Cesar Philippidis, gcc-patches, Fortran List; +Cc: Tobias Burnus, Jakub Jelinek

[-- Attachment #1: Type: text/plain, Size: 43473 bytes --]

Hi!

This is still hacky and WIP; posting for Cesar and Tobias to have a look.
I'm still not too much of a Fortran person.  ;-)

On Fri, 1 Jul 2016 13:40:58 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
> It turns out that the acc routine parallelism isn't being recorded in
> fortran .mod files. This is a problem because then the ME can't validate
> if a routine has compatible parallelism with the call site. This patch
> does two things:
> 
>  1. Encode gang, worker, vector and seq level parallelism in module
>     files. This introduces a new oacc_function enum, which I ended
>     up using to record the parallelism of standalone acc routines too.

Building on top of this patch, and on top of
<https://gcc.gnu.org/ml/gcc-patches/2016-07/msg01910.html> "[gomp4] Fix
PR72741", I reworked these patches (effectively reverting a lot of
Cesar's earlier changes, which nevertheless gave good guidance to me,
about which code I needed to touch).  With this patch, we now handle more
Fortran OpenACC routine directive use/misuse (see the test case changes),
much in spirit of what I discussed in <http://gcc.gnu.org/PR72741>
"Fortran OpenACC routine directive doesn't properly handle clauses
specifying the level of parallelism", minus items that Cesar already
clarified for me, where Fortran is different from what I expected,
different from the C/C++ environment I'm more used to.  This now also
paves the way for adding Fortran support to my recent patch
<https://gcc.gnu.org/ml/gcc-patches/2016-08/msg00069.html> "Use
verify_oacc_routine_clauses", and then ultimately
<https://gcc.gnu.org/ml/gcc-patches/2016-08/msg00071.html> "Repeated use
of the OpenACC routine directive".

However, my changes are still hacky and WIP, still contains a bunch of
TODOs.  Can you, Cesar and/or Tobias, please advise on these?

>  2. Extends gfc_match_oacc_routine to add acc routine directive support
>     for intrinsic procedures such as abort.
> 
> Is this patch OK for trunk? I included support for intrinsic procedures
> because it was necessary with my previous patch which treated all calls
> to non-acc routines from within an OpenACC offloaded region as errors.
> Now that it has been determined that those patches should be link time
> errors, we technically don't need to add acc routine support for
> intrinsic procedures. So I can drop that part of the patch if necessary.

That could've been a patch separate from the others, as it's doing a
separate thing.  We will want to handle intrinsics used with the OpenACC
routine directive with a name (but it certainly isn't a priority).  I
left in these changes, and also extended them a bit.

First some comments on Cesar's patch:

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

>  [...]
> +DECL_MIO_NAME (oacc_function)
>  [...]

As discussed between Cesar and Tobias, these module.c/symbol.c changes
introduce an incompatibility in the Fortran module file format, which
we'll want to avoid.  Reverting that to use individual bit flags instead
of the "enum oacc_function", I think that we're safe (but I have not
verified that).  On the other hand, given that I'm not at all handling in
module.c/symbol.c the new "locus omp_clauses_locus" and "struct
symbol_attribute *next" members that I'm adding to "symbol_attribute",
I'm not sure whether I'm actually testing this properly.  ;-) I guess I'm
not.

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

> @@ -1814,7 +1824,10 @@ gfc_match_oacc_routine (void)
>  	  != MATCH_YES))
>      return MATCH_ERROR;
>  
> -  if (sym != NULL)
> +  if (isym != NULL)
> +    /* There is nothing to do for intrinsic procedures.  */
> +    ;

We will want to check that no incompatible clauses are being specified,
for example (but, low priority).  I'm adding a hacky implementation of
that.

> +  else if (sym != NULL)
>      {
>        n = gfc_get_oacc_routine_name ();
>        n->sym = sym;

> --- a/gcc/fortran/trans-decl.c
> +++ b/gcc/fortran/trans-decl.c
> @@ -1327,11 +1327,26 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
>      list = tree_cons (get_identifier ("omp declare target"),
>  		      NULL_TREE, list);
>  
> -  if (sym_attr.oacc_function)
> +  if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
>      {
>        tree dims = NULL_TREE;
>        int ix;
> -      int level = sym_attr.oacc_function - 1;
> +      int level = GOMP_DIM_MAX;
> +
> +      switch (sym_attr.oacc_function)
> +	{
> +	case OACC_FUNCTION_GANG:
> +	  level = GOMP_DIM_GANG;
> +	  break;
> +	case OACC_FUNCTION_WORKER:
> +	  level = GOMP_DIM_WORKER;
> +	  break;
> +	case OACC_FUNCTION_VECTOR:
> +	  level = GOMP_DIM_VECTOR;
> +	  break;
> +	case OACC_FUNCTION_SEQ:
> +	default:;
> +	}
>  
>        for (ix = GOMP_DIM_MAX; ix--;)
>  	dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),

As discussed before, this should use the generic omp-low.c functions,
which I've implemented.

> --- /dev/null
> +++ b/gcc/testsuite/gfortran.dg/goacc/routine-7.f90
> @@ -0,0 +1,69 @@
> +! Test acc routines inside modules.
> +
> +! { dg-additional-options "-O0" }

-O0 to prevent inlining of functions tagged with OpenACC routine
directives, or another reason?

> --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
> +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
> @@ -1,121 +1,95 @@
> +! Test acc routines inside modules.
>  
>  ! { dg-do run }
> -! { dg-additional-options "-cpp" }
>  
> -#define M 8
> -#define N 32
> +module routines
> +  integer, parameter :: N = 32
>  
> -program main
> -  integer :: i
> -  integer :: a(N)
> -  integer :: b(M * N)
> -
> -  do i = 1, N
> -    a(i) = 0
> -  end do
> +contains
> +  subroutine vector (a)
> +    implicit none
> +    !$acc routine vector
> +    integer, intent (inout) :: a(N)
> +    integer :: i
> [...]

This seems to completely rewrite the test case.  Is that intentional, or
should the original test case be preserved, and the changed/new/rewritten
one be added as a new test case?


Now, my hacky WIP patch.

One big chunk of the gcc/fortran/gfortran.h changes is just to move some
stuff around, without any changes, so that I can use "locus" in
"symbol_attribute".

I very much "cargo cult"ed all that "oacc_routine*" bit flag stuff in
module.c/symbol.c, replicating what's being done for "omp target
declare", without really knowing what I'm doing there.  I will appreciate
test cases actually exercising this code -- which doesn't currently at
all handle the new "locus omp_clauses_locus" and "struct symbol_attribute
*next" members that I'm adding to "symbol_attribute", as I've mentioned
before.  (But I suppose it should?)

We're not implementing the OpenACC device_type clause at the moment, so
the "TODO: handle device_type clauses" comment in
gcc/fortran/openmp.c:gfc_match_oacc_routine is not a concern right now.

With these changes, we're now actually also paying attention the clauses
specified with the OpenACC routine directive with a name -- one of the
things mentioned as missing in <http://gcc.gnu.org/PR72741> "Fortran
OpenACC routine directive doesn't properly handle clauses specifying the
level of parallelism".

To handle several "pending" OpenACC routine directives, I had to add the
"struct symbol_attribute *next" member to "symbol_attribute" -- I hope
that doesn't disqualify the proposed changes as too ugly.  (Several other
structs already contain such "next" pointers, and the use is very much
confined to only the OpenACC routine directive.)  I will of course be
happy to learn about a better/different way to do this.

commit ca4a098dab72f27c6e1121aa7e5e49764921974e
Author: Thomas Schwinge <thomas@codesourcery.com>
Date:   Thu Aug 11 16:34:22 2016 +0200

    [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling
---
 gcc/fortran/gfortran.h                             | 275 +++++++++++----------
 gcc/fortran/module.c                               |  34 ++-
 gcc/fortran/openmp.c                               | 106 ++++----
 gcc/fortran/symbol.c                               | 135 +++++++++-
 gcc/fortran/trans-decl.c                           | 106 ++++++--
 .../gfortran.dg/goacc/oaccdevlow-routine.f95       |   2 +-
 gcc/testsuite/gfortran.dg/goacc/pr72741-2.f        |  39 +++
 .../gfortran.dg/goacc/pr72741-intrinsic-1.f        |  16 ++
 gcc/testsuite/gfortran.dg/goacc/pr72741.f90        |  14 +-
 9 files changed, 501 insertions(+), 226 deletions(-)

diff --git gcc/fortran/gfortran.h gcc/fortran/gfortran.h
index c70f51f..5f19421 100644
--- gcc/fortran/gfortran.h
+++ gcc/fortran/gfortran.h
@@ -303,15 +303,6 @@ enum save_state
 { SAVE_NONE = 0, SAVE_EXPLICIT, SAVE_IMPLICIT
 };
 
-/* Flags to keep track of ACC routine states.  */
-enum oacc_function
-{ OACC_FUNCTION_NONE = 0,
-  OACC_FUNCTION_SEQ,
-  OACC_FUNCTION_GANG,
-  OACC_FUNCTION_WORKER,
-  OACC_FUNCTION_VECTOR
-};
-
 /* Strings for all symbol attributes.  We use these for dumping the
    parse tree, in error messages, and also when reading and writing
    modules.  In symbol.c.  */
@@ -321,7 +312,6 @@ extern const mstring intents[];
 extern const mstring access_types[];
 extern const mstring ifsrc_types[];
 extern const mstring save_status[];
-extern const mstring oacc_function_types[];
 
 /* Enumeration of all the generic intrinsic functions.  Used by the
    backend for identification of a function.  */
@@ -705,6 +695,126 @@ CInteropKind_t;
 extern CInteropKind_t c_interop_kinds_table[];
 
 
+/* We need to store source lines as sequences of multibyte source
+   characters. We define here a type wide enough to hold any multibyte
+   source character, just like libcpp does.  A 32-bit type is enough.  */
+
+#if HOST_BITS_PER_INT >= 32
+typedef unsigned int gfc_char_t;
+#elif HOST_BITS_PER_LONG >= 32
+typedef unsigned long gfc_char_t;
+#elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
+typedef unsigned long long gfc_char_t;
+#else
+# error "Cannot find an integer type with at least 32 bits"
+#endif
+
+
+/* The following three structures are used to identify a location in
+   the sources.
+
+   gfc_file is used to maintain a tree of the source files and how
+   they include each other
+
+   gfc_linebuf holds a single line of source code and information
+   which file it resides in
+
+   locus point to the sourceline and the character in the source
+   line.
+*/
+
+typedef struct gfc_file
+{
+  struct gfc_file *next, *up;
+  int inclusion_line, line;
+  char *filename;
+} gfc_file;
+
+typedef struct gfc_linebuf
+{
+  source_location location;
+  struct gfc_file *file;
+  struct gfc_linebuf *next;
+
+  int truncated;
+  bool dbg_emitted;
+
+  gfc_char_t line[1];
+} gfc_linebuf;
+
+#define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
+
+#define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
+
+typedef struct
+{
+  gfc_char_t *nextc;
+  gfc_linebuf *lb;
+} locus;
+
+/* In order for the "gfc" format checking to work correctly, you must
+   have declared a typedef locus first.  */
+#if GCC_VERSION >= 4001
+#define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
+#else
+#define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
+#endif
+
+
+/* Suppress error messages or re-enable them.  */
+
+void gfc_push_suppress_errors (void);
+void gfc_pop_suppress_errors (void);
+
+
+/* Character length structures hold the expression that gives the
+   length of a character variable.  We avoid putting these into
+   gfc_typespec because doing so prevents us from doing structure
+   copies and forces us to deallocate any typespecs we create, as well
+   as structures that contain typespecs.  They also can have multiple
+   character typespecs pointing to them.
+
+   These structures form a singly linked list within the current
+   namespace and are deallocated with the namespace.  It is possible to
+   end up with gfc_charlen structures that have nothing pointing to them.  */
+
+typedef struct gfc_charlen
+{
+  struct gfc_expr *length;
+  struct gfc_charlen *next;
+  bool length_from_typespec; /* Length from explicit array ctor typespec?  */
+  tree backend_decl;
+  tree passed_length; /* Length argument explicitly passed.  */
+
+  int resolved;
+}
+gfc_charlen;
+
+#define gfc_get_charlen() XCNEW (gfc_charlen)
+
+/* Type specification structure.  */
+typedef struct
+{
+  bt type;
+  int kind;
+
+  union
+  {
+    struct gfc_symbol *derived;	/* For derived types only.  */
+    gfc_charlen *cl;		/* For character types only.  */
+    int pad;			/* For hollerith types only.  */
+  }
+  u;
+
+  struct gfc_symbol *interface;	/* For PROCEDURE declarations.  */
+  int is_c_interop;
+  int is_iso_c;
+  bt f90_type;
+  bool deferred;
+}
+gfc_typespec;
+
+
 /* Structure and list of supported extension attributes.  */
 typedef enum
 {
@@ -729,7 +839,7 @@ ext_attr_t;
 extern const ext_attr_t ext_attr_list[];
 
 /* Symbol attribute structure.  */
-typedef struct
+typedef struct symbol_attribute
 {
   /* Variable attributes.  */
   unsigned allocatable:1, dimension:1, codimension:1, external:1, intrinsic:1,
@@ -864,6 +974,13 @@ typedef struct
   /* Mentioned in OMP DECLARE TARGET.  */
   unsigned omp_declare_target:1;
 
+  /* OpenACC routine.  */
+  unsigned oacc_routine:1;
+  unsigned oacc_routine_gang:1;
+  unsigned oacc_routine_worker:1;
+  unsigned oacc_routine_vector:1;
+  unsigned oacc_routine_seq:1;
+
   /* Mentioned in OACC DECLARE.  */
   unsigned oacc_declare_create:1;
   unsigned oacc_declare_copyin:1;
@@ -871,137 +988,24 @@ typedef struct
   unsigned oacc_declare_device_resident:1;
   unsigned oacc_declare_link:1;
 
-  /* This is an OpenACC acclerator function at level N - 1  */
-  ENUM_BITFIELD (oacc_function) oacc_function:3;
-
   /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
   unsigned ext_attr:EXT_ATTR_NUM;
 
+  /* Location information for OMP clauses.  */
+  //TODO: how to handle in module.c/symbol.c?
+  locus omp_clauses_locus;
+
   /* The namespace where the attribute has been set.  */
   struct gfc_namespace *volatile_ns, *asynchronous_ns;
+
+  /* Chain to another set of symbol attributes.  Currently only used for
+     OpenACC routine.  */
+  //TODO: how to handle in module.c/symbol.c?
+  struct symbol_attribute *next;
 }
 symbol_attribute;
 
 
-/* We need to store source lines as sequences of multibyte source
-   characters. We define here a type wide enough to hold any multibyte
-   source character, just like libcpp does.  A 32-bit type is enough.  */
-
-#if HOST_BITS_PER_INT >= 32
-typedef unsigned int gfc_char_t;
-#elif HOST_BITS_PER_LONG >= 32
-typedef unsigned long gfc_char_t;
-#elif defined(HAVE_LONG_LONG) && (HOST_BITS_PER_LONGLONG >= 32)
-typedef unsigned long long gfc_char_t;
-#else
-# error "Cannot find an integer type with at least 32 bits"
-#endif
-
-
-/* The following three structures are used to identify a location in
-   the sources.
-
-   gfc_file is used to maintain a tree of the source files and how
-   they include each other
-
-   gfc_linebuf holds a single line of source code and information
-   which file it resides in
-
-   locus point to the sourceline and the character in the source
-   line.
-*/
-
-typedef struct gfc_file
-{
-  struct gfc_file *next, *up;
-  int inclusion_line, line;
-  char *filename;
-} gfc_file;
-
-typedef struct gfc_linebuf
-{
-  source_location location;
-  struct gfc_file *file;
-  struct gfc_linebuf *next;
-
-  int truncated;
-  bool dbg_emitted;
-
-  gfc_char_t line[1];
-} gfc_linebuf;
-
-#define gfc_linebuf_header_size (offsetof (gfc_linebuf, line))
-
-#define gfc_linebuf_linenum(LBUF) (LOCATION_LINE ((LBUF)->location))
-
-typedef struct
-{
-  gfc_char_t *nextc;
-  gfc_linebuf *lb;
-} locus;
-
-/* In order for the "gfc" format checking to work correctly, you must
-   have declared a typedef locus first.  */
-#if GCC_VERSION >= 4001
-#define ATTRIBUTE_GCC_GFC(m, n) __attribute__ ((__format__ (__gcc_gfc__, m, n))) ATTRIBUTE_NONNULL(m)
-#else
-#define ATTRIBUTE_GCC_GFC(m, n) ATTRIBUTE_NONNULL(m)
-#endif
-
-
-/* Suppress error messages or re-enable them.  */
-
-void gfc_push_suppress_errors (void);
-void gfc_pop_suppress_errors (void);
-
-
-/* Character length structures hold the expression that gives the
-   length of a character variable.  We avoid putting these into
-   gfc_typespec because doing so prevents us from doing structure
-   copies and forces us to deallocate any typespecs we create, as well
-   as structures that contain typespecs.  They also can have multiple
-   character typespecs pointing to them.
-
-   These structures form a singly linked list within the current
-   namespace and are deallocated with the namespace.  It is possible to
-   end up with gfc_charlen structures that have nothing pointing to them.  */
-
-typedef struct gfc_charlen
-{
-  struct gfc_expr *length;
-  struct gfc_charlen *next;
-  bool length_from_typespec; /* Length from explicit array ctor typespec?  */
-  tree backend_decl;
-  tree passed_length; /* Length argument explicitly passed.  */
-
-  int resolved;
-}
-gfc_charlen;
-
-#define gfc_get_charlen() XCNEW (gfc_charlen)
-
-/* Type specification structure.  */
-typedef struct
-{
-  bt type;
-  int kind;
-
-  union
-  {
-    struct gfc_symbol *derived;	/* For derived types only.  */
-    gfc_charlen *cl;		/* For character types only.  */
-    int pad;			/* For hollerith types only.  */
-  }
-  u;
-
-  struct gfc_symbol *interface;	/* For PROCEDURE declarations.  */
-  int is_c_interop;
-  int is_iso_c;
-  bt f90_type;
-  bool deferred;
-}
-gfc_typespec;
-
 /* Array specification.  */
 typedef struct
 {
@@ -2816,6 +2820,11 @@ bool gfc_add_result (symbol_attribute *, const char *, locus *);
 bool gfc_add_save (symbol_attribute *, save_state, const char *, locus *);
 bool gfc_add_threadprivate (symbol_attribute *, const char *, locus *);
 bool gfc_add_omp_declare_target (symbol_attribute *, const char *, locus *);
+bool gfc_add_oacc_routine (symbol_attribute *, const char *, locus *);
+bool gfc_add_oacc_routine_gang (symbol_attribute *, const char *, locus *);
+bool gfc_add_oacc_routine_worker (symbol_attribute *, const char *, locus *);
+bool gfc_add_oacc_routine_vector (symbol_attribute *, const char *, locus *);
+bool gfc_add_oacc_routine_seq (symbol_attribute *, const char *, locus *);
 bool gfc_add_saved_common (symbol_attribute *, locus *);
 bool gfc_add_target (symbol_attribute *, locus *);
 bool gfc_add_dummy (symbol_attribute *, const char *, locus *);
diff --git gcc/fortran/module.c gcc/fortran/module.c
index 267858f..4b590c6 100644
--- gcc/fortran/module.c
+++ gcc/fortran/module.c
@@ -1986,6 +1986,7 @@ enum ab_attribute
   AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
   AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
   AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET,
+  AB_OACC_ROUTINE, AB_OACC_ROUTINE_GANG, AB_OACC_ROUTINE_WORKER, AB_OACC_ROUTINE_VECTOR, AB_OACC_ROUTINE_SEQ,
   AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE,
   AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
   AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK
@@ -2044,6 +2045,11 @@ static const mstring attr_bits[] =
     minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE),
     minit ("UNLIMITED_POLY", AB_UNLIMITED_POLY),
     minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET),
+    minit ("OACC_ROUTINE", AB_OACC_ROUTINE),
+    minit ("OACC_ROUTINE_GANG", AB_OACC_ROUTINE_GANG),
+    minit ("OACC_ROUTINE_WORKER", AB_OACC_ROUTINE_WORKER),
+    minit ("OACC_ROUTINE_VECTOR", AB_OACC_ROUTINE_VECTOR),
+    minit ("OACC_ROUTINE_SEQ", AB_OACC_ROUTINE_SEQ),
     minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY),
     minit ("MODULE_PROCEDURE", AB_MODULE_PROCEDURE),
     minit ("OACC_DECLARE_CREATE", AB_OACC_DECLARE_CREATE),
@@ -2095,7 +2101,6 @@ DECL_MIO_NAME (procedure_type)
 DECL_MIO_NAME (ref_type)
 DECL_MIO_NAME (sym_flavor)
 DECL_MIO_NAME (sym_intent)
-DECL_MIO_NAME (oacc_function)
 #undef DECL_MIO_NAME
 
 /* Symbol attributes are stored in list with the first three elements
@@ -2117,8 +2122,6 @@ mio_symbol_attribute (symbol_attribute *attr)
   attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures);
   attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types);
   attr->save = MIO_NAME (save_state) (attr->save, save_status);
-  attr->oacc_function = MIO_NAME (oacc_function) (attr->oacc_function,
-						  oacc_function_types);
 
   ext_attr = attr->ext_attr;
   mio_integer ((int *) &ext_attr);
@@ -2236,6 +2239,16 @@ mio_symbol_attribute (symbol_attribute *attr)
 	MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
       if (attr->omp_declare_target)
 	MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET, attr_bits);
+      if (attr->oacc_routine)
+	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE, attr_bits);
+      if (attr->oacc_routine_gang)
+	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_GANG, attr_bits);
+      if (attr->oacc_routine_worker)
+	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_WORKER, attr_bits);
+      if (attr->oacc_routine_vector)
+	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_VECTOR, attr_bits);
+      if (attr->oacc_routine_seq)
+	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_SEQ, attr_bits);
       if (attr->array_outer_dependency)
 	MIO_NAME (ab_attribute) (AB_ARRAY_OUTER_DEPENDENCY, attr_bits);
       if (attr->module_procedure)
@@ -2422,6 +2435,21 @@ mio_symbol_attribute (symbol_attribute *attr)
 	    case AB_OMP_DECLARE_TARGET:
 	      attr->omp_declare_target = 1;
 	      break;
+	    case AB_OACC_ROUTINE:
+	      attr->oacc_routine = 1;
+	      break;
+	    case AB_OACC_ROUTINE_GANG:
+	      attr->oacc_routine_gang = 1;
+	      break;
+	    case AB_OACC_ROUTINE_WORKER:
+	      attr->oacc_routine_worker = 1;
+	      break;
+	    case AB_OACC_ROUTINE_VECTOR:
+	      attr->oacc_routine_vector = 1;
+	      break;
+	    case AB_OACC_ROUTINE_SEQ:
+	      attr->oacc_routine_seq = 1;
+	      break;
 	    case AB_ARRAY_OUTER_DEPENDENCY:
 	      attr->array_outer_dependency =1;
 	      break;
diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
index 05e4661..5a69e38 100644
--- gcc/fortran/openmp.c
+++ gcc/fortran/openmp.c
@@ -1714,44 +1714,6 @@ gfc_match_oacc_cache (void)
   return MATCH_YES;
 }
 
-/* Determine the loop level for a routine.  Returns OACC_FUNCTION_NONE if
-   any error is detected.  */
-
-static oacc_function
-gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
-{
-  int level = -1;
-  oacc_function ret = OACC_FUNCTION_SEQ;
-
-  if (clauses)
-    {
-      unsigned mask = 0;
-
-      if (clauses->gang)
-	{
-	  level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
-	  ret = OACC_FUNCTION_GANG;
-	}
-      if (clauses->worker)
-	{
-	  level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
-	  ret = OACC_FUNCTION_WORKER;
-	}
-      if (clauses->vector)
-	{
-	  level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
-	  ret = OACC_FUNCTION_VECTOR;
-	}
-      if (clauses->seq)
-	level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
-
-      if (mask != (mask & -mask))
-	ret = OACC_FUNCTION_NONE;
-    }
-
-  return ret;
-}
-
 match
 gfc_match_oacc_routine (void)
 {
@@ -1761,7 +1723,8 @@ gfc_match_oacc_routine (void)
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
   gfc_intrinsic_sym *isym = NULL;
-  oacc_function dims = OACC_FUNCTION_NONE;
+  symbol_attribute *add_attr = NULL;
+  const char *add_attr_name = NULL;
 
   old_loc = gfc_current_locus;
 
@@ -1828,19 +1791,26 @@ gfc_match_oacc_routine (void)
 	  != MATCH_YES))
     return MATCH_ERROR;
 
-  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;
-    }
-
   if (isym != NULL)
-    /* There is nothing to do for intrinsic procedures.  */
-    ;
+    {
+      //TODO gfc_intrinsic_sym doesn't have symbol_attribute?
+      //add_attr = &isym->attr;
+      //add_attr_name = NULL; //TODO
+      /* Fake it.  TODO: handle device_type clauses...  */
+      if (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");
+	  gfc_current_locus = old_loc;
+	  return MATCH_ERROR;
+	}
+    }
   else if (sym != NULL)
     {
+      add_attr = &sym->attr;
+      add_attr_name = NULL; //TODO
+
       n = gfc_get_oacc_routine_name ();
       n->sym = sym;
       n->clauses = NULL;
@@ -1852,11 +1822,41 @@ gfc_match_oacc_routine (void)
     }
   else if (gfc_current_ns->proc_name)
     {
-      if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
-				       gfc_current_ns->proc_name->name,
-				       &old_loc))
+      add_attr = &gfc_current_ns->proc_name->attr;
+      add_attr_name = gfc_current_ns->proc_name->name;
+    }
+  else
+    gcc_unreachable ();
+
+  if (add_attr != NULL)
+    {
+      if (!gfc_add_omp_declare_target (add_attr, add_attr_name, &old_loc))
 	goto cleanup;
-      gfc_current_ns->proc_name->attr.oacc_function = dims;
+      /* Skip over any existing symbol attributes capturing OpenACC routine
+	 directives.  */
+      while (add_attr->next != NULL)
+	add_attr = add_attr->next;
+      if (add_attr->oacc_routine)
+	{
+	  add_attr->next = XCNEW (symbol_attribute);
+	  gfc_clear_attr (add_attr->next);
+	  add_attr = add_attr->next;
+	}
+      if (!gfc_add_oacc_routine (add_attr, add_attr_name, &old_loc))
+	goto cleanup;
+      if (c && c->gang
+	  && !gfc_add_oacc_routine_gang (add_attr, add_attr_name, &old_loc))
+	goto cleanup;
+      if (c && c->worker
+	  && !gfc_add_oacc_routine_worker (add_attr, add_attr_name, &old_loc))
+	goto cleanup;
+      if (c && c->vector
+	  && !gfc_add_oacc_routine_vector (add_attr, add_attr_name, &old_loc))
+	goto cleanup;
+      if (c && c->seq
+	  && !gfc_add_oacc_routine_seq (add_attr, add_attr_name, &old_loc))
+	goto cleanup;
+      add_attr->omp_clauses_locus = old_loc; //TODO OK to just assign that?
     }
 
   if (n)
diff --git gcc/fortran/symbol.c gcc/fortran/symbol.c
index 84fa2bd..36852da 100644
--- gcc/fortran/symbol.c
+++ gcc/fortran/symbol.c
@@ -87,15 +87,6 @@ const mstring save_status[] =
     minit ("IMPLICIT-SAVE", SAVE_IMPLICIT),
 };
 
-const mstring oacc_function_types[] =
-{
-  minit ("NONE", OACC_FUNCTION_NONE),
-  minit ("OACC_FUNCTION_SEQ", OACC_FUNCTION_SEQ),
-  minit ("OACC_FUNCTION_GANG", OACC_FUNCTION_GANG),
-  minit ("OACC_FUNCTION_WORKER", OACC_FUNCTION_WORKER),
-  minit ("OACC_FUNCTION_VECTOR", OACC_FUNCTION_VECTOR)
-};
-
 /* This is to make sure the backend generates setup code in the correct
    order.  */
 
@@ -385,6 +376,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
     *contiguous = "CONTIGUOUS", *generic = "GENERIC";
   static const char *threadprivate = "THREADPRIVATE";
   static const char *omp_declare_target = "OMP DECLARE TARGET";
+  static const char *oacc_routine = "OACC ROUTINE";
+  static const char *oacc_routine_gang = "OACC ROUTINE GANG";
+  static const char *oacc_routine_worker = "OACC ROUTINE WORKER";
+  static const char *oacc_routine_vector = "OACC ROUTINE VECTOR";
+  static const char *oacc_routine_seq = "OACC ROUTINE SEQ";
   static const char *oacc_declare_copyin = "OACC DECLARE COPYIN";
   static const char *oacc_declare_create = "OACC DECLARE CREATE";
   static const char *oacc_declare_deviceptr = "OACC DECLARE DEVICEPTR";
@@ -482,6 +478,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (dummy, intrinsic);
   conf (dummy, threadprivate);
   conf (dummy, omp_declare_target);
+  conf (dummy, oacc_routine);
+  conf (dummy, oacc_routine_gang);
+  conf (dummy, oacc_routine_worker);
+  conf (dummy, oacc_routine_vector);
+  conf (dummy, oacc_routine_seq);
   conf (pointer, target);
   conf (pointer, intrinsic);
   conf (pointer, elemental);
@@ -526,6 +527,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (in_equivalence, allocatable);
   conf (in_equivalence, threadprivate);
   conf (in_equivalence, omp_declare_target);
+  conf (in_equivalence, oacc_routine);
+  conf (in_equivalence, oacc_routine_gang);
+  conf (in_equivalence, oacc_routine_worker);
+  conf (in_equivalence, oacc_routine_vector);
+  conf (in_equivalence, oacc_routine_seq);
   conf (in_equivalence, oacc_declare_create);
   conf (in_equivalence, oacc_declare_copyin);
   conf (in_equivalence, oacc_declare_deviceptr);
@@ -579,6 +585,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (cray_pointee, in_equivalence);
   conf (cray_pointee, threadprivate);
   conf (cray_pointee, omp_declare_target);
+  conf (cray_pointee, oacc_routine);
+  conf (cray_pointee, oacc_routine_gang);
+  conf (cray_pointee, oacc_routine_worker);
+  conf (cray_pointee, oacc_routine_vector);
+  conf (cray_pointee, oacc_routine_seq);
   conf (cray_pointee, oacc_declare_create);
   conf (cray_pointee, oacc_declare_copyin);
   conf (cray_pointee, oacc_declare_deviceptr);
@@ -637,6 +648,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
   conf (proc_pointer, abstract)
 
   conf (entry, omp_declare_target)
+  conf (entry, oacc_routine)
+  conf (entry, oacc_routine_gang)
+  conf (entry, oacc_routine_worker)
+  conf (entry, oacc_routine_vector)
+  conf (entry, oacc_routine_seq)
   conf (entry, oacc_declare_create)
   conf (entry, oacc_declare_copyin)
   conf (entry, oacc_declare_deviceptr)
@@ -678,6 +694,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
       conf2 (subroutine);
       conf2 (threadprivate);
       conf2 (omp_declare_target);
+      conf2 (oacc_routine);
+      conf2 (oacc_routine_gang);
+      conf2 (oacc_routine_worker);
+      conf2 (oacc_routine_vector);
+      conf2 (oacc_routine_seq);
       conf2 (oacc_declare_create);
       conf2 (oacc_declare_copyin);
       conf2 (oacc_declare_deviceptr);
@@ -764,6 +785,11 @@ check_conflict (symbol_attribute *attr, const char *name, locus *where)
       conf2 (threadprivate);
       conf2 (result);
       conf2 (omp_declare_target);
+      conf2 (oacc_routine);
+      conf2 (oacc_routine_gang);
+      conf2 (oacc_routine_worker);
+      conf2 (oacc_routine_vector);
+      conf2 (oacc_routine_seq);
       conf2 (oacc_declare_create);
       conf2 (oacc_declare_copyin);
       conf2 (oacc_declare_deviceptr);
@@ -1266,7 +1292,6 @@ bool
 gfc_add_omp_declare_target (symbol_attribute *attr, const char *name,
 			    locus *where)
 {
-
   if (check_used (attr, name, where))
     return false;
 
@@ -1279,6 +1304,81 @@ gfc_add_omp_declare_target (symbol_attribute *attr, const char *name,
 
 
 bool
+gfc_add_oacc_routine (symbol_attribute *attr, const char *name,
+		      locus *where)
+{
+  if (check_used (attr, name, where))
+    return false;
+
+  if (attr->oacc_routine)
+    return true;
+
+  attr->oacc_routine = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_routine_gang (symbol_attribute *attr, const char *name,
+			   locus *where)
+{
+  if (check_used (attr, name, where))
+    return false;
+
+  if (attr->oacc_routine_gang)
+    return true;
+
+  attr->oacc_routine_gang = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_routine_worker (symbol_attribute *attr, const char *name,
+			     locus *where)
+{
+  if (check_used (attr, name, where))
+    return false;
+
+  if (attr->oacc_routine_worker)
+    return true;
+
+  attr->oacc_routine_worker = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_routine_vector (symbol_attribute *attr, const char *name,
+			     locus *where)
+{
+  if (check_used (attr, name, where))
+    return false;
+
+  if (attr->oacc_routine_vector)
+    return true;
+
+  attr->oacc_routine_vector = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+bool
+gfc_add_oacc_routine_seq (symbol_attribute *attr, const char *name,
+			  locus *where)
+{
+  if (check_used (attr, name, where))
+    return false;
+
+  if (attr->oacc_routine_seq)
+    return true;
+
+  attr->oacc_routine_seq = 1;
+  return check_conflict (attr, name, where);
+}
+
+
+bool
 gfc_add_oacc_declare_create (symbol_attribute *attr, const char *name,
 			     locus *where)
 {
@@ -1915,6 +2015,21 @@ gfc_copy_attr (symbol_attribute *dest, symbol_attribute *src, locus *where)
   if (src->omp_declare_target
       && !gfc_add_omp_declare_target (dest, NULL, where))
     goto fail;
+  if (src->oacc_routine
+      && !gfc_add_oacc_routine (dest, NULL, where))
+    goto fail;
+  if (src->oacc_routine_gang
+      && !gfc_add_oacc_routine_gang (dest, NULL, where))
+    goto fail;
+  if (src->oacc_routine_worker
+      && !gfc_add_oacc_routine_worker (dest, NULL, where))
+    goto fail;
+  if (src->oacc_routine_vector
+      && !gfc_add_oacc_routine_vector (dest, NULL, where))
+    goto fail;
+  if (src->oacc_routine_seq
+      && !gfc_add_oacc_routine_seq (dest, NULL, where))
+    goto fail;
   if (src->oacc_declare_create
       && !gfc_add_oacc_declare_create (dest, NULL, where))
     goto fail;
diff --git gcc/fortran/trans-decl.c gcc/fortran/trans-decl.c
index 1934453..d1b956c 100644
--- gcc/fortran/trans-decl.c
+++ gcc/fortran/trans-decl.c
@@ -46,6 +46,7 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-stmt.h"
 #include "gomp-constants.h"
 #include "gimplify.h"
+#include "omp-low.h"
 
 #define MAX_LABEL_VALUE 99999
 
@@ -1360,37 +1361,94 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
       }
 
   if (sym_attr.omp_declare_target)
-    list = tree_cons (get_identifier ("omp declare target"),
-		      NULL_TREE, list);
-
-  if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
     {
-      tree dims = NULL_TREE;
-      int ix;
-      int level = GOMP_DIM_MAX;
+      tree clauses = NULL_TREE;
+      symbol_attribute *oacc_routine_attr = &sym_attr;
+      while (oacc_routine_attr != NULL
+	     && oacc_routine_attr->oacc_routine)
+	{
+	  location_t loc = oacc_routine_attr->omp_clauses_locus.lb->location;
+	  //TODO use gfc_trans_omp_clauses?
+	  tree clauses_ = NULL_TREE;
+	  if (oacc_routine_attr->oacc_routine_gang)
+	    {
+	      tree c = build_omp_clause (loc, OMP_CLAUSE_GANG);
+	      OMP_CLAUSE_CHAIN (c) = clauses_;
+	      clauses_ = c;
+	    }
+	  if (oacc_routine_attr->oacc_routine_worker)
+	    {
+	      tree c = build_omp_clause (loc, OMP_CLAUSE_WORKER);
+	      OMP_CLAUSE_CHAIN (c) = clauses_;
+	      clauses_ = c;
+	    }
+	  if (oacc_routine_attr->oacc_routine_vector)
+	    {
+	      tree c = build_omp_clause (loc, OMP_CLAUSE_VECTOR);
+	      OMP_CLAUSE_CHAIN (c) = clauses_;
+	      clauses_ = c;
+	    }
+	  /* Default to seq if nothing else has been specified.  */
+	  if (oacc_routine_attr->oacc_routine_seq
+	      || clauses_ == NULL_TREE)
+	    {
+	      tree c = build_omp_clause (loc, OMP_CLAUSE_SEQ);
+	      OMP_CLAUSE_CHAIN (c) = clauses_;
+	      clauses_ = c;
+	    }
+
+	  /* If we saw more than one clause specifying the level of
+	     parallelism...  */
+	  if (OMP_CLAUSE_CHAIN (clauses_) != NULL_TREE)
+	    {
+	      gfc_error ("Multiple loop axes specified for routine at %L",
+			 &oacc_routine_attr->omp_clauses_locus);
+
+	      /* ..., only one clause survives.  */
+	      OMP_CLAUSE_CHAIN (clauses_) = NULL_TREE;
+	    }
+
+	  OMP_CLAUSE_CHAIN (clauses_) = clauses;
+	  clauses = clauses_;
+
+	  oacc_routine_attr = oacc_routine_attr->next;
+	}
 
-      switch (sym_attr.oacc_function)
+      /* For any chained symbol attributes for OpenACC routine, handle, and
+	 clean these up.  */
+      while (sym_attr.next != NULL)
 	{
-	case OACC_FUNCTION_GANG:
-	  level = GOMP_DIM_GANG;
-	  break;
-	case OACC_FUNCTION_WORKER:
-	  level = GOMP_DIM_WORKER;
-	  break;
-	case OACC_FUNCTION_VECTOR:
-	  level = GOMP_DIM_VECTOR;
-	  break;
-	case OACC_FUNCTION_SEQ:
-	default:;
+	  symbol_attribute *sym_attr_next = sym_attr.next->next;
+
+	  gfc_error ("!$ACC ROUTINE already applied at %L",
+		     &sym_attr.next->omp_clauses_locus);
+
+	  free (sym_attr.next);
+
+	  sym_attr.next = sym_attr_next;
 	}
 
-      for (ix = GOMP_DIM_MAX; ix--;)
-	dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
-			  integer_zero_node, dims);
+      if (sym_attr.oacc_routine)
+	{
+	  gcc_checking_assert (clauses != NULL_TREE);
+	  /* If we saw more than one set of symbol attributes for OpenACC
+	     routine, only one clause survives.  */
+	  OMP_CLAUSE_CHAIN (clauses) = NULL_TREE;
 
-      list = tree_cons (get_identifier ("oacc function"),
-			dims, list);
+	  /* Set the routine's level of parallelism.  */
+	  tree dims = build_oacc_routine_dims (clauses);
+#if 0
+	  // TODO Can we call this before decl_attributes has been called, which happens only after returning from add_attributes_to_decl?
+	  replace_oacc_fn_attrib (fndecl, dims);
+#else
+	  list = tree_cons (get_identifier ("oacc function"),
+			    dims, list);
+#endif
+	}
+      list = tree_cons (get_identifier ("omp declare target"),
+			NULL_TREE, list);
     }
+  gcc_checking_assert (sym_attr.next == NULL);
 
   return list;
 }
diff --git gcc/testsuite/gfortran.dg/goacc/oaccdevlow-routine.f95 gcc/testsuite/gfortran.dg/goacc/oaccdevlow-routine.f95
index 2161fe2..6af19d5 100644
--- gcc/testsuite/gfortran.dg/goacc/oaccdevlow-routine.f95
+++ gcc/testsuite/gfortran.dg/goacc/oaccdevlow-routine.f95
@@ -20,7 +20,7 @@ subroutine ROUTINE
 end subroutine ROUTINE
 
 ! Check the offloaded function's attributes.
-! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } }
+! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 0, 1 0\\), omp declare target\\)\\)" 1 "ompexp" } }
 
 ! Check the offloaded function's classification and compute dimensions (will
 ! always be [1, 1, 1] for target compilation).
diff --git gcc/testsuite/gfortran.dg/goacc/pr72741-2.f gcc/testsuite/gfortran.dg/goacc/pr72741-2.f
new file mode 100644
index 0000000..e0c35d6
--- /dev/null
+++ 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 gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-1.f
new file mode 100644
index 0000000..d84cdf9
--- /dev/null
+++ 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 gcc/testsuite/gfortran.dg/goacc/pr72741.f90 gcc/testsuite/gfortran.dg/goacc/pr72741.f90
index cf89727..bf47fc2 100644
--- gcc/testsuite/gfortran.dg/goacc/pr72741.f90
+++ gcc/testsuite/gfortran.dg/goacc/pr72741.f90
@@ -1,12 +1,19 @@
 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" }
+  ! { dg-error "\\!\\\$ACC ROUTINE already applied" "already" { target *-*-* } 5 }
 END SUBROUTINE v_1
 
 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" }
+  !$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" }
+  ! { dg-error "\\!\\\$ACC ROUTINE already applied" "already" { target *-*-* } 15 }
 
   CALL v_1
   CALL g_1
@@ -17,7 +24,10 @@ 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" }
+  !$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" }
+  ! { dg-error "\\!\\\$ACC ROUTINE already applied" "already" { target *-*-* } 29 }
 
 CONTAINS
   SUBROUTINE sub_2


Grüße
 Thomas

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 472 bytes --]

^ permalink raw reply	[flat|nested] 15+ messages in thread

* Re: [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling (was: [PATCH] OpenACC routines in fortran modules)
  2016-08-11 15:19     ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling (was: [PATCH] OpenACC routines in fortran modules) Thomas Schwinge
@ 2016-08-11 15:40       ` Jakub Jelinek
  2016-08-11 16:27         ` Thomas Schwinge
  2016-08-11 16:44       ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling Cesar Philippidis
  1 sibling, 1 reply; 15+ messages in thread
From: Jakub Jelinek @ 2016-08-11 15:40 UTC (permalink / raw)
  To: Thomas Schwinge
  Cc: Cesar Philippidis, gcc-patches, Fortran List, Tobias Burnus

On Thu, Aug 11, 2016 at 05:18:43PM +0200, Thomas Schwinge wrote:
> --- gcc/fortran/gfortran.h
> +++ gcc/fortran/gfortran.h
> @@ -729,7 +839,7 @@ ext_attr_t;
>  extern const ext_attr_t ext_attr_list[];
>  
>  /* Symbol attribute structure.  */
> -typedef struct
> +typedef struct symbol_attribute
>  {
>    /* Variable attributes.  */
>    unsigned allocatable:1, dimension:1, codimension:1, external:1, intrinsic:1,
> @@ -864,6 +974,13 @@ typedef struct
>    /* Mentioned in OMP DECLARE TARGET.  */
>    unsigned omp_declare_target:1;
>  
> +  /* OpenACC routine.  */
> +  unsigned oacc_routine:1;
> +  unsigned oacc_routine_gang:1;
> +  unsigned oacc_routine_worker:1;
> +  unsigned oacc_routine_vector:1;
> +  unsigned oacc_routine_seq:1;
> +
>    /* Mentioned in OACC DECLARE.  */
>    unsigned oacc_declare_create:1;
>    unsigned oacc_declare_copyin:1;
> @@ -871,137 +988,24 @@ typedef struct
>    unsigned oacc_declare_device_resident:1;
>    unsigned oacc_declare_link:1;
>  
> -  /* This is an OpenACC acclerator function at level N - 1  */
> -  ENUM_BITFIELD (oacc_function) oacc_function:3;
> -
>    /* Attributes set by compiler extensions (!GCC$ ATTRIBUTES).  */
>    unsigned ext_attr:EXT_ATTR_NUM;
>  
> +  /* Location information for OMP clauses.  */
> +  //TODO: how to handle in module.c/symbol.c?
> +  locus omp_clauses_locus;
> +
>    /* The namespace where the attribute has been set.  */
>    struct gfc_namespace *volatile_ns, *asynchronous_ns;
> +
> +  /* Chain to another set of symbol attributes.  Currently only used for
> +     OpenACC routine.  */
> +  //TODO: how to handle in module.c/symbol.c?
> +  struct symbol_attribute *next;

While symbol_attribute is already bloated, I don't like bloating it this
much further.  Do you really need it for all symbols, or just all subroutines?
In the latter case, it is much better to add some openacc specific pointer
into the namespace structure and stick everything you need into some custom
structure it will refer to.  E.g. look at gfc_omp_declare_simd struct
in ns->omp_declare_simd.
omp_clauses_locus makes no sense, symbol_attribute contains parsed info from
many different clauses, which one it is?

	Jakub

^ permalink raw reply	[flat|nested] 15+ messages in thread

* Re: [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling (was: [PATCH] OpenACC routines in fortran modules)
  2016-08-11 15:40       ` Jakub Jelinek
@ 2016-08-11 16:27         ` Thomas Schwinge
  2016-08-11 16:42           ` Jakub Jelinek
  2016-08-16  1:55           ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling Cesar Philippidis
  0 siblings, 2 replies; 15+ messages in thread
From: Thomas Schwinge @ 2016-08-11 16:27 UTC (permalink / raw)
  To: Cesar Philippidis, Jakub Jelinek; +Cc: gcc-patches, Fortran List, Tobias Burnus

Hi!

As Cesar asked for it, there is now a Git branch
tschwinge/omp/pr72741-wip containing these changes (plus some other
pending changes that I didn't single out at this time), at
<https://gcc.gnu.org/git/?p=gcc.git;a=shortlog;h=refs/heads/tschwinge/omp/pr72741-wip>.
(I expect it does, but I didn't verify that this actually builds; I have
further changes on top of that.)  Cesar, please tell me if you'd like me
to push this to GitHub, in case you want to use their review/commentary
functions, or the like.


On Thu, 11 Aug 2016 17:40:26 +0200, Jakub Jelinek <jakub@redhat.com> wrote:
> On Thu, Aug 11, 2016 at 05:18:43PM +0200, Thomas Schwinge wrote:
> > --- gcc/fortran/gfortran.h
> > +++ gcc/fortran/gfortran.h

> >  /* Symbol attribute structure.  */
> > -typedef struct
> > +typedef struct symbol_attribute
> >  {

> While symbol_attribute is already bloated, I don't like bloating it this
> much further.  Do you really need it for all symbols, or just all subroutines?

Certainly not for all symbole; just for what is valid to be used with the
OpenACC routine directive, which per OpenACC 2.0a, 2.13.1 Routine
Directive is:

    In Fortran the syntax of the routine directive is:
        !$acc routine clause-list
        !$acc routine( name ) clause-list
    In Fortran, the routine directive without a name may appear within the specification part of a subroutine or function definition, or within an interface body for a subroutine or function in an interface block, and applies to the containing subroutine or function. The routine directive with a name may appear in the specification part of a subroutine, function or module, and applies to the named subroutine or function.

(Pasting that in full just in case that contains some additional Fortran
lingo, meaning more than "subroutines".)

> In the latter case, it is much better to add some openacc specific pointer
> into the namespace structure and stick everything you need into some custom
> structure it will refer to.  E.g. look at gfc_omp_declare_simd struct
> in ns->omp_declare_simd.

Thanks for the suggestion, I'll look into that.


> omp_clauses_locus makes no sense, symbol_attribute contains parsed info from
> many different clauses, which one it is?

Well, it makes some sense -- it works no worse than the existing code ;-)
-- but I agree that it's not exactly pretty.  To the best of my
knowledge, in Fortran OpenACC/OpenMP clauses parsing, we're currently not
tracking (saving) specific location information for individual clauses
(at least, that's what a casual scan through the code, and
gfc_match_oacc_routine or gfc_match_omp_declare_target in particular make
me think: gfc_omp_clauses collects all clause data, but only contains a
single "locus loc" member (which maybe I should have used instead of
"old_loc", the location information for the directive itself?).  Maybe I
misunderstood, and we do have more precise location information available
for individual clauses?  In that case, I'll happily use that, of course.


Grüße
 Thomas

^ permalink raw reply	[flat|nested] 15+ messages in thread

* Re: [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling (was: [PATCH] OpenACC routines in fortran modules)
  2016-08-11 16:27         ` Thomas Schwinge
@ 2016-08-11 16:42           ` Jakub Jelinek
  2016-08-16  1:55           ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling Cesar Philippidis
  1 sibling, 0 replies; 15+ messages in thread
From: Jakub Jelinek @ 2016-08-11 16:42 UTC (permalink / raw)
  To: Thomas Schwinge
  Cc: Cesar Philippidis, gcc-patches, Fortran List, Tobias Burnus

On Thu, Aug 11, 2016 at 06:26:50PM +0200, Thomas Schwinge wrote:
> > > --- gcc/fortran/gfortran.h
> > > +++ gcc/fortran/gfortran.h
> 
> > >  /* Symbol attribute structure.  */
> > > -typedef struct
> > > +typedef struct symbol_attribute
> > >  {
> 
> > While symbol_attribute is already bloated, I don't like bloating it this
> > much further.  Do you really need it for all symbols, or just all subroutines?
> 
> Certainly not for all symbole; just for what is valid to be used with the
> OpenACC routine directive, which per OpenACC 2.0a, 2.13.1 Routine
> Directive is:
> 
>     In Fortran the syntax of the routine directive is:
>         !$acc routine clause-list
>         !$acc routine( name ) clause-list
>     In Fortran, the routine directive without a name may appear within the specification part of a subroutine or function definition, or within an interface body for a subroutine or function in an interface block, and applies to the containing subroutine or function. The routine directive with a name may appear in the specification part of a subroutine, function or module, and applies to the named subroutine or function.
> 
> (Pasting that in full just in case that contains some additional Fortran
> lingo, meaning more than "subroutines".)

By "subroutines" I've meant of course also functions, those have their own
namespace structure too.

> > omp_clauses_locus makes no sense, symbol_attribute contains parsed info from
> > many different clauses, which one it is?
> 
> Well, it makes some sense -- it works no worse than the existing code ;-)
> -- but I agree that it's not exactly pretty.  To the best of my
> knowledge, in Fortran OpenACC/OpenMP clauses parsing, we're currently not
> tracking (saving) specific location information for individual clauses
> (at least, that's what a casual scan through the code, and
> gfc_match_oacc_routine or gfc_match_omp_declare_target in particular make
> me think: gfc_omp_clauses collects all clause data, but only contains a
> single "locus loc" member (which maybe I should have used instead of
> "old_loc", the location information for the directive itself?).  Maybe I
> misunderstood, and we do have more precise location information available
> for individual clauses?  In that case, I'll happily use that, of course.

The Fortran FE generally doesn't track locations of any of the attributes
symbols have, attributes as well as OpenMP clauses are represented just as
bits (for boolean stuff), etc., only if you have some expression you have
location for the expression.
I don't see what is so special on these clauses that they need to have
location tracked compared to say CONTIGUOUS or whatever other attribute, just
use the location of the function.  Unless of course you want to rewrite all
the Fortran FE data structures and track detailed locations for everything.
But just treating selected OpenACC clauses specially, ignoring how the FE is
structured, is at least inconsistent with the rest.

	Jakub

^ permalink raw reply	[flat|nested] 15+ messages in thread

* Re: [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling
  2016-08-11 15:19     ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling (was: [PATCH] OpenACC routines in fortran modules) Thomas Schwinge
  2016-08-11 15:40       ` Jakub Jelinek
@ 2016-08-11 16:44       ` Cesar Philippidis
  1 sibling, 0 replies; 15+ messages in thread
From: Cesar Philippidis @ 2016-08-11 16:44 UTC (permalink / raw)
  To: Thomas Schwinge, gcc-patches, Fortran List; +Cc: Tobias Burnus, Jakub Jelinek

[-- Attachment #1: Type: text/plain, Size: 15956 bytes --]

On 08/11/2016 08:18 AM, Thomas Schwinge wrote:

>> --- a/gcc/fortran/module.c
>> +++ b/gcc/fortran/module.c
> 
>>  [...]
>> +DECL_MIO_NAME (oacc_function)
>>  [...]
> 
> As discussed between Cesar and Tobias, these module.c/symbol.c changes
> introduce an incompatibility in the Fortran module file format, which
> we'll want to avoid.  Reverting that to use individual bit flags instead
> of the "enum oacc_function", I think that we're safe (but I have not
> verified that).  On the other hand, given that I'm not at all handling in
> module.c/symbol.c the new "locus omp_clauses_locus" and "struct
> symbol_attribute *next" members that I'm adding to "symbol_attribute",
> I'm not sure whether I'm actually testing this properly.  ;-) I guess I'm
> not.

How are you testing it? Basically, what you need to do is create two
source files, one containing a module and another with the program unit.
Then compile one of those files with the old, say gcc6 fortran, and the
other with trunk gfortran and try to link the .o files together.

I've attached some test cases so that you can experiment with. Each
driver file corresponds to a test file, with the exception of
test-driver which uses both test-interface.f90 and test-module.f90.

>> --- a/gcc/fortran/openmp.c
>> +++ b/gcc/fortran/openmp.c
> 
>> @@ -1814,7 +1824,10 @@ gfc_match_oacc_routine (void)
>>  	  != MATCH_YES))
>>      return MATCH_ERROR;
>>  
>> -  if (sym != NULL)
>> +  if (isym != NULL)
>> +    /* There is nothing to do for intrinsic procedures.  */
>> +    ;
> 
> We will want to check that no incompatible clauses are being specified,
> for example (but, low priority).  I'm adding a hacky implementation of
> that.

So this is what I was overlooking in PR72741. For some reason I was only
considering invalid clauses of the form

  !$acc routine gang worker

and not actually checking for compatible parallelism at the call sites.
The title "Fortran OpenACC routine directive doesn't properly handle
clauses specifying the level of parallelism" was kind of misleading.

Shouldn't the oaccdevlow pass already catch these types of errors already?

>> --- /dev/null
>> +++ b/gcc/testsuite/gfortran.dg/goacc/routine-7.f90
>> @@ -0,0 +1,69 @@
>> +! Test acc routines inside modules.
>> +
>> +! { dg-additional-options "-O0" }
> 
> -O0 to prevent inlining of functions tagged with OpenACC routine
> directives, or another reason?

I'm not sure why, but that's probably it.

>> --- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
>> +++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
>> @@ -1,121 +1,95 @@
>> +! Test acc routines inside modules.
>>  
>>  ! { dg-do run }
>> -! { dg-additional-options "-cpp" }
>>  
>> -#define M 8
>> -#define N 32
>> +module routines
>> +  integer, parameter :: N = 32
>>  
>> -program main
>> -  integer :: i
>> -  integer :: a(N)
>> -  integer :: b(M * N)
>> -
>> -  do i = 1, N
>> -    a(i) = 0
>> -  end do
>> +contains
>> +  subroutine vector (a)
>> +    implicit none
>> +    !$acc routine vector
>> +    integer, intent (inout) :: a(N)
>> +    integer :: i
>> [...]
> 
> This seems to completely rewrite the test case.  Is that intentional, or
> should the original test case be preserved, and the changed/new/rewritten
> one be added as a new test case?

The original test was completely bogus because it had a lot of race
conditions when writing to variables. I could restore it, but then you'd
need to remove all of the gang, worker, vector clauses and force it to
run in seq. But that would defeat the intent behind the patch.

> Now, my hacky WIP patch.
> 
> One big chunk of the gcc/fortran/gfortran.h changes is just to move some
> stuff around, without any changes, so that I can use "locus" in
> "symbol_attribute".

I agree with Jakub about creating a new gfc_acc_routine struct to
contain the locus and clauses for acc routines. That way, you can also
link them together for device_type.

But at the same time, since device_type isn't a priority for in the near
term, we might be better off using the existing oacc_function and nohost
attribute bits instead of introducing a new struct.

> I very much "cargo cult"ed all that "oacc_routine*" bit flag stuff in
> module.c/symbol.c, replicating what's being done for "omp target
> declare", without really knowing what I'm doing there.  I will appreciate
> test cases actually exercising this code -- which doesn't currently at
> all handle the new "locus omp_clauses_locus" and "struct symbol_attribute
> *next" members that I'm adding to "symbol_attribute", as I've mentioned
> before.  (But I suppose it should?)
> 
> We're not implementing the OpenACC device_type clause at the moment, so
> the "TODO: handle device_type clauses" comment in
> gcc/fortran/openmp.c:gfc_match_oacc_routine is not a concern right now.
> 
> With these changes, we're now actually also paying attention the clauses
> specified with the OpenACC routine directive with a name -- one of the
> things mentioned as missing in <http://gcc.gnu.org/PR72741> "Fortran
> OpenACC routine directive doesn't properly handle clauses specifying the
> level of parallelism".
> 
> To handle several "pending" OpenACC routine directives, I had to add the
> "struct symbol_attribute *next" member to "symbol_attribute" -- I hope
> that doesn't disqualify the proposed changes as too ugly.  (Several other
> structs already contain such "next" pointers, and the use is very much
> confined to only the OpenACC routine directive.)  I will of course be
> happy to learn about a better/different way to do this.
> 
> commit ca4a098dab72f27c6e1121aa7e5e49764921974e
> Author: Thomas Schwinge <thomas@codesourcery.com>
> Date:   Thu Aug 11 16:34:22 2016 +0200
> 
>     [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling

>  /* Structure and list of supported extension attributes.  */
>  typedef enum
>  {
> @@ -729,7 +839,7 @@ ext_attr_t;
>  extern const ext_attr_t ext_attr_list[];
>  
>  /* Symbol attribute structure.  */
> -typedef struct
> +typedef struct symbol_attribute
>  {
>    /* Variable attributes.  */
>    unsigned allocatable:1, dimension:1, codimension:1, external:1, intrinsic:1,
> @@ -864,6 +974,13 @@ typedef struct
>    /* Mentioned in OMP DECLARE TARGET.  */
>    unsigned omp_declare_target:1;
>  
> +  /* OpenACC routine.  */
> +  unsigned oacc_routine:1;
> +  unsigned oacc_routine_gang:1;
> +  unsigned oacc_routine_worker:1;
> +  unsigned oacc_routine_vector:1;
> +  unsigned oacc_routine_seq:1;
> +
>    /* Mentioned in OACC DECLARE.  */
>    unsigned oacc_declare_create:1;
>    unsigned oacc_declare_copyin:1;
> @@ -871,137 +988,24 @@ typedef struct
>    unsigned oacc_declare_device_resident:1;
>    unsigned oacc_declare_link:1;
>  
> -  /* This is an OpenACC acclerator function at level N - 1  */
> -  ENUM_BITFIELD (oacc_function) oacc_function:3;
> -

I'm not sure what's better from a stylistic standpoint. Personally, I'd
prefer if all of these extra bits were coalesced into an oacc_routine
and oacc_declare enums. At least for acc routines, gang, worker, vector
and seq are all mutually exclusive.

> +++ gcc/fortran/module.c
> @@ -1986,6 +1986,7 @@ enum ab_attribute
>    AB_IS_CLASS, AB_PROCEDURE, AB_PROC_POINTER, AB_ASYNCHRONOUS, AB_CODIMENSION,
>    AB_COARRAY_COMP, AB_VTYPE, AB_VTAB, AB_CONTIGUOUS, AB_CLASS_POINTER,
>    AB_IMPLICIT_PURE, AB_ARTIFICIAL, AB_UNLIMITED_POLY, AB_OMP_DECLARE_TARGET,
> +  AB_OACC_ROUTINE, AB_OACC_ROUTINE_GANG, AB_OACC_ROUTINE_WORKER, AB_OACC_ROUTINE_VECTOR, AB_OACC_ROUTINE_SEQ,
>    AB_ARRAY_OUTER_DEPENDENCY, AB_MODULE_PROCEDURE, AB_OACC_DECLARE_CREATE,
>    AB_OACC_DECLARE_COPYIN, AB_OACC_DECLARE_DEVICEPTR,
>    AB_OACC_DECLARE_DEVICE_RESIDENT, AB_OACC_DECLARE_LINK
> @@ -2044,6 +2045,11 @@ static const mstring attr_bits[] =
>      minit ("IMPLICIT_PURE", AB_IMPLICIT_PURE),
>      minit ("UNLIMITED_POLY", AB_UNLIMITED_POLY),
>      minit ("OMP_DECLARE_TARGET", AB_OMP_DECLARE_TARGET),
> +    minit ("OACC_ROUTINE", AB_OACC_ROUTINE),
> +    minit ("OACC_ROUTINE_GANG", AB_OACC_ROUTINE_GANG),
> +    minit ("OACC_ROUTINE_WORKER", AB_OACC_ROUTINE_WORKER),
> +    minit ("OACC_ROUTINE_VECTOR", AB_OACC_ROUTINE_VECTOR),
> +    minit ("OACC_ROUTINE_SEQ", AB_OACC_ROUTINE_SEQ),
>      minit ("ARRAY_OUTER_DEPENDENCY", AB_ARRAY_OUTER_DEPENDENCY),
>      minit ("MODULE_PROCEDURE", AB_MODULE_PROCEDURE),
>      minit ("OACC_DECLARE_CREATE", AB_OACC_DECLARE_CREATE),
> @@ -2095,7 +2101,6 @@ DECL_MIO_NAME (procedure_type)
>  DECL_MIO_NAME (ref_type)
>  DECL_MIO_NAME (sym_flavor)
>  DECL_MIO_NAME (sym_intent)
> -DECL_MIO_NAME (oacc_function)
>  #undef DECL_MIO_NAME
>  
>  /* Symbol attributes are stored in list with the first three elements
> @@ -2117,8 +2122,6 @@ mio_symbol_attribute (symbol_attribute *attr)
>    attr->proc = MIO_NAME (procedure_type) (attr->proc, procedures);
>    attr->if_source = MIO_NAME (ifsrc) (attr->if_source, ifsrc_types);
>    attr->save = MIO_NAME (save_state) (attr->save, save_status);
> -  attr->oacc_function = MIO_NAME (oacc_function) (attr->oacc_function,
> -						  oacc_function_types);
>  
>    ext_attr = attr->ext_attr;
>    mio_integer ((int *) &ext_attr);
> @@ -2236,6 +2239,16 @@ mio_symbol_attribute (symbol_attribute *attr)
>  	MIO_NAME (ab_attribute) (AB_VTAB, attr_bits);
>        if (attr->omp_declare_target)
>  	MIO_NAME (ab_attribute) (AB_OMP_DECLARE_TARGET, attr_bits);
> +      if (attr->oacc_routine)
> +	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE, attr_bits);
> +      if (attr->oacc_routine_gang)
> +	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_GANG, attr_bits);
> +      if (attr->oacc_routine_worker)
> +	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_WORKER, attr_bits);
> +      if (attr->oacc_routine_vector)
> +	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_VECTOR, attr_bits);
> +      if (attr->oacc_routine_seq)
> +	MIO_NAME (ab_attribute) (AB_OACC_ROUTINE_SEQ, attr_bits);
>        if (attr->array_outer_dependency)
>  	MIO_NAME (ab_attribute) (AB_ARRAY_OUTER_DEPENDENCY, attr_bits);
>        if (attr->module_procedure)
> @@ -2422,6 +2435,21 @@ mio_symbol_attribute (symbol_attribute *attr)
>  	    case AB_OMP_DECLARE_TARGET:
>  	      attr->omp_declare_target = 1;
>  	      break;
> +	    case AB_OACC_ROUTINE:
> +	      attr->oacc_routine = 1;
> +	      break;
> +	    case AB_OACC_ROUTINE_GANG:
> +	      attr->oacc_routine_gang = 1;
> +	      break;
> +	    case AB_OACC_ROUTINE_WORKER:
> +	      attr->oacc_routine_worker = 1;
> +	      break;
> +	    case AB_OACC_ROUTINE_VECTOR:
> +	      attr->oacc_routine_vector = 1;
> +	      break;
> +	    case AB_OACC_ROUTINE_SEQ:
> +	      attr->oacc_routine_seq = 1;
> +	      break;
>  	    case AB_ARRAY_OUTER_DEPENDENCY:
>  	      attr->array_outer_dependency =1;
>  	      break;

That seems similar to what my patch is did, albeit with some checking
deferred. I don't think this would maintain backwards compatibility with
object files generated by older versions of gcc.

Regarding backwards compatibility, maybe we should teach gfortran to
default to seq parallelism if an oacc_function attribute is missing in
an older version of the .mod file? I'm not sure if there's anything we
can do about forwards compatibility, i.e., linking a module generated by
gcc7 with gcc6.

> diff --git gcc/fortran/openmp.c gcc/fortran/openmp.c
> index 05e4661..5a69e38 100644
> --- gcc/fortran/openmp.c
> +++ gcc/fortran/openmp.c
> @@ -1714,44 +1714,6 @@ gfc_match_oacc_cache (void)
>    return MATCH_YES;
>  }
>  
> -/* Determine the loop level for a routine.  Returns OACC_FUNCTION_NONE if
> -   any error is detected.  */
> -
> -static oacc_function
> -gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
> -{
> -  int level = -1;
> -  oacc_function ret = OACC_FUNCTION_SEQ;
> -
> -  if (clauses)
> -    {
> -      unsigned mask = 0;
> -
> -      if (clauses->gang)
> -	{
> -	  level = GOMP_DIM_GANG, mask |= GOMP_DIM_MASK (level);
> -	  ret = OACC_FUNCTION_GANG;
> -	}
> -      if (clauses->worker)
> -	{
> -	  level = GOMP_DIM_WORKER, mask |= GOMP_DIM_MASK (level);
> -	  ret = OACC_FUNCTION_WORKER;
> -	}
> -      if (clauses->vector)
> -	{
> -	  level = GOMP_DIM_VECTOR, mask |= GOMP_DIM_MASK (level);
> -	  ret = OACC_FUNCTION_VECTOR;
> -	}
> -      if (clauses->seq)
> -	level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
> -
> -      if (mask != (mask & -mask))
> -	ret = OACC_FUNCTION_NONE;
> -    }
> -
> -  return ret;
> -}
> -
>  match
>  gfc_match_oacc_routine (void)
>  {
> @@ -1761,7 +1723,8 @@ gfc_match_oacc_routine (void)
>    gfc_omp_clauses *c = NULL;
>    gfc_oacc_routine_name *n = NULL;
>    gfc_intrinsic_sym *isym = NULL;
> -  oacc_function dims = OACC_FUNCTION_NONE;
> +  symbol_attribute *add_attr = NULL;
> +  const char *add_attr_name = NULL;
>  
>    old_loc = gfc_current_locus;
>  
> @@ -1828,19 +1791,26 @@ gfc_match_oacc_routine (void)
>  	  != MATCH_YES))
>      return MATCH_ERROR;
>  
> -  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;
> -    }
> -
>    if (isym != NULL)
> -    /* There is nothing to do for intrinsic procedures.  */
> -    ;
> +    {
> +      //TODO gfc_intrinsic_sym doesn't have symbol_attribute?
> +      //add_attr = &isym->attr;
> +      //add_attr_name = NULL; //TODO
> +      /* Fake it.  TODO: handle device_type clauses...  */
> +      if (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");
> +	  gfc_current_locus = old_loc;
> +	  return MATCH_ERROR;
> +	}
> +    }
>    else if (sym != NULL)
>      {
> +      add_attr = &sym->attr;
> +      add_attr_name = NULL; //TODO
> +
>        n = gfc_get_oacc_routine_name ();
>        n->sym = sym;
>        n->clauses = NULL;
> @@ -1852,11 +1822,41 @@ gfc_match_oacc_routine (void)
>      }
>    else if (gfc_current_ns->proc_name)
>      {
> -      if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
> -				       gfc_current_ns->proc_name->name,
> -				       &old_loc))
> +      add_attr = &gfc_current_ns->proc_name->attr;
> +      add_attr_name = gfc_current_ns->proc_name->name;
> +    }
> +  else
> +    gcc_unreachable ();
> +
> +  if (add_attr != NULL)
> +    {
> +      if (!gfc_add_omp_declare_target (add_attr, add_attr_name, &old_loc))
>  	goto cleanup;
> -      gfc_current_ns->proc_name->attr.oacc_function = dims;
> +      /* Skip over any existing symbol attributes capturing OpenACC routine
> +	 directives.  */
> +      while (add_attr->next != NULL)
> +	add_attr = add_attr->next;
> +      if (add_attr->oacc_routine)
> +	{
> +	  add_attr->next = XCNEW (symbol_attribute);
> +	  gfc_clear_attr (add_attr->next);
> +	  add_attr = add_attr->next;
> +	}
> +      if (!gfc_add_oacc_routine (add_attr, add_attr_name, &old_loc))
> +	goto cleanup;
> +      if (c && c->gang
> +	  && !gfc_add_oacc_routine_gang (add_attr, add_attr_name, &old_loc))
> +	goto cleanup;
> +      if (c && c->worker
> +	  && !gfc_add_oacc_routine_worker (add_attr, add_attr_name, &old_loc))
> +	goto cleanup;
> +      if (c && c->vector
> +	  && !gfc_add_oacc_routine_vector (add_attr, add_attr_name, &old_loc))
> +	goto cleanup;
> +      if (c && c->seq
> +	  && !gfc_add_oacc_routine_seq (add_attr, add_attr_name, &old_loc))
> +	goto cleanup;
> +      add_attr->omp_clauses_locus = old_loc; //TODO OK to just assign that?
>      }

This is another stylistic thing I don't like. Instead of having a single
function for mutually exclusive attributes, you need five. And each of
those functions are extremely similar, and I copy and paste issues when
dealing with such functions in the past.

With that in mind, I do see some value in preserving the routine clauses
and location information for device_type. But I thought that device_type
was more of a future project.

Cesar

[-- Attachment #2: module-test.tar --]
[-- Type: application/x-tar, Size: 10240 bytes --]

^ permalink raw reply	[flat|nested] 15+ messages in thread

* Re: [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling
  2016-08-11 16:27         ` Thomas Schwinge
  2016-08-11 16:42           ` Jakub Jelinek
@ 2016-08-16  1:55           ` Cesar Philippidis
  2016-08-16 22:17             ` Thomas Schwinge
  2019-02-28 20:37             ` [PR72741, PR89433] Repeated use of the Fortran OpenACC 'routine' directive Thomas Schwinge
  1 sibling, 2 replies; 15+ messages in thread
From: Cesar Philippidis @ 2016-08-16  1:55 UTC (permalink / raw)
  To: Thomas Schwinge, Jakub Jelinek; +Cc: gcc-patches, Fortran List, Tobias Burnus

[-- Attachment #1: Type: text/plain, Size: 2868 bytes --]

On 08/11/2016 09:26 AM, Thomas Schwinge wrote:

> As Cesar asked for it, there is now a Git branch
> tschwinge/omp/pr72741-wip containing these changes (plus some other
> pending changes that I didn't single out at this time), at
> <https://gcc.gnu.org/git/?p=gcc.git;a=shortlog;h=refs/heads/tschwinge/omp/pr72741-wip>.
> (I expect it does, but I didn't verify that this actually builds; I have
> further changes on top of that.)  Cesar, please tell me if you'd like me
> to push this to GitHub, in case you want to use their review/commentary
> functions, or the like.

No, that git repository is fine.

> On Thu, 11 Aug 2016 17:40:26 +0200, Jakub Jelinek <jakub@redhat.com> wrote:
>> On Thu, Aug 11, 2016 at 05:18:43PM +0200, Thomas Schwinge wrote:
>>> --- gcc/fortran/gfortran.h
>>> +++ gcc/fortran/gfortran.h
> 
>>>  /* Symbol attribute structure.  */
>>> -typedef struct
>>> +typedef struct symbol_attribute
>>>  {
> 
>> While symbol_attribute is already bloated, I don't like bloating it this
>> much further.  Do you really need it for all symbols, or just all subroutines?
> 
> Certainly not for all symbole; just for what is valid to be used with the
> OpenACC routine directive, which per OpenACC 2.0a, 2.13.1 Routine
> Directive is:
> 
>     In Fortran the syntax of the routine directive is:
>         !$acc routine clause-list
>         !$acc routine( name ) clause-list
>     In Fortran, the routine directive without a name may appear within the specification part of a subroutine or function definition, or within an interface body for a subroutine or function in an interface block, and applies to the containing subroutine or function. The routine directive with a name may appear in the specification part of a subroutine, function or module, and applies to the named subroutine or function.
> 
> (Pasting that in full just in case that contains some additional Fortran
> lingo, meaning more than "subroutines".)

I'm avoided that problem in this patch. For the moment, I'm ignoring the
device_type problem and handling all of the matching errors in
gfc_match_oacc_routine. You're patch was handling those errors in
add_attributes_to_decls, which I think is too late.

device_type will require extra handling down the road. But instead of
introducing new attributes, we can just use the existing
gfc_oacc_routine_name struct to capture and chain all of the clauses for
all of the different device_types. Then we can teach
add_attributes_to_decls to call gfc_oacc_routine_dims to generate the
appropriate OACC_FUNCTION attribute for a given set of device_type clauses.

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.

Thomas, does this patch ok to you for gomp4?

Cesar

[-- Attachment #2: pr72741-gomp4.diff --]
[-- Type: text/x-patch, Size: 13085 bytes --]

2016-08-15  Cesar Philippidis  <cesar@codesourcery.com>

	gcc/fortran/
	* openmp.c (gfc_match_oacc_routine): Error on repeated ACC ROUTINE
	directives.  Consider the optional NAME argument being the current
	procedure name.
	* trans-decl.c (add_attributes_to_decl): Use build_oacc_routine_dims
	to construct the oacc_function attribute arguments.

	gcc/testsuite/
	* gfortran.dg/goacc/pr72741-2.f: New test.
	* gfortran.dg/goacc/pr72741-intrinsic-1.f: Add test coverage.
	* gfortran.dg/goacc/pr72741-intrinsic-2.f: Likewise.
	* gfortran.dg/goacc/pr72741.f90: Likewise.


diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 80f46c0..cb8efb8 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -1877,8 +1877,9 @@ gfc_match_oacc_cache (void)
   return MATCH_YES;
 }
 
-/* Determine the loop level for a routine.  Returns OACC_FUNCTION_NONE if
-   any error is detected.  */
+/* Determine the loop level for a routine.  Returns OACC_FUNCTION_NONE
+   if any error is detected.  Note that this function needs to be
+   called repeatedly for each DEVICE_TYPE.  */
 
 static oacc_function
 gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
@@ -1925,6 +1926,7 @@ gfc_match_oacc_routine (void)
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
   oacc_function dims = OACC_FUNCTION_NONE;
+  bool seen_error = false;
 
   old_loc = gfc_current_locus;
 
@@ -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
         {
@@ -1993,19 +2002,24 @@ 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 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;
     }
 
   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");
+	  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
@@ -2013,24 +2027,59 @@ 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 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 ();
+	  n->sym = sym;
+	  n->clauses = c;
+	  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;
+	}
+
+      if (seen_error)
+	goto cleanup;
     }
   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;
+	}
+
       if (!gfc_add_omp_declare_target (&gfc_current_ns->proc_name->attr,
 				       gfc_current_ns->proc_name->name,
 				       &old_loc))
 	goto cleanup;
-      gfc_current_ns->proc_name->attr.oacc_function = dims;
+
+      gfc_current_ns->proc_name->attr.oacc_function
+	= seen_error ? OACC_FUNCTION_SEQ : dims;
       gfc_current_ns->proc_name->attr.oacc_function_nohost
 	= c ? c->nohost : false;
+
+      if (seen_error)
+	goto cleanup;
     }
   else
     gcc_unreachable ();
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 5271268..785212f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -45,6 +45,7 @@ along with GCC; see the file COPYING3.  If not see
 /* Only for gfc_trans_code.  Shouldn't need to include this.  */
 #include "trans-stmt.h"
 #include "gomp-constants.h"
+#include "omp-low.h"
 
 #define MAX_LABEL_VALUE 99999
 
@@ -1329,29 +1330,27 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
 
   if (sym_attr.oacc_function != OACC_FUNCTION_NONE)
     {
-      tree dims = NULL_TREE;
-      int ix;
-      int level = GOMP_DIM_MAX;
-
+      omp_clause_code code = OMP_CLAUSE_ERROR;
+      tree clause, dims;
+      
       switch (sym_attr.oacc_function)
 	{
 	case OACC_FUNCTION_GANG:
-	  level = GOMP_DIM_GANG;
+	  code = OMP_CLAUSE_GANG;
 	  break;
 	case OACC_FUNCTION_WORKER:
-	  level = GOMP_DIM_WORKER;
+	  code = OMP_CLAUSE_WORKER;
 	  break;
 	case OACC_FUNCTION_VECTOR:
-	  level = GOMP_DIM_VECTOR;
+	  code = OMP_CLAUSE_VECTOR;
 	  break;
 	case OACC_FUNCTION_SEQ:
-	default:;
+	default:
+	  code = OMP_CLAUSE_SEQ;
 	}
 
-      for (ix = GOMP_DIM_MAX; ix--;)
-	dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
-			  integer_zero_node, dims);
-
+      clause = build_omp_clause (UNKNOWN_LOCATION, code);
+      dims = build_oacc_routine_dims (clause);
       list = tree_cons (get_identifier ("oacc function"),
 			dims, list);
     }
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 0000000..5865144
--- /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
index 4bff3e3..d84cdf9 100644
--- 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" }
 
       CALL ABORT
       END SUBROUTINE sub_1
 
       MODULE m_w_1
       IMPLICIT NONE
-!$ACC ROUTINE (ABORT) SEQ
-!$ACC ROUTINE (ABORT)
+!$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
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f b/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
index fed8e76..e5e3794 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
+++ b/gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
@@ -2,18 +2,18 @@
 
       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" }
+!$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 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" }
+!$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
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr72741.f90 b/gcc/testsuite/gfortran.dg/goacc/pr72741.f90
index cf89727..3fbd94f 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr72741.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr72741.f90
@@ -1,12 +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" }
+  !$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
@@ -17,7 +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" }
+  !$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

^ permalink raw reply	[flat|nested] 15+ messages in thread

* Re: [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling
  2016-08-16  1:55           ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling Cesar Philippidis
@ 2016-08-16 22:17             ` Thomas Schwinge
  2019-02-28 20:37             ` [PR72741, PR89433] Repeated use of the Fortran OpenACC 'routine' directive Thomas Schwinge
  1 sibling, 0 replies; 15+ messages in thread
From: Thomas Schwinge @ 2016-08-16 22:17 UTC (permalink / raw)
  To: Cesar Philippidis; +Cc: gcc-patches, Fortran List, Tobias Burnus, Jakub Jelinek

Hi!

On Mon, 15 Aug 2016 18:54:49 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
> For the moment, I'm ignoring the
> device_type problem and handling all of the matching errors in
> gfc_match_oacc_routine.

OK for the moment; my idea has been to do it generally enough already
now, using generic infrastructure I have been/will be adding for C/C++,
so that device_type support will later be simple to implement for all
three front ends.  But, let's leave that aside for the moment.

> You're patch was handling those errors in
> add_attributes_to_decls, which I think is too late.

I can't tell why that's "too late".  Anyway, we can save this discussion
for later.  ;-)

> Thomas, does this patch ok to you for gomp4?

Yes, please commit, so that we can move this whole thing forward.  :-)

A few quick comments anyway:

> --- a/gcc/fortran/openmp.c
> +++ b/gcc/fortran/openmp.c
> @@ -1993,19 +2002,24 @@ gfc_match_oacc_routine (void)

>    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;
>      }

Hmm, I don't know if that's really important?  I mean, if we run into
"Multiple loop axes specified", that is a hard semantic error already?
Anyway, this can be reconsidered later.

>    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");
> +	  gfc_error ("Intrinsic symbol specified in !$ACC ROUTINE ( NAME ) "
> +		     "at %C, with incompatible clauses specifying the level "
> +		     "of parallelism");
>  	  goto cleanup;
>  	}

You're re-introducing the wording I had used earlier, before I changed
that to the more specific one mentioning the clause names.  Why change
that again?  Also something the can be reconsidered later.  (Goes
together with the gcc/testsuite/gfortran.dg/goacc/pr72741-intrinsic-2.f
changes.)

> --- 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" }
>  
>        CALL ABORT
>        END SUBROUTINE sub_1
>  
>        MODULE m_w_1
>        IMPLICIT NONE
> -!$ACC ROUTINE (ABORT) SEQ
> -!$ACC ROUTINE (ABORT)
> +!$ACC ROUTINE (ABORT) VECTOR GANG ! { dg-error "Intrinsic symbol specified in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), with incompatible clauses specifying the level of parallelism" }

This changes the intention of this test file?  Another thing that can be
reconsidered later.

So, please commit as-is, and I'll then base my other changes on top of
that.


Grüße
 Thomas

^ permalink raw reply	[flat|nested] 15+ messages in thread

* [PR72741] For all Fortran OpenACC 'routine' directive variants check for multiple clauses specifying the level of parallelism
  2016-07-29  4:21 ` [gomp4] Fix PR72741 Cesar Philippidis
  2016-07-01 20:41   ` [PATCH] OpenACC routines in fortran modules Cesar Philippidis
@ 2019-02-28 20:35   ` Thomas Schwinge
  1 sibling, 0 replies; 15+ messages in thread
From: Thomas Schwinge @ 2019-02-28 20:35 UTC (permalink / raw)
  To: gcc-patches, fortran


[-- Attachment #1.1: Type: text/plain, Size: 540 bytes --]

Hi!

On Thu, 28 Jul 2016 21:21:29 -0700, Cesar Philippidis <cesar@codesourcery.com> wrote:
> Thomas found a bug in the fortran routine parser where errors involving
> invalid combinations of gang, worker, vector and seq clauses were
> getting suppressed.  [...]
> This bug is also present in trunk, but [...]

Re-worked a bit, and committed to trunk in r269286 "[PR72741] For all
Fortran OpenACC 'routine' directive variants check for multiple clauses
specifying the level of parallelism", as attached.


Grüße
 Thomas



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0002-PR72741-For-all-Fortran-OpenACC-routine-directive-va.patch --]
[-- Type: text/x-diff, Size: 5987 bytes --]

From 7378dd70e000e78ba7a266349077ab6ef36b5c62 Mon Sep 17 00:00:00 2001
From: tschwinge <tschwinge@138bc75d-0d04-0410-961f-82ee72b054a4>
Date: Thu, 28 Feb 2019 20:31:23 +0000
Subject: [PATCH 2/3] [PR72741] For all Fortran OpenACC 'routine' directive
 variants check for multiple clauses specifying the level of parallelism

	gcc/fortran/
	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.
	* trans-decl.c (add_attributes_to_decl): Likewise.
	gcc/testsuite/
	PR fortran/72741
	* gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90: New file.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@269286 138bc75d-0d04-0410-961f-82ee72b054a4
---
 gcc/fortran/ChangeLog                         |  5 +++
 gcc/fortran/gfortran.h                        |  3 +-
 gcc/fortran/openmp.c                          | 13 ++++++--
 gcc/fortran/trans-decl.c                      |  1 +
 gcc/testsuite/ChangeLog                       |  3 ++
 .../goacc/routine-multiple-lop-clauses-1.f90  | 32 +++++++++++++++++++
 6 files changed, 53 insertions(+), 4 deletions(-)
 create mode 100644 gcc/testsuite/gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 78c6324d1b83..1c8f71252980 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
+	* gfortran.h (enum oacc_routine_lop): Add OACC_ROUTINE_LOP_ERROR.
+	* openmp.c (gfc_oacc_routine_lop, gfc_match_oacc_routine): Use it.
+	* trans-decl.c (add_attributes_to_decl): Likewise.
+
 	PR fortran/72741
 	PR fortran/89433
 	* openmp.c (gfc_match_oacc_routine): Accept intrinsic symbols.
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index f0258b39ffd1..3e0f634c3a8e 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -323,7 +323,8 @@ enum oacc_routine_lop
   OACC_ROUTINE_LOP_GANG,
   OACC_ROUTINE_LOP_WORKER,
   OACC_ROUTINE_LOP_VECTOR,
-  OACC_ROUTINE_LOP_SEQ
+  OACC_ROUTINE_LOP_SEQ,
+  OACC_ROUTINE_LOP_ERROR
 };
 
 /* Strings for all symbol attributes.  We use these for dumping the
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 6999ac34a1a9..50b91f2150ab 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2265,7 +2265,7 @@ gfc_oacc_routine_lop (gfc_omp_clauses *clauses)
 	}
 
       if (n_lop_clauses > 1)
-	gfc_error ("Multiple loop axes specified for routine");
+	ret = OACC_ROUTINE_LOP_ERROR;
     }
 
   return ret;
@@ -2280,6 +2280,7 @@ gfc_match_oacc_routine (void)
   gfc_symbol *sym = NULL;
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
+  oacc_routine_lop lop = OACC_ROUTINE_LOP_NONE;
 
   old_loc = gfc_current_locus;
 
@@ -2352,6 +2353,13 @@ gfc_match_oacc_routine (void)
 	  != MATCH_YES))
     return MATCH_ERROR;
 
+  lop = gfc_oacc_routine_lop (c);
+  if (lop == OACC_ROUTINE_LOP_ERROR)
+    {
+      gfc_error ("Multiple loop axes specified for routine at %C");
+      goto cleanup;
+    }
+
   if (isym != NULL)
     {
       /* Diagnose any OpenACC 'routine' directive that doesn't match the
@@ -2381,8 +2389,7 @@ gfc_match_oacc_routine (void)
 				       gfc_current_ns->proc_name->name,
 				       &old_loc))
 	goto cleanup;
-      gfc_current_ns->proc_name->attr.oacc_routine_lop
-	= gfc_oacc_routine_lop (c);
+      gfc_current_ns->proc_name->attr.oacc_routine_lop = lop;
     }
   else
     /* Something has gone wrong, possibly a syntax error.  */
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 20d453051a29..36b7fdd2701f 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -1425,6 +1425,7 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
 	  code = OMP_CLAUSE_SEQ;
 	  break;
 	case OACC_ROUTINE_LOP_NONE:
+	case OACC_ROUTINE_LOP_ERROR:
 	default:
 	  gcc_unreachable ();
 	}
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index c45e7b7546a9..9f4c598951c3 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,6 +1,9 @@
 2019-02-28  Thomas Schwinge  <thomas@codesourcery.com>
 	    Cesar Philippidis  <cesar@codesourcery.com>
 
+	PR fortran/72741
+	* gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90: New file.
+
 	PR fortran/72741
 	PR fortran/89433
 	* gfortran.dg/goacc/routine-6.f90: Update
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90
new file mode 100644
index 000000000000..8ca9be822ea5
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-multiple-lop-clauses-1.f90
@@ -0,0 +1,32 @@
+! Check for multiple clauses specifying the level of parallelism.
+
+SUBROUTINE v_1
+  !$ACC ROUTINE VECTOR WORKER ! { dg-error "Multiple loop axes specified for routine" }
+END SUBROUTINE v_1
+
+SUBROUTINE sub_1
+  IMPLICIT NONE
+  EXTERNAL :: g_1
+  !$ACC ROUTINE (g_1) GANG WORKER ! { dg-error "Multiple loop axes specified for routine" }
+  !$ACC ROUTINE (ABORT) SEQ WORKER GANG VECTOR ! { dg-error "Multiple loop axes specified for routine" }
+  !$ACC ROUTINE WORKER SEQ ! { dg-error "Multiple loop axes specified for routine" }
+
+  CALL v_1
+  CALL g_1
+  CALL ABORT
+END SUBROUTINE sub_1
+
+MODULE m_w_1
+  IMPLICIT NONE
+  EXTERNAL :: w_1
+  !$ACC ROUTINE VECTOR GANG SEQ ! { dg-error "Multiple loop axes specified for routine" }
+  !$ACC ROUTINE (w_1) GANG WORKER SEQ ! { dg-error "Multiple loop axes specified for routine" }
+  !$ACC ROUTINE (ABORT) VECTOR GANG ! { dg-error "Multiple loop axes specified for routine" }
+
+CONTAINS
+  SUBROUTINE sub_2
+    CALL v_1
+    CALL w_1
+    CALL ABORT
+  END SUBROUTINE sub_2
+END MODULE m_w_1
-- 
2.17.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 658 bytes --]

^ permalink raw reply	[flat|nested] 15+ messages in thread

* [PR72741, PR89433] Repeated use of the Fortran OpenACC 'routine' directive
  2016-08-16  1:55           ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling Cesar Philippidis
  2016-08-16 22:17             ` Thomas Schwinge
@ 2019-02-28 20:37             ` Thomas Schwinge
  2019-03-21 19:57               ` Thomas Schwinge
  1 sibling, 1 reply; 15+ messages in thread
From: Thomas Schwinge @ 2019-02-28 20:37 UTC (permalink / raw)
  Cc: gcc-patches, fortran


[-- Attachment #1.1: Type: text/plain, Size: 3421 bytes --]

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



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0003-PR72741-PR89433-Repeated-use-of-the-Fortran-OpenACC-.patch --]
[-- Type: text/x-diff, Size: 9296 bytes --]

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


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 658 bytes --]

^ permalink raw reply	[flat|nested] 15+ messages in thread

* Re: [PR72741, PR89433] Repeated use of the Fortran OpenACC 'routine' directive
  2019-02-28 20:37             ` [PR72741, PR89433] Repeated use of the Fortran OpenACC 'routine' directive Thomas Schwinge
@ 2019-03-21 19:57               ` Thomas Schwinge
  0 siblings, 0 replies; 15+ messages in thread
From: Thomas Schwinge @ 2019-03-21 19:57 UTC (permalink / raw)
  To: gcc-patches, fortran


[-- Attachment #1.1: Type: text/plain, Size: 1706 bytes --]

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



[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #1.2: 0001-PR72741-The-name-in-a-Fortran-OpenACC-routine-.trunk.patch --]
[-- Type: text/x-diff, Size: 2980 bytes --]

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
 
-- 
2.17.1


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 658 bytes --]

^ permalink raw reply	[flat|nested] 15+ messages in thread

end of thread, other threads:[~2019-03-21 19:57 UTC | newest]

Thread overview: 15+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2016-07-28  2:54 [gomp4] encode acc routine clauses inside fortran module files Cesar Philippidis
2016-07-29  4:21 ` [gomp4] Fix PR72741 Cesar Philippidis
2016-07-01 20:41   ` [PATCH] OpenACC routines in fortran modules Cesar Philippidis
2016-07-28  9:55     ` Tobias Burnus
2016-07-28 21:33       ` Cesar Philippidis
2016-08-11 15:19     ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling (was: [PATCH] OpenACC routines in fortran modules) Thomas Schwinge
2016-08-11 15:40       ` Jakub Jelinek
2016-08-11 16:27         ` Thomas Schwinge
2016-08-11 16:42           ` Jakub Jelinek
2016-08-16  1:55           ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling Cesar Philippidis
2016-08-16 22:17             ` Thomas Schwinge
2019-02-28 20:37             ` [PR72741, PR89433] Repeated use of the Fortran OpenACC 'routine' directive Thomas Schwinge
2019-03-21 19:57               ` Thomas Schwinge
2016-08-11 16:44       ` [WIP] [PR fortran/72741] Rework Fortran OpenACC routine clause handling Cesar Philippidis
2019-02-28 20:35   ` [PR72741] For all Fortran OpenACC 'routine' directive variants check for multiple clauses specifying the level of parallelism Thomas Schwinge

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).