[openacc] Teach gfortran to lower OpenACC routine dims

Message ID d28b32ce-15cf-dc2a-99b5-541d8ff28f66@codesourcery.com
State New
Headers show
Series
  • [openacc] Teach gfortran to lower OpenACC routine dims
Related show

Commit Message

Cesar Philippidis Sept. 5, 2018, 7:52 p.m.
At present, gfortran does not encode the gang, worker or vector
parallelism clauses when it creates acc routines dim attribute for
subroutines and functions. While support for acc routine is lacking in
other areas in gfortran (including modules), this patch is important
because it encodes the parallelism attributes using the same function as
the C and C++ FEs. This will become important with the forthcoming nvptx
vector length extensions, because large vectors are not supported in acc
routines yet.

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

Thanks,
Cesar

Comments

Bernhard Reutner-Fischer Sept. 19, 2018, 10:27 p.m. | #1
On Wed, 5 Sep 2018 12:52:03 -0700
Cesar Philippidis <cesar@codesourcery.com> wrote:

> At present, gfortran does not encode the gang, worker or vector

> parallelism clauses when it creates acc routines dim attribute for

> subroutines and functions. While support for acc routine is lacking in

> other areas in gfortran (including modules), this patch is important

> because it encodes the parallelism attributes using the same function

> as the C and C++ FEs. This will become important with the forthcoming

> nvptx vector length extensions, because large vectors are not

> supported in acc routines yet.

> 

> Is this OK for trunk? I regtested and bootstrapped for x86_64 with

> nvptx offloading.


> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c

> index 94a7f7eaa50..d48c9351e25 100644

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

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

> @@ -2234,34 +2234,45 @@ 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 int

> +static oacc_function

>  gfc_oacc_routine_dims (gfc_omp_clauses *clauses)

>  {

>    int level = -1;

> +  oacc_function ret = OACC_FUNCTION_AUTO;

>  

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

> +	{

> +	  level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);

> +	  ret = OACC_FUNCTION_SEQ;

> +	}

>  

>        if (mask != (mask & -mask))

> -	gfc_error ("Multiple loop axes specified for routine");

> +	ret = OACC_FUNCTION_NONE;

>      }

>  

> -  if (level < 0)

> -    level = GOMP_DIM_MAX;

> -

> -  return level;

> +  return ret;

>  }

>  

>  match

> @@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void)

>    match m;

>    gfc_omp_clauses *c = NULL;

>    gfc_oacc_routine_name *n = NULL;

> +  oacc_function dims = OACC_FUNCTION_NONE;


Unneeded initialisation of dims.

> +  bool seen_error = false;

>  

>    old_loc = gfc_current_locus;

>  

> @@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void)

>  	}

>        else

>          {

> -	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");

> -	  gfc_current_locus = old_loc;

> -	  return MATCH_ERROR;

> +	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L",

> &old_loc);

> +	  goto cleanup;

>  	}

>  

>        if (gfc_match_char (')') != MATCH_YES)

>  	{

> -	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C,

> expecting"

> -		     " ')' after NAME");

> -	  gfc_current_locus = old_loc;

> -	  return MATCH_ERROR;

> +	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L,

> expecting"

> +		     " ')' after NAME", &old_loc);

> +	  goto cleanup;

>  	}

>      }

>  

> @@ -2337,26 +2348,83 @@ 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

> %L",

> +		 &old_loc);

> +

> +      /* Don't abort early, because it's important to let the user

> +	 know of any potential duplicate routine directives.  */

> +      seen_error = true;

> +    }

> +  else if (dims == OACC_FUNCTION_AUTO)

> +    {

> +      gfc_warning (0, "Expected one of %<gang%>, %<worker%>,

> %<vector%> or "

> +		   "%<seq%> clauses in !$ACC ROUTINE at %L",

> &old_loc);

> +      dims = OACC_FUNCTION_SEQ;

> +    }

> +

>    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 %L",

> &old_loc);

> +		goto cleanup;

> +	      }

> +	  }

> +

> +      if (needs_entry)

> +	{

> +	  n = gfc_get_oacc_routine_name ();

> +	  n->sym = sym;

> +	  n->clauses = c;

> +	  n->next = NULL;

> +	  n->loc = old_loc;

> +

> +	  if (gfc_current_ns->oacc_routine_names != NULL)

> +	    n->next = gfc_current_ns->oacc_routine_names;


Just omit n->next = NULL above and unconditionally set ->next to current
ns' 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 %L",

> &old_loc);

> +	  goto cleanup;


I'd move both this gfc_error and the one above to a duplicate_routine
label before the cleanup label and jump to that here and for the
identical gfc_error above.
  
> +	}

> +

>        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

> -	= gfc_oacc_routine_dims (c) + 1;

> +	= seen_error ? OACC_FUNCTION_SEQ : dims;


why can't you use dims unconditionally after branching to cleanup if
seen_error? I.e. move the seen_error check below to above the
attr.oacc_function setting?
> +

> +      if (seen_error)

> +	goto cleanup;

>      }

> +  else

> +    /* Something has gone wrong.  Perhaps there was a syntax error

> +       in the program-stmt.  */

> +    goto cleanup;

>  

>    if (n)

>      n->clauses = c;

> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c

> index eea6b81ebfa..eed868f475b 100644

> --- a/gcc/fortran/trans-decl.c

> +++ b/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-general.h"


hmz. so the gomp-constants.h include would be redundant, but do we
really need omp-general.h?
Doesn't this suggest to move this oacc dims lowering to trans-openmp.c
instead, please?

>  

>  #define MAX_LABEL_VALUE 99999

>  

> @@ -1403,16 +1404,29 @@ 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;

> +      omp_clause_code code = OMP_CLAUSE_ERROR;


redundant initialization.

> +      tree clause, dims;

>  

> -      for (ix = GOMP_DIM_MAX; ix--;)

> -	dims = tree_cons (build_int_cst (boolean_type_node, ix >=

> level),

> -			  integer_zero_node, dims);

> +      switch (sym_attr.oacc_function)

> +	{

> +	case OACC_FUNCTION_GANG:

> +	  code = OMP_CLAUSE_GANG;

> +	  break;

> +	case OACC_FUNCTION_WORKER:

> +	  code = OMP_CLAUSE_WORKER;

> +	  break;

> +	case OACC_FUNCTION_VECTOR:

> +	  code = OMP_CLAUSE_VECTOR;

> +	  break;

> +	case OACC_FUNCTION_SEQ:

> +	default:

> +	  code = OMP_CLAUSE_SEQ;

> +	}

>  

> +      clause = build_omp_clause (UNKNOWN_LOCATION, code);

> +      dims = oacc_build_routine_dims (clause);

