[PR89773] Fortran OpenACC 'routine' directive refuses procedures with implicit EXTERNAL attribute

	gcc/fortran/
	PR fortran/89773
	* gfortran.h (gfc_oacc_routine_name): Add loc member.
	(gfc_resolve_oacc_routines): Declare.
	* openmp.c (gfc_match_oacc_routine): Move some error checking
	into...
	(gfc_resolve_oacc_routines): ... this new function.
	* resolve.c (resolve_codes): Call it.
	gcc/testsuite/
	PR fortran/89773
	* gfortran.dg/goacc/pr89773.f90: New file.
	* gfortran.dg/goacc/pr77765.f90: Adjust.
	* gfortran.dg/goacc/routine-6.f90: Adjust, and extend.

From-SVN: r269857

4 files changed, 36 insertions, 8 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 111e3a2..7ce67eb 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,5 +1,13 @@
 2019-03-21  Thomas Schwinge  <thomas@codesourcery.com>
 
+	PR fortran/89773
+	* gfortran.h (gfc_oacc_routine_name): Add loc member.
+	(gfc_resolve_oacc_routines): Declare.
+	* openmp.c (gfc_match_oacc_routine): Move some error checking
+	into...
+	(gfc_resolve_oacc_routines): ... this new function.
+	* resolve.c (resolve_codes): Call it.
+
 	PR fortran/72741
 	* openmp.c (gfc_match_oacc_routine): Clarify.
 
diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h
index 2f55b9c..caf5e52 100644
--- a/gcc/fortran/gfortran.h
+++ b/gcc/fortran/gfortran.h
@@ -1739,6 +1739,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;
 
@@ -3210,6 +3211,7 @@ void gfc_resolve_oacc_directive (gfc_code *, gfc_namespace *);
 void gfc_resolve_oacc_declare (gfc_namespace *);
 void gfc_resolve_oacc_parallel_loop_blocks (gfc_code *, gfc_namespace *);
 void gfc_resolve_oacc_blocks (gfc_code *, gfc_namespace *);
+void gfc_resolve_oacc_routines (gfc_namespace *);
 
 /* expr.c */
 void gfc_free_actual_arglist (gfc_actual_arglist *);
diff --git a/gcc/fortran/openmp.c b/gcc/fortran/openmp.c
index 1b1a0b4..983b83d 100644
--- a/gcc/fortran/openmp.c
+++ b/gcc/fortran/openmp.c
@@ -2322,15 +2322,10 @@ gfc_match_oacc_routine (void)
 	        sym = NULL;
 	    }
 
-	  if ((isym == NULL && st == NULL)
-	      || (sym
-		  && !sym->attr.external
-		  && !sym->attr.function
-		  && !sym->attr.subroutine))
+	  if (isym == NULL && st == NULL)
 	    {
-	      gfc_error ("Syntax error in !$ACC ROUTINE ( NAME ) at %C, "
-			 "invalid function name %s",
-			 (sym) ? sym->name : buffer);
+	      gfc_error ("Invalid NAME %qs in !$ACC ROUTINE ( NAME ) at %C",
+			 buffer);
 	      gfc_current_locus = old_loc;
 	      return MATCH_ERROR;
 	    }
@@ -2400,6 +2395,7 @@ gfc_match_oacc_routine (void)
 	  n->sym = sym;
 	  n->clauses = c;
 	  n->next = gfc_current_ns->oacc_routine_names;
+	  n->loc = old_loc;
 	  gfc_current_ns->oacc_routine_names = n;
 	}
     }
@@ -6072,6 +6068,27 @@ gfc_resolve_oacc_declare (gfc_namespace *ns)
     }
 }
 
+
+void
+gfc_resolve_oacc_routines (gfc_namespace *ns)
+{
+  for (gfc_oacc_routine_name *orn = ns->oacc_routine_names;
+       orn;
+       orn = orn->next)
+    {
+      gfc_symbol *sym = orn->sym;
+      if (!sym->attr.external
+	  && !sym->attr.function
+	  && !sym->attr.subroutine)
+	{
+	  gfc_error ("NAME %qs does not refer to a subroutine or function"
+		     " in !$ACC ROUTINE ( NAME ) at %L", sym->name, &orn->loc);
+	  continue;
+	}
+    }
+}
+
+
 void
 gfc_resolve_oacc_directive (gfc_code *code, gfc_namespace *ns ATTRIBUTE_UNUSED)
 {
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 7539aa7..e1cd200 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -16818,6 +16818,7 @@ resolve_codes (gfc_namespace *ns)
   bitmap_obstack_initialize (&labels_obstack);
 
   gfc_resolve_oacc_declare (ns);
+  gfc_resolve_oacc_routines (ns);
   gfc_resolve_omp_local_vars (ns);
   gfc_resolve_code (ns->code, ns);