Test global identifiers against what is specified interfaces.

Apart from calling gfc_compare_interfaces to check interfaces against
global identifiers, this also sets and check a few sym->error flags
to avoid duplicate error messages.  I thought about issuing errors
on mismatched interfaces, but when the procedure is not invoked,
a warning should be enough to alert the user.

gcc/fortran/ChangeLog:

	PR fortran/27318
	* frontend-passes.c (check_against_globals): New function.
	(gfc_check_externals): Split; also invoke check_against_globals
	via gfc_traverse_ns.
	(gfc_check_externals0): Recursive part formerly in
	gfc_check_externals.
	* resolve.c (resolve_global_procedure): Set sym->error on
	interface mismatch.
	* symbol.c (ambiguous_symbol): Check for, and set sym->error.

gcc/testsuite/ChangeLog:

	PR fortran/27318
	* gfortran.dg/error_recovery_1.f90: Adjust test case.
	* gfortran.dg/use_15.f90: Likewise.
	* gfortran.dg/interface_47.f90: New test.

1 files changed, 57 insertions, 8 deletions

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index d5d71b5..69f9ca6 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -5493,26 +5493,75 @@ check_externals_expr (gfc_expr **ep, int *walk_subtrees ATTRIBUTE_UNUSED,
   return check_externals_procedure (sym, loc, actual);
 }
 
-/* Called routine.  */
+/* Function to check if any interface clashes with a global
+   identifier, to be invoked via gfc_traverse_ns.  */
 
-void
-gfc_check_externals (gfc_namespace *ns)
+static void
+check_against_globals (gfc_symbol *sym)
 {
+  gfc_gsymbol *gsym;
+  gfc_symbol *def_sym = NULL;
+  const char *sym_name;
+  char buf  [200];
 
-  gfc_clear_error ();
+  if (sym->attr.if_source != IFSRC_IFBODY || sym->attr.flavor != FL_PROCEDURE
+      || sym->attr.generic || sym->error)
+    return;
 
-  /* Turn errors into warnings if the user indicated this.  */
+  if (sym->binding_label)
+    sym_name = sym->binding_label;
+  else
+    sym_name = sym->name;
 
-  if (!pedantic && flag_allow_argument_mismatch)
-    gfc_errors_to_warnings (true);
+  gsym = gfc_find_gsymbol (gfc_gsym_root, sym_name);
+  if (gsym && gsym->ns)
+    gfc_find_symbol (sym->name, gsym->ns, 0, &def_sym);
+
+  if (!def_sym || def_sym->error || def_sym->attr.generic)
+    return;
+
+  buf[0] = 0;
+  gfc_compare_interfaces (sym, def_sym, sym->name, 0, 1, buf, sizeof(buf),
+			  NULL, NULL, NULL);
+  if (buf[0] != 0)
+    {
+      gfc_warning (0, "%s between %L and %L", buf, &def_sym->declared_at,
+		   &sym->declared_at);
+      sym->error = 1;
+      def_sym->error = 1;
+    }
+
+}
+
+/* Do the code-walkling part for gfc_check_externals.  */
 
+static void
+gfc_check_externals0 (gfc_namespace *ns)
+{
   gfc_code_walker (&ns->code, check_externals_code, check_externals_expr, NULL);
 
   for (ns = ns->contained; ns; ns = ns->sibling)
     {
       if (ns->code == NULL || ns->code->op != EXEC_BLOCK)
-	gfc_check_externals (ns);
+	gfc_check_externals0 (ns);
     }
 
+}
+
+/* Called routine.  */
+
+void gfc_check_externals (gfc_namespace *ns)
+{
+  gfc_clear_error ();
+
+  /* Turn errors into warnings if the user indicated this.  */
+
+  if (!pedantic && flag_allow_argument_mismatch)
+    gfc_errors_to_warnings (true);
+
+  gfc_check_externals0 (ns);
+  gfc_traverse_ns (ns, check_against_globals);
+
   gfc_errors_to_warnings (false);
 }
+