>        list = tree_cons (get_identifier ("oacc function"),

>  			dims, list);

>      }



btw.. the OACC merge from the gomp4 branch added a copy'n paste error
in an error message. May i ask you to regtest and install the below:

diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index fcfe671be8b..ac1f4fc7619 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -5848,13 +5848,13 @@ resolve_oacc_loop_blocks (gfc_code *code)
 		if (c->code->ext.omp_clauses->worker)
 		  gfc_error ("Loop parallelized across gangs is not
allowed " "inside loop parallelized across workers at %L",
 			     &code->loc);
 		if (c->code->ext.omp_clauses->vector)
 		  gfc_error ("Loop parallelized across gangs is not
allowed "
-			     "inside loop parallelized across workers
at %L",
+			     "inside loop parallelized across vectors
at %L", &code->loc);
 	      }
 	    if (code->ext.omp_clauses->worker)
 	      {
 		if (c->code->ext.omp_clauses->worker)
 		  gfc_error ("Loop parallelized across workers is not
 		  allowed "


thanks,
Cesar Philippidis Sept. 20, 2018, 2:41 p.m. | #2
On 09/19/2018 03:27 PM, Bernhard Reutner-Fischer wrote:
> On Wed, 5 Sep 2018 12:52:03 -0700

> Cesar Philippidis <cesar@codesourcery.com> wrote:

> 

>> At present, gfortran does not encode the gang, worker or vector

>> parallelism clauses when it creates acc routines dim attribute for

>> subroutines and functions. While support for acc routine is lacking in

>> other areas in gfortran (including modules), this patch is important

>> because it encodes the parallelism attributes using the same function

>> as the C and C++ FEs. This will become important with the forthcoming

>> nvptx vector length extensions, because large vectors are not

>> supported in acc routines yet.

>>

>> Is this OK for trunk? I regtested and bootstrapped for x86_64 with

>> nvptx offloading.

> 

>> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c

>> index 94a7f7eaa50..d48c9351e25 100644

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

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

>> @@ -2234,34 +2234,45 @@ 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 int

>> +static oacc_function

>>  gfc_oacc_routine_dims (gfc_omp_clauses *clauses)

>>  {

>>    int level = -1;

>> +  oacc_function ret = OACC_FUNCTION_AUTO;

>>  

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

>> +	{

>> +	  level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);

>> +	  ret = OACC_FUNCTION_SEQ;

>> +	}

>>  

>>        if (mask != (mask & -mask))

>> -	gfc_error ("Multiple loop axes specified for routine");

>> +	ret = OACC_FUNCTION_NONE;

>>      }

>>  

>> -  if (level < 0)

>> -    level = GOMP_DIM_MAX;

>> -

>> -  return level;

>> +  return ret;

>>  }

>>  

>>  match

>> @@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void)

>>    match m;

>>    gfc_omp_clauses *c = NULL;

>>    gfc_oacc_routine_name *n = NULL;

>> +  oacc_function dims = OACC_FUNCTION_NONE;

> 

> Unneeded initialisation of dims.


ACK.

>> +  bool seen_error = false;

>>  

>>    old_loc = gfc_current_locus;

>>  

>> @@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void)

>>  	}

>>        else

>>          {

>> -	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");

>> -	  gfc_current_locus = old_loc;

>> -	  return MATCH_ERROR;

>> +	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L",

>> &old_loc);

>> +	  goto cleanup;

>>  	}

>>  

>>        if (gfc_match_char (')') != MATCH_YES)

>>  	{

>> -	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C,

>> expecting"

>> -		     " ')' after NAME");

>> -	  gfc_current_locus = old_loc;

>> -	  return MATCH_ERROR;

>> +	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L,

>> expecting"

>> +		     " ')' after NAME", &old_loc);

>> +	  goto cleanup;

>>  	}

>>      }

>>  

>> @@ -2337,26 +2348,83 @@ 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

>> %L",

>> +		 &old_loc);

>> +

>> +      /* Don't abort early, because it's important to let the user

>> +	 know of any potential duplicate routine directives.  */

>> +      seen_error = true;

>> +    }

>> +  else if (dims == OACC_FUNCTION_AUTO)

>> +    {

>> +      gfc_warning (0, "Expected one of %<gang%>, %<worker%>,

>> %<vector%> or "

>> +		   "%<seq%> clauses in !$ACC ROUTINE at %L",

>> &old_loc);

>> +      dims = OACC_FUNCTION_SEQ;

>> +    }

>> +

>>    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 %L",

>> &old_loc);

>> +		goto cleanup;

>> +	      }

>> +	  }

>> +

>> +      if (needs_entry)

>> +	{

>> +	  n = gfc_get_oacc_routine_name ();

>> +	  n->sym = sym;

>> +	  n->clauses = c;

>> +	  n->next = NULL;

>> +	  n->loc = old_loc;

>> +

>> +	  if (gfc_current_ns->oacc_routine_names != NULL)

>> +	    n->next = gfc_current_ns->oacc_routine_names;

> 

> Just omit n->next = NULL above and unconditionally set ->next to current

> ns' routine names.


ACK.

>> +

>> +	  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 %L",

>> &old_loc);

>> +	  goto cleanup;

> 

> I'd move both this gfc_error and the one above to a duplicate_routine

> label before the cleanup label and jump to that here and for the

> identical gfc_error above.


I did it this way because we have a forthcoming patch which adds support
for Fortran modules, and that patch has a different set of errors. That
said, I'll incorporate those changes and modify the patch.

>> +	}

>> +

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

>> -	= gfc_oacc_routine_dims (c) + 1;

>> +	= seen_error ? OACC_FUNCTION_SEQ : dims;

> 

> why can't you use dims unconditionally after branching to cleanup if

> seen_error? I.e. move the seen_error check below to above the

> attr.oacc_function setting?


Yeah, it probably doesn't matter much if the function returns
MATCH_ERROR. I'll change it.

>> +

>> +      if (seen_error)

>> +	goto cleanup;

>>      }

>> +  else

>> +    /* Something has gone wrong.  Perhaps there was a syntax error

>> +       in the program-stmt.  */

>> +    goto cleanup;

>>  

>>    if (n)

>>      n->clauses = c;

>> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c

>> index eea6b81ebfa..eed868f475b 100644

>> --- a/gcc/fortran/trans-decl.c

>> +++ b/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-general.h"

> 

> hmz. so the gomp-constants.h include would be redundant, but do we

> really need omp-general.h?


Good point. omp-general.h is required for oacc_build_routine_dims.

> Doesn't this suggest to move this oacc dims lowering to trans-openmp.c

> instead, please?


So something like adding a new gfc_add_omp_offload_attributes to
trans-openmp.c and call it from add_attributes_to_decl?

