re PR fortran/91443 (-Wargument-mismatch does not catch mismatch for global procedure)

2019-08-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/91443
	* frontend-passes.c (check_externals_expr): New function.
	(check_externals_code): New function.
	(gfc_check_externals): New function.
	* gfortran.h (debug): Add prototypes for gfc_symbol * and
	gfc_expr *.
	(gfc_check_externals): Add prototype.
	* interface.c (compare_actual_formal): Do not complain about
	alternate returns if the formal argument is optional.
	(gfc_procedure_use): Handle cases when an error has been issued
	previously.  Break long line.
	* parse.c (gfc_parse_file): Call gfc_check_externals for all
	external procedures.
	* resolve.c (resolve_global_procedure): Remove checking of
	argument list.

2019-08-15  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/91443
	* gfortran.dg/argument_checking_19.f90: New test.
	* gfortran.dg/altreturn_10.f90: Change dg-warning to dg-error.
	* gfortran.dg/dec_union_11.f90: Add -std=legacy.
	* gfortran.dg/hollerith8.f90: Likewise. Remove warning for
	Hollerith constant.
	* gfortran.dg/integer_exponentiation_2.f90: New subroutine gee_i8;
	use it to avoid type mismatches.
	* gfortran.dg/pr41011.f: Add -std=legacy.
	* gfortran.dg/whole_file_1.f90: Change warnings to errors.
	* gfortran.dg/whole_file_2.f90: Likewise.

From-SVN: r274551

1 files changed, 97 insertions, 1 deletions

diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c
index be99a06..dd82089 100644
--- a/gcc/fortran/frontend-passes.c
+++ b/gcc/fortran/frontend-passes.c
@@ -56,7 +56,6 @@ static gfc_expr* check_conjg_transpose_variable (gfc_expr *, bool *,
 static int call_external_blas (gfc_code **, int *, void *);
 static int matmul_temp_args (gfc_code **, int *,void *data);
 static int index_interchange (gfc_code **, int*, void *);
-
 static bool is_fe_temp (gfc_expr *e);
 
 #ifdef CHECKING_P
@@ -5364,3 +5363,100 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t codefn, walk_expr_fn_t exprfn,
     }
   return 0;
 }
+
+/* As a post-resolution step, check that all global symbols which are
+   not declared in the source file match in their call signatures.
+   We do this by looping over the code (and expressions). The first call
+   we happen to find is assumed to be canonical.  */
+
+/* Callback for external functions.  */
+
+static int
+check_externals_expr (gfc_expr **ep, int *walk_subtrees ATTRIBUTE_UNUSED,
+		      void *data ATTRIBUTE_UNUSED)
+{
+  gfc_expr *e = *ep;
+  gfc_symbol *sym, *def_sym;
+  gfc_gsymbol *gsym;
+
+  if (e->expr_type != EXPR_FUNCTION)
+    return 0;
+
+  sym = e->value.function.esym;
+
+  if (sym == NULL || sym->attr.is_bind_c)
+    return 0;
+
+  if (sym->attr.proc != PROC_EXTERNAL && sym->attr.proc != PROC_UNKNOWN)
+    return 0;
+
+  gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name);
+  if (gsym == NULL)
+    return 0;
+
+  gfc_find_symbol (sym->name, gsym->ns, 0, &def_sym);
+
+  if (sym && def_sym)
+    gfc_procedure_use (def_sym, &e->value.function.actual, &e->where);
+
+  return 0;
+}
+
+/* Callback for external code.  */
+
+static int
+check_externals_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
+		      void *data ATTRIBUTE_UNUSED)
+{
+  gfc_code *co = *c;
+  gfc_symbol *sym, *def_sym;
+  gfc_gsymbol *gsym;
+
+  if (co->op != EXEC_CALL)
+    return 0;
+
+  sym = co->resolved_sym;
+  if (sym == NULL || sym->attr.is_bind_c)
+    return 0;
+
+  if (sym->attr.proc != PROC_EXTERNAL && sym->attr.proc != PROC_UNKNOWN)
+    return 0;
+
+  if (sym->attr.if_source == IFSRC_IFBODY || sym->attr.if_source == IFSRC_DECL)
+    return 0;
+
+  gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name);
+  if (gsym == NULL)
+    return 0;
+
+  gfc_find_symbol (sym->name, gsym->ns, 0, &def_sym);
+
+  if (sym && def_sym)
+    gfc_procedure_use (def_sym, &co->ext.actual, &co->loc);
+
+  return 0;
+}
+
+/* Called routine.  */
+
+void
+gfc_check_externals (gfc_namespace *ns)
+{
+
+  gfc_clear_error ();
+
+  /* Turn errors into warnings if -std=legacy is given by the user.  */
+
+  if (!pedantic && !(gfc_option.warn_std & GFC_STD_LEGACY))
+    gfc_errors_to_warnings (true);
+
+  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_errors_to_warnings (false);
+}