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