>>  #define MAX_LABEL_VALUE 99999

>>  

>> @@ -1403,16 +1404,29 @@ 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;

>> +      omp_clause_code code = OMP_CLAUSE_ERROR;

> 

> redundant initialization.


ACK.

>> +      tree clause, dims;

>>  

>> -      for (ix = GOMP_DIM_MAX; ix--;)

>> -	dims = tree_cons (build_int_cst (boolean_type_node, ix >=

>> level),

>> -			  integer_zero_node, dims);

>> +      switch (sym_attr.oacc_function)

>> +	{

>> +	case OACC_FUNCTION_GANG:

>> +	  code = OMP_CLAUSE_GANG;

>> +	  break;

>> +	case OACC_FUNCTION_WORKER:

>> +	  code = OMP_CLAUSE_WORKER;

>> +	  break;

>> +	case OACC_FUNCTION_VECTOR:

>> +	  code = OMP_CLAUSE_VECTOR;

>> +	  break;

>> +	case OACC_FUNCTION_SEQ:

>> +	default:

>> +	  code = OMP_CLAUSE_SEQ;

>> +	}

>>  

>> +      clause = build_omp_clause (UNKNOWN_LOCATION, code);

>> +      dims = oacc_build_routine_dims (clause);

>>        list = tree_cons (get_identifier ("oacc function"),

>>  			dims, list);

>>      }


On a related note, I noticed that I forgot to incorporate this change in
gfortran.h:

@@ -902,7 +912,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;

It's probably not huge, but I noticed that some other enum bitfields are
declared that way.

> btw.. the OACC merge from the gomp4 branch added a copy'n paste error

> in an error message. May i ask you to regtest and install the below:

> 

> diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c

> index fcfe671be8b..ac1f4fc7619 100644

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

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

> @@ -5848,13 +5848,13 @@ resolve_oacc_loop_blocks (gfc_code *code)

>  		if (c->code->ext.omp_clauses->worker)

>  		  gfc_error ("Loop parallelized across gangs is not

> allowed " "inside loop parallelized across workers at %L",

>  			     &code->loc);

>  		if (c->code->ext.omp_clauses->vector)

>  		  gfc_error ("Loop parallelized across gangs is not

> allowed "

> -			     "inside loop parallelized across workers

> at %L",

> +			     "inside loop parallelized across vectors

> at %L", &code->loc);

>  	      }

>  	    if (code->ext.omp_clauses->worker)

>  	      {

>  		if (c->code->ext.omp_clauses->worker)

>  		  gfc_error ("Loop parallelized across workers is not

>  		  allowed "


Sure. That looks reasonable. I'll also update and/or add new tests as
necessary.

Thanks for the review. I have couple in my queue already, but I hope to
have both my updated patch and your patch ready early next week. This
week I've been preparing a bunch of miscellaneous OpenACC patches, but
next week return to OpenACC routine patches. In terms of Fortran, I have
a patch that introduces support for the nohost routine clause (and the
bind clause, but bind hasn't been implemented in the middle end yet, so
I won't include it), as well as a patch the aforementioned routine
support in Fortran modules.

Cesar
Bernhard Reutner-Fischer Sept. 20, 2018, 4:10 p.m. | #3
On Thu, 20 Sep 2018 07:41:08 -0700
Cesar Philippidis <cesar@codesourcery.com> wrote:

> On 09/19/2018 03:27 PM, Bernhard Reutner-Fischer wrote:

> > On Wed, 5 Sep 2018 12:52:03 -0700

> > Cesar Philippidis <cesar@codesourcery.com> wrote:


> >> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c

> >> index eea6b81ebfa..eed868f475b 100644

> >> --- a/gcc/fortran/trans-decl.c

> >> +++ b/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-general.h"  

> > 

> > hmz. so the gomp-constants.h include would be redundant, but do we

> > really need omp-general.h?  

> 

> Good point. omp-general.h is required for oacc_build_routine_dims.

> 

> > Doesn't this suggest to move this oacc dims lowering to

> > trans-openmp.c instead, please?  

> 

> So something like adding a new gfc_add_omp_offload_attributes to

> trans-openmp.c and call it from add_attributes_to_decl?


yes.

> On a related note, I noticed that I forgot to incorporate this change

> in gfortran.h:

> 

> @@ -902,7 +912,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;

> 

> It's probably not huge, but I noticed that some other enum bitfields

> are declared that way.


yea, some compilers had trouble with enum bitfields (where plain int
bitfields like here worked fine, IIRC) but i'm not sure if it's
considered legacy these days. Fine with me to be safe.

> 

> > btw.. the OACC merge from the gomp4 branch added a copy'n paste

> > error in an error message. May i ask you to regtest and install the

> > below:


> Sure. That looks reasonable. I'll also update and/or add new tests as

> necessary.


TIA and cheers,
Cesar Philippidis Sept. 24, 2018, 2:45 p.m. | #4
On 09/20/2018 09:10 AM, Bernhard Reutner-Fischer wrote:
> On Thu, 20 Sep 2018 07:41:08 -0700

> Cesar Philippidis <cesar@codesourcery.com> wrote:

> 

>> On 09/19/2018 03:27 PM, Bernhard Reutner-Fischer wrote:

>>> On Wed, 5 Sep 2018 12:52:03 -0700

>>> Cesar Philippidis <cesar@codesourcery.com> wrote:

> 

>>>> diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c

>>>> index eea6b81ebfa..eed868f475b 100644

>>>> --- a/gcc/fortran/trans-decl.c

>>>> +++ b/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-general.h"  

>>>

>>> hmz. so the gomp-constants.h include would be redundant, but do we

>>> really need omp-general.h?  

>>

>> Good point. omp-general.h is required for oacc_build_routine_dims.

>>

>>> Doesn't this suggest to move this oacc dims lowering to

>>> trans-openmp.c instead, please?  

>>

>> So something like adding a new gfc_add_omp_offload_attributes to

>> trans-openmp.c and call it from add_attributes_to_decl?

> 

> yes.

> 

>> On a related note, I noticed that I forgot to incorporate this change

>> in gfortran.h:

>>

>> @@ -902,7 +912,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;

>>

>> It's probably not huge, but I noticed that some other enum bitfields

>> are declared that way.

> 

> yea, some compilers had trouble with enum bitfields (where plain int

> bitfields like here worked fine, IIRC) but i'm not sure if it's

> considered legacy these days. Fine with me to be safe.


I updated the patch by incorporating all of those changes. Is it OK for
trunk?

Thanks,
Cesar
[openacc] Make GFC default to -1 for OpenACC routine dims

2018-09-24  Cesar Philippidis  <cesar@codesourcery.com>

	* gfortran.h (enum oacc_function): New enum.
	(gfc_oacc_routine_name): Add locus loc field.
	(symbol_attribute): Update type of oacc_function field.	
	* openmp.c (gfc_oacc_routine_dims): Return oacc_function.
	(gfc_match_oacc_routine): Update routine clause syntax checking.
	Populate oacc_function attribute with dims.
	* trans-decl.c (add_attributes_to_decl): Use oacc_build_routine_dims
	to construct routine dims.
	* trans.h (gfc_add_omp_offload_attributes): Declare.
	* trans-decl.c (add_attributes_to_decl): Use it to set OMP and ACC
	offload function attributes.
	* trans-openmp.c (gfc_add_omp_offload_attributes): New function.

	gcc/testsuite/
	* gfortran.dg/goacc/classify-routine.f95: Adjust test.
	* gfortran.dg/goacc/pr71704.f90: Likewise.
	* gfortran.dg/goacc/routine-6.f90: Likewise.
	* gfortran.dg/goacc/routine-8.f90: Likewise.
	* gfortran.dg/goacc/routine-level-of-parallelism-1.f90: Likewise.

	libgomp/
	* testsuite/libgomp.oacc-fortran/routine-1.f90: Adjust test.
	* testsuite/libgomp.oacc-fortran/routine-2.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-3.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-4.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-5.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-7.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-9.f90: Likewise.
	* libgomp.oacc-fortran/host_data-2.f90: Likewise.
	* libgomp.oacc-fortran/host_data-3.f: Likewise.
	* libgomp.oacc-fortran/host_data-4.f90: Likewise.


diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 04b0024a992..3efd59c95f7 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -316,6 +316,16 @@ 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_GANG,
+  OACC_FUNCTION_WORKER,
+  OACC_FUNCTION_VECTOR,
+  OACC_FUNCTION_SEQ,
+  OACC_FUNCTION_AUTO
+};
+
 /* 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.  */
@@ -902,7 +912,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;
@@ -1726,6 +1736,7 @@ typedef struct gfc_oacc_routine_name
   struct gfc_symbol *sym;
   struct gfc_omp_clauses *clauses;
   struct gfc_oacc_routine_name *next;
+  locus loc;
 }
 gfc_oacc_routine_name;
 
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 94a7f7eaa50..ac1923ea06b 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2234,34 +2234,45 @@ 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 int
+static oacc_function
 gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
 {
   int level = -1;
+  oacc_function ret = OACC_FUNCTION_AUTO;
 
   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);
+	{
+	  level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
+	  ret = OACC_FUNCTION_SEQ;
+	}
 
       if (mask != (mask & -mask))
-	gfc_error ("Multiple loop axes specified for routine");
+	ret = OACC_FUNCTION_NONE;
     }
 
-  if (level < 0)
-    level = GOMP_DIM_MAX;
-
-  return level;
+  return ret;
 }
 
 match
@@ -2272,6 +2283,8 @@ gfc_match_oacc_routine (void)
   match m;
   gfc_omp_clauses *c = NULL;
   gfc_oacc_routine_name *n = NULL;
+  oacc_function dims;
+  bool seen_error = false;
 
   old_loc = gfc_current_locus;
 
@@ -2318,17 +2331,15 @@ gfc_match_oacc_routine (void)
 	}
       else
         {
-	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
-	  gfc_current_locus = old_loc;
-	  return MATCH_ERROR;
+	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L", &old_loc);
+	  goto cleanup;
 	}
 
       if (gfc_match_char (')') != MATCH_YES)
 	{
-	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting"
-		     " ')' after NAME");
-	  gfc_current_locus = old_loc;
-	  return MATCH_ERROR;
+	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, expecting"
+		     " ')' after NAME", &old_loc);
+	  goto cleanup;
 	}
     }
 
@@ -2337,26 +2348,72 @@ 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 %L",
+		 &old_loc);
+
+      /* Don't abort early, because it's important to let the user
+	 know of any potential duplicate routine directives.  */
+      seen_error = true;
+    }
+  else if (dims == OACC_FUNCTION_AUTO)
+    {
+      gfc_warning (0, "Expected one of %<gang%>, %<worker%>, %<vector%> or "
+		   "%<seq%> clauses in !$ACC ROUTINE at %L", &old_loc);
+      dims = OACC_FUNCTION_SEQ;
+    }
+
   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))
+	      goto duplicate_routine;
+	  }
+
+      if (needs_entry)
+	{
+	  n = gfc_get_oacc_routine_name ();
+	  n->sym = sym;
+	  n->clauses = c;
+	  n->loc = old_loc;
+	  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)
+	goto duplicate_routine;
+
       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
-	= gfc_oacc_routine_dims (c) + 1;
+
+      gfc_current_ns->proc_name->attr.oacc_function = dims;
+
+      if (seen_error)
+	goto cleanup;
     }
+  else
+    /* Something has gone wrong.  Perhaps there was a syntax error
+       in the program-stmt.  */
+    goto cleanup;
 
   if (n)
     n->clauses = c;
@@ -2367,6 +2424,9 @@ gfc_match_oacc_routine (void)
   new_st.ext.omp_clauses = c;
   return MATCH_YES;  
 
+duplicate_routine:
+  gfc_error ("!$ACC ROUTINE already applied at %L", &old_loc);
+
 cleanup:
   gfc_current_locus = old_loc;
   return MATCH_ERROR;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 06066eb93dd..e2e96da9a57 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -44,7 +44,6 @@ along with GCC; see the file COPYING3.  If not see
 #include "trans-const.h"
 /* Only for gfc_trans_code.  Shouldn't need to include this.  */
 #include "trans-stmt.h"
-#include "gomp-constants.h"
 #include "gimplify.h"
 
 #define MAX_LABEL_VALUE 99999
@@ -1396,26 +1395,7 @@ add_attributes_to_decl (symbol_attribute sym_attr, tree list)
 	list = chainon (list, attr);
       }
 
-  if (sym_attr.omp_declare_target_link)
-    list = tree_cons (get_identifier ("omp declare target link"),
-		      NULL_TREE, list);
-  else if (sym_attr.omp_declare_target)
-    list = tree_cons (get_identifier ("omp declare target"),
-		      NULL_TREE, list);
-
-  if (sym_attr.oacc_function)
-    {
-      tree dims = NULL_TREE;
-      int ix;
-      int level = sym_attr.oacc_function - 1;
-
-      for (ix = GOMP_DIM_MAX; ix--;)
-	dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
-			  integer_zero_node, dims);
-
-      list = tree_cons (get_identifier ("oacc function"),
-			dims, list);
-    }
+  list = gfc_add_omp_offload_attributes (sym_attr, list);
 
   return list;
 }
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index f038f4c5bf8..753272d84c2 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -1281,6 +1281,48 @@ gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *ctx, tree type)
     }
 }
 
+/* Add OpenMP / OpenACC function attributes to LIST.  */
+
+tree
+gfc_add_omp_offload_attributes (symbol_attribute sym_attr, tree list)
+{
+  if (sym_attr.omp_declare_target_link)
+    list = tree_cons (get_identifier ("omp declare target link"),
+		      NULL_TREE, list);
+  else 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)
+    {
+      omp_clause_code code;
+      tree clause, dims;
+
+      switch (sym_attr.oacc_function)
+	{
+	case OACC_FUNCTION_GANG:
+	  code = OMP_CLAUSE_GANG;
+	  break;
+	case OACC_FUNCTION_WORKER:
+	  code = OMP_CLAUSE_WORKER;
+	  break;
+	case OACC_FUNCTION_VECTOR:
+	  code = OMP_CLAUSE_VECTOR;
+	  break;
+	case OACC_FUNCTION_SEQ:
+	default:
+	  code = OMP_CLAUSE_SEQ;
+	}
+
+      clause = build_omp_clause (UNKNOWN_LOCATION, code);
+      dims = oacc_build_routine_dims (clause);
+      list = tree_cons (get_identifier ("oacc function"),
+			dims, list);
+    }
+
+  return list;
+}
+
 
 static inline tree
 gfc_trans_add_clause (tree node, tree tail)
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 1813882fe36..ecaf3d87827 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -780,6 +780,7 @@ bool gfc_omp_private_debug_clause (tree, bool);
 bool gfc_omp_private_outer_ref (tree);
 struct gimplify_omp_ctx;
 void gfc_omp_firstprivatize_type_sizes (struct gimplify_omp_ctx *, tree);
+tree gfc_add_omp_offload_attributes (symbol_attribute, tree);
 
 /* Runtime library function decls.  */
 extern GTY(()) tree gfor_fndecl_pause_numeric;
diff --git a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
index 4ca406742f9..445ff9afd4e 100644
--- a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
@@ -20,10 +20,10 @@ 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__\\(\\(omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } }
 
 ! Check the offloaded function's classification and compute dimensions (will
 ! always be 1 x 1 x 1 for non-offloading compilation).
 ! { dg-final { scan-tree-dump-times "(?n)Function is OpenACC routine level 1" 1 "oaccdevlow" } }
 ! { dg-final { scan-tree-dump-times "(?n)Compute dimensions \\\[1, 1, 1\\\]" 1 "oaccdevlow" } }
-! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } }
+! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
index 0235e85d42a..92d0c71d75c 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
@@ -2,7 +2,7 @@
 ! { dg-do compile }
 
 real function f1 ()
-!$acc routine (f1)
+!$acc routine (f1) seq
   f1 = 1
 end
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
index 10943cff304..5c1f652ff6d 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
@@ -4,8 +4,7 @@ module m
 contains
   subroutine subr5 (x) 
   implicit none
-  !$acc routine (subr5)
-  !$acc routine (m1int) ! { dg-error "invalid function name" }
+  !$acc routine (subr5) seq
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -19,22 +18,21 @@ program main
   implicit none
   interface
     function subr6 (x) 
-    !$acc routine (subr6) ! { dg-error "without list is allowed in interface" }
+    !$acc routine (subr6) seq ! { dg-error "without list is allowed in interface" }
     integer, intent (in) :: x
     integer :: subr6
     end function subr6
   end interface
   integer, parameter :: n = 10
   integer :: a(n), i
-  !$acc routine (subr1) ! { dg-error "invalid function name" }
   external :: subr2
-  !$acc routine (subr2)
+  !$acc routine (subr2) seq
 
   external :: R1, R2
-  !$acc routine (R1 R2 R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
-  !$acc routine (R1, R2, R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
-  !$acc routine (R1)
-  !$acc routine (R2)
+  !$acc routine (R1 R2 R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
+  !$acc routine (R1, R2, R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
+  !$acc routine (R1) seq
+  !$acc routine (R2) seq
 
   !$acc parallel
   !$acc loop
@@ -46,7 +44,7 @@ program main
 end program main
 
 subroutine subr1 (x) 
-  !$acc routine
+  !$acc routine seq
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -56,7 +54,6 @@ subroutine subr1 (x)
 end subroutine subr1
 
 subroutine subr2 (x) 
-  !$acc routine (subr1) ! { dg-error "invalid function name" }
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -66,7 +63,7 @@ subroutine subr2 (x)
 end subroutine subr2
 
 subroutine subr3 (x) 
-  !$acc routine (subr3)
+  !$acc routine (subr3) seq
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -76,7 +73,7 @@ subroutine subr3 (x)
 end subroutine subr3
 
 subroutine subr4 (x) 
-  !$acc routine (subr4)
+  !$acc routine (subr4) seq
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -86,7 +83,6 @@ subroutine subr4 (x)
 end subroutine subr4
 
 subroutine subr10 (x)
-  !$acc routine (subr10) device ! { dg-error "Unclassifiable OpenACC directive" }
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
index c9039153885..beca43f2d60 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
@@ -4,7 +4,7 @@ program main
   interface
      function s_1 (a)
        integer a
-       !$acc routine
+       !$acc routine seq
      end function s_1
   end interface
 
@@ -18,7 +18,7 @@ program main
   interface
      function s_3 (a)
        integer a
-       !$acc routine (s_3) ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" }
+       !$acc routine (s_3) seq ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" }
      end function s_3
   end interface
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
index 75dd1b01f6f..efc1b400add 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
@@ -7,7 +7,7 @@ subroutine g_1
 end subroutine g_1
 
 subroutine s_1_2a
-  !$acc routine
+  !$acc routine seq
 end subroutine s_1_2a
 
 subroutine s_1_2b
@@ -15,7 +15,7 @@ subroutine s_1_2b
 end subroutine s_1_2b
 
 subroutine s_1_2c
-  !$acc routine (s_1_2c)
+  !$acc routine (s_1_2c) seq
 end subroutine s_1_2c
 
 subroutine s_1_2d
@@ -25,7 +25,7 @@ end subroutine s_1_2d
 module s_2
 contains
   subroutine s_2_1a
-    !$acc routine
+    !$acc routine seq
   end subroutine s_2_1a
 
   subroutine s_2_1b
@@ -33,7 +33,7 @@ contains
   end subroutine s_2_1b
 
   subroutine s_2_1c
-    !$acc routine (s_2_1c)
+    !$acc routine (s_2_1c) seq
   end subroutine s_2_1c
 
   subroutine s_2_1d
@@ -48,7 +48,7 @@ subroutine test
   interface
      function s_3_1a (a)
        integer a
-       !$acc routine
+       !$acc routine seq
      end function s_3_1a
   end interface
 
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
index ff0921863f6..4cdaa0c4d60 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
@@ -81,7 +81,7 @@ subroutine saxpy (nn, aa, xx, yy)
   integer :: nn
   real*4 :: aa, xx(nn), yy(nn)
   integer i
-  !$acc routine
+  !$acc routine seq
 
   do i = 1, nn
     yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
index 05ed949ee5c..fe0b904bb91 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
@@ -67,7 +67,7 @@
       integer :: nn
       real*4 :: aa, xx(nn), yy(nn)
       integer i
-!$acc routine
+!$acc routine seq
 
       do i = 1, nn
          yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
index 6e379b5485b..e192c59a97c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
@@ -21,7 +21,7 @@ contains
     integer :: nn
     real*4 :: aa, xx(nn), yy(nn)
     integer i
-    !$acc routine
+    !$acc routine seq
 
     do i = 1, nn
        yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
index 6a573218b7a..346e875ba00 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
@@ -3,7 +3,7 @@
 
   interface
     recursive function fact (x)
-      !$acc routine
+      !$acc routine seq
       integer, intent(in) :: x
       integer :: fact
     end function fact
@@ -21,7 +21,7 @@
   end do
 end
 recursive function fact (x) result (res)
-  !$acc routine
+  !$acc routine seq
   integer, intent(in) :: x
   integer :: res
   if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
index b6979747902..1391979291c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
@@ -4,7 +4,7 @@
   module m1
     contains
     recursive function fact (x) result (res)
-      !$acc routine
+      !$acc routine seq
       integer, intent(in) :: x
       integer :: res
       if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
index e7b9d8ab364..6f49db97b80 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
@@ -4,7 +4,7 @@
   integer, parameter :: n = 10
   integer :: a(n), i
   integer, external :: fact
-  !$acc routine (fact)
+  !$acc routine (fact) seq
   !$acc parallel
   !$acc loop
   do i = 1, n
@@ -16,7 +16,7 @@
   end do
 end
 recursive function fact (x) result (res)
-  !$acc routine
+  !$acc routine seq
   integer, intent(in) :: x
   integer :: res
   if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
index a96363b8cde..85bdb2a0a07 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
@@ -17,7 +17,7 @@
   end do
 end
 subroutine incr (x)
-  !$acc routine
+  !$acc routine seq
   integer, intent(inout) :: x
   x = x + 1
 end subroutine incr
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
index a803ad96bb5..88d65741b7c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
@@ -15,7 +15,7 @@ program main
 contains
 
     function func (n) result (rc)
-    !$acc routine
+    !$acc routine seq
     integer, intent (in) :: n
     integer :: rc
 
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
index f58a95fe670..a83e92ab129 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
@@ -1,4 +1,3 @@
-
 ! { dg-do run }
 ! { dg-additional-options "-cpp" }
 
@@ -100,7 +99,7 @@ subroutine gang (a)
   integer, intent (inout) :: a(N)
   integer :: i
 
-  !$acc loop gang
+  !$acc loop gang worker vector
   do i = 1, N
     a(i) = a(i) - i 
   end do
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
index b1a1338dd8c..4a1250405cb 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
@@ -6,7 +6,7 @@ program main
   integer, parameter :: n = 10
   integer :: a(n), i
   integer, external :: fact
-  !$acc routine (fact)
+  !$acc routine (fact) seq
   !$acc parallel
   !$acc loop
   do i = 1, n
@@ -20,7 +20,7 @@ end program main
 
 recursive function fact (x) result (res)
   implicit none
-  !$acc routine (fact)
+  !$acc routine (fact) seq
   integer, intent(in) :: x
   integer :: res
   if (x < 1) then
-- 
2.17.1
Bernhard Reutner-Fischer Sept. 25, 2018, 7:06 a.m. | #5
On 24 September 2018 16:45:38 CEST, Cesar Philippidis <cesar@codesourcery.com> wrote:

>I updated the patch by incorporating all of those changes. Is it OK for

>trunk?


LGTM but I cannot approve it.

thanks,

Patch

[openacc] Teach gfortran to lower OpenACC routine dims

	gcc/fortran/
	* gfortran.h (oacc_function): New enum.
	(gfc_oacc_routine_name): Add locus loc field.
	* openmp.c (gfc_oacc_routine_dims): Return oacc_function.
	(gfc_match_oacc_routine): Update routine clause syntax checking.
	Populate oacc_function attribute with dims.
	* trans-decl.c (add_attributes_to_decl): Use oacc_build_routine_dims
	to construct routine dims.

	gcc/testsuite/
	* gfortran.dg/goacc/classify-routine.f95: Adjust test.
	* gfortran.dg/goacc/pr71704.f90: Likewise.
	* gfortran.dg/goacc/routine-6.f90: Likewise.
	* gfortran.dg/goacc/routine-8.f90: Likewise.
	* gfortran.dg/goacc/routine-level-of-parallelism-1.f90: Likewise.

	libgomp/
	* testsuite/libgomp.oacc-fortran/routine-1.f90: Adjust test.
	* testsuite/libgomp.oacc-fortran/routine-2.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-3.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-4.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-5.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-7.f90: Likewise.
	* testsuite/libgomp.oacc-fortran/routine-9.f90: Likewise.
	* libgomp.oacc-fortran/host_data-2.f90: Likewise.
	* libgomp.oacc-fortran/host_data-3.f: Likewise.
	* libgomp.oacc-fortran/host_data-4.f90: Likewise.


diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 04b0024a992..3675f2e8d52 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -316,6 +316,16 @@  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_GANG,
+  OACC_FUNCTION_WORKER,
+  OACC_FUNCTION_VECTOR,
+  OACC_FUNCTION_SEQ,
+  OACC_FUNCTION_AUTO
+};
+
 /* 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.  */
@@ -1726,6 +1736,7 @@  typedef struct gfc_oacc_routine_name
   struct gfc_symbol *sym;
   struct gfc_omp_clauses *clauses;
   struct gfc_oacc_routine_name *next;
+  locus loc;
 }
 gfc_oacc_routine_name;
 
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 94a7f7eaa50..d48c9351e25 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2234,34 +2234,45 @@  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 int
+static oacc_function
 gfc_oacc_routine_dims (gfc_omp_clauses *clauses)
 {
   int level = -1;
+  oacc_function ret = OACC_FUNCTION_AUTO;
 
   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);
+	{
+	  level = GOMP_DIM_MAX, mask |= GOMP_DIM_MASK (level);
+	  ret = OACC_FUNCTION_SEQ;
+	}
 
       if (mask != (mask & -mask))
-	gfc_error ("Multiple loop axes specified for routine");
+	ret = OACC_FUNCTION_NONE;
     }
 
-  if (level < 0)
-    level = GOMP_DIM_MAX;
-
-  return level;
+  return ret;
 }
 
 match
@@ -2272,6 +2283,8 @@  gfc_match_oacc_routine (void)
   match m;
   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;
 
@@ -2318,17 +2331,15 @@  gfc_match_oacc_routine (void)
 	}
       else
         {
-	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C");
-	  gfc_current_locus = old_loc;
-	  return MATCH_ERROR;
+	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L", &old_loc);
+	  goto cleanup;
 	}
 
       if (gfc_match_char (')') != MATCH_YES)
 	{
-	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, expecting"
-		     " ')' after NAME");
-	  gfc_current_locus = old_loc;
-	  return MATCH_ERROR;
+	  gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %L, expecting"
+		     " ')' after NAME", &old_loc);
+	  goto cleanup;
 	}
     }
 
@@ -2337,26 +2348,83 @@  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 %L",
+		 &old_loc);
+
+      /* Don't abort early, because it's important to let the user
+	 know of any potential duplicate routine directives.  */
+      seen_error = true;
+    }
+  else if (dims == OACC_FUNCTION_AUTO)
+    {
+      gfc_warning (0, "Expected one of %<gang%>, %<worker%>, %<vector%> or "
+		   "%<seq%> clauses in !$ACC ROUTINE at %L", &old_loc);
+      dims = OACC_FUNCTION_SEQ;
+    }
+
   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 %L", &old_loc);
+		goto cleanup;
+	      }
+	  }
+
+      if (needs_entry)
+	{
+	  n = gfc_get_oacc_routine_name ();
+	  n->sym = sym;
+	  n->clauses = c;
+	  n->next = NULL;
+	  n->loc = old_loc;
+
+	  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 %L", &old_loc);
+	  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
-	= gfc_oacc_routine_dims (c) + 1;
+	= seen_error ? OACC_FUNCTION_SEQ : dims;
+
+      if (seen_error)
+	goto cleanup;
     }
+  else
+    /* Something has gone wrong.  Perhaps there was a syntax error
+       in the program-stmt.  */
+    goto cleanup;
 
   if (n)
     n->clauses = c;
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index eea6b81ebfa..eed868f475b 100644
--- a/gcc/fortran/trans-decl.c
+++ b/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-general.h"
 
 #define MAX_LABEL_VALUE 99999
 
@@ -1403,16 +1404,29 @@  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;
+      omp_clause_code code = OMP_CLAUSE_ERROR;
+      tree clause, dims;
 
-      for (ix = GOMP_DIM_MAX; ix--;)
-	dims = tree_cons (build_int_cst (boolean_type_node, ix >= level),
-			  integer_zero_node, dims);
+      switch (sym_attr.oacc_function)
+	{
+	case OACC_FUNCTION_GANG:
+	  code = OMP_CLAUSE_GANG;
+	  break;
+	case OACC_FUNCTION_WORKER:
+	  code = OMP_CLAUSE_WORKER;
+	  break;
+	case OACC_FUNCTION_VECTOR:
+	  code = OMP_CLAUSE_VECTOR;
+	  break;
+	case OACC_FUNCTION_SEQ:
+	default:
+	  code = OMP_CLAUSE_SEQ;
+	}
 
+      clause = build_omp_clause (UNKNOWN_LOCATION, code);
+      dims = oacc_build_routine_dims (clause);
       list = tree_cons (get_identifier ("oacc function"),
 			dims, list);
     }
diff --git a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95 b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
index 4ca406742f9..445ff9afd4e 100644
--- a/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
+++ b/gcc/testsuite/gfortran.dg/goacc/classify-routine.f95
@@ -20,10 +20,10 @@  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__\\(\\(omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "ompexp" } }
 
 ! Check the offloaded function's classification and compute dimensions (will
 ! always be 1 x 1 x 1 for non-offloading compilation).
 ! { dg-final { scan-tree-dump-times "(?n)Function is OpenACC routine level 1" 1 "oaccdevlow" } }
 ! { dg-final { scan-tree-dump-times "(?n)Compute dimensions \\\[1, 1, 1\\\]" 1 "oaccdevlow" } }
-! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 0, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } }
+! { dg-final { scan-tree-dump-times "(?n)__attribute__\\(\\(oacc function \\(0 1, 1 1, 1 1\\), omp declare target, oacc function \\(0 1, 1 0, 1 0\\)\\)\\)" 1 "oaccdevlow" } }
diff --git a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90 b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
index 0235e85d42a..92d0c71d75c 100644
--- a/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/pr71704.f90
@@ -2,7 +2,7 @@ 
 ! { dg-do compile }
 
 real function f1 ()
-!$acc routine (f1)
+!$acc routine (f1) seq
   f1 = 1
 end
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
index 10943cff304..5c1f652ff6d 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-6.f90
@@ -4,8 +4,7 @@  module m
 contains
   subroutine subr5 (x) 
   implicit none
-  !$acc routine (subr5)
-  !$acc routine (m1int) ! { dg-error "invalid function name" }
+  !$acc routine (subr5) seq
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -19,22 +18,21 @@  program main
   implicit none
   interface
     function subr6 (x) 
-    !$acc routine (subr6) ! { dg-error "without list is allowed in interface" }
+    !$acc routine (subr6) seq ! { dg-error "without list is allowed in interface" }
     integer, intent (in) :: x
     integer :: subr6
     end function subr6
   end interface
   integer, parameter :: n = 10
   integer :: a(n), i
-  !$acc routine (subr1) ! { dg-error "invalid function name" }
   external :: subr2
-  !$acc routine (subr2)
+  !$acc routine (subr2) seq
 
   external :: R1, R2
-  !$acc routine (R1 R2 R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
-  !$acc routine (R1, R2, R3) ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
-  !$acc routine (R1)
-  !$acc routine (R2)
+  !$acc routine (R1 R2 R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
+  !$acc routine (R1, R2, R3) seq ! { dg-error "Syntax error in \\!\\\$ACC ROUTINE \\( NAME \\) at \\(1\\), expecting .\\). after NAME" }
+  !$acc routine (R1) seq
+  !$acc routine (R2) seq
 
   !$acc parallel
   !$acc loop
@@ -46,7 +44,7 @@  program main
 end program main
 
 subroutine subr1 (x) 
-  !$acc routine
+  !$acc routine seq
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -56,7 +54,6 @@  subroutine subr1 (x)
 end subroutine subr1
 
 subroutine subr2 (x) 
-  !$acc routine (subr1) ! { dg-error "invalid function name" }
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -66,7 +63,7 @@  subroutine subr2 (x)
 end subroutine subr2
 
 subroutine subr3 (x) 
-  !$acc routine (subr3)
+  !$acc routine (subr3) seq
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -76,7 +73,7 @@  subroutine subr3 (x)
 end subroutine subr3
 
 subroutine subr4 (x) 
-  !$acc routine (subr4)
+  !$acc routine (subr4) seq
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
@@ -86,7 +83,6 @@  subroutine subr4 (x)
 end subroutine subr4
 
 subroutine subr10 (x)
-  !$acc routine (subr10) device ! { dg-error "Unclassifiable OpenACC directive" }
   integer, intent(inout) :: x
   if (x < 1) then
      x = 1
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
index c9039153885..beca43f2d60 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-8.f90
@@ -4,7 +4,7 @@  program main
   interface
      function s_1 (a)
        integer a
-       !$acc routine
+       !$acc routine seq
      end function s_1
   end interface
 
@@ -18,7 +18,7 @@  program main
   interface
      function s_3 (a)
        integer a
-       !$acc routine (s_3) ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" }
+       !$acc routine (s_3) seq ! { dg-error "Only the ..ACC ROUTINE form without list is allowed in interface block" }
      end function s_3
   end interface
 
diff --git a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90 b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
index 75dd1b01f6f..efc1b400add 100644
--- a/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
+++ b/gcc/testsuite/gfortran.dg/goacc/routine-level-of-parallelism-1.f90
@@ -7,7 +7,7 @@  subroutine g_1
 end subroutine g_1
 
 subroutine s_1_2a
-  !$acc routine
+  !$acc routine seq
 end subroutine s_1_2a
 
 subroutine s_1_2b
@@ -15,7 +15,7 @@  subroutine s_1_2b
 end subroutine s_1_2b
 
 subroutine s_1_2c
-  !$acc routine (s_1_2c)
+  !$acc routine (s_1_2c) seq
 end subroutine s_1_2c
 
 subroutine s_1_2d
@@ -25,7 +25,7 @@  end subroutine s_1_2d
 module s_2
 contains
   subroutine s_2_1a
-    !$acc routine
+    !$acc routine seq
   end subroutine s_2_1a
 
   subroutine s_2_1b
@@ -33,7 +33,7 @@  contains
   end subroutine s_2_1b
 
   subroutine s_2_1c
-    !$acc routine (s_2_1c)
+    !$acc routine (s_2_1c) seq
   end subroutine s_2_1c
 
   subroutine s_2_1d
@@ -48,7 +48,7 @@  subroutine test
   interface
      function s_3_1a (a)
        integer a
-       !$acc routine
+       !$acc routine seq
      end function s_3_1a
   end interface
 
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
index ff0921863f6..4cdaa0c4d60 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-2.f90
@@ -81,7 +81,7 @@  subroutine saxpy (nn, aa, xx, yy)
   integer :: nn
   real*4 :: aa, xx(nn), yy(nn)
   integer i
-  !$acc routine
+  !$acc routine seq
 
   do i = 1, nn
     yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
index 05ed949ee5c..fe0b904bb91 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-3.f
@@ -67,7 +67,7 @@ 
       integer :: nn
       real*4 :: aa, xx(nn), yy(nn)
       integer i
-!$acc routine
+!$acc routine seq
 
       do i = 1, nn
          yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
index 6e379b5485b..e192c59a97c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/host_data-4.f90
@@ -21,7 +21,7 @@  contains
     integer :: nn
     real*4 :: aa, xx(nn), yy(nn)
     integer i
-    !$acc routine
+    !$acc routine seq
 
     do i = 1, nn
        yy(i) = yy(i) + aa * xx(i)
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
index 6a573218b7a..346e875ba00 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-1.f90
@@ -3,7 +3,7 @@ 
 
   interface
     recursive function fact (x)
-      !$acc routine
+      !$acc routine seq
       integer, intent(in) :: x
       integer :: fact
     end function fact
@@ -21,7 +21,7 @@ 
   end do
 end
 recursive function fact (x) result (res)
-  !$acc routine
+  !$acc routine seq
   integer, intent(in) :: x
   integer :: res
   if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
index b6979747902..1391979291c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-2.f90
@@ -4,7 +4,7 @@ 
   module m1
     contains
     recursive function fact (x) result (res)
-      !$acc routine
+      !$acc routine seq
       integer, intent(in) :: x
       integer :: res
       if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
index e7b9d8ab364..6f49db97b80 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-3.f90
@@ -4,7 +4,7 @@ 
   integer, parameter :: n = 10
   integer :: a(n), i
   integer, external :: fact
-  !$acc routine (fact)
+  !$acc routine (fact) seq
   !$acc parallel
   !$acc loop
   do i = 1, n
@@ -16,7 +16,7 @@ 
   end do
 end
 recursive function fact (x) result (res)
-  !$acc routine
+  !$acc routine seq
   integer, intent(in) :: x
   integer :: res
   if (x < 1) then
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
index a96363b8cde..85bdb2a0a07 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-4.f90
@@ -17,7 +17,7 @@ 
   end do
 end
 subroutine incr (x)
-  !$acc routine
+  !$acc routine seq
   integer, intent(inout) :: x
   x = x + 1
 end subroutine incr
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
index a803ad96bb5..88d65741b7c 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-5.f90
@@ -15,7 +15,7 @@  program main
 contains
 
     function func (n) result (rc)
-    !$acc routine
+    !$acc routine seq
     integer, intent (in) :: n
     integer :: rc
 
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
index f58a95fe670..a83e92ab129 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-7.f90
@@ -1,4 +1,3 @@ 
-
 ! { dg-do run }
 ! { dg-additional-options "-cpp" }
 
@@ -100,7 +99,7 @@  subroutine gang (a)
   integer, intent (inout) :: a(N)
   integer :: i
 
-  !$acc loop gang
+  !$acc loop gang worker vector
   do i = 1, N
     a(i) = a(i) - i 
   end do
diff --git a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90 b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
index b1a1338dd8c..4a1250405cb 100644
--- a/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
+++ b/libgomp/testsuite/libgomp.oacc-fortran/routine-9.f90
@@ -6,7 +6,7 @@  program main
   integer, parameter :: n = 10
   integer :: a(n), i
   integer, external :: fact
-  !$acc routine (fact)
+  !$acc routine (fact) seq
   !$acc parallel
   !$acc loop
   do i = 1, n
@@ -20,7 +20,7 @@  end program main
 
 recursive function fact (x) result (res)
   implicit none
-  !$acc routine (fact)
+  !$acc routine (fact) seq
   integer, intent(in) :: x
   integer :: res
   if (x < 1) then
-- 
2.17.1