Hello world,
here is the next installment of checking for mismatched calls,
this time for mismatching CALLs.
The solution is to build a separate namespace with procedure
arguments determined from the actual arguments the first time a
procedure is seen, and then compare it against that on subsequent
calls.
This has uncovered quite a few examples of non-conforming code
in our testsuite, so no separate test case needed, IMHO.
So, OK for trunk? (The -std=legacy question can be settled
later).
2019-08-20 Thomas Koenig
PR fortran/91390
* frontend-passes.c (check_externals_procedure): New
function. If a procedure is not in the translation unit, create
an "interface" for it, including its formal arguments.
(check_externals_code): Use check_externals_procedure for common
code with check_externals_expr.
(check_externals_expr): Vice versa.
* gfortran.h (gfc_get_formal_from_actual-arglist): New prototype.
(gfc_compare_actual_formal): New prototype.
* interface.c (compare_actual_formal): Rename to
(gfc_compare_actual_forma): New function, make global.
(gfc_get_formal_from_actual_arglist): Make global, and move here from
* trans-types.c (get_formal_from_actual_arglist): Remove here.
(gfc_get_function_type): Use gfc_get_formal_from_actual_arglist.
2019-08-20 Thomas Koenig
PR fortran/91390
* gfortran.dg/bessel_3.f90: Add type mismatch errors.
* gfortran.dg/coarray_7.f90: Rename subroutines to avoid
additional errors.
* gfortran.dg/g77/20010519-1.f: Add -std=legacy. Remove
warnings for ASSIGN. Add warnings for type mismatch.
* gfortran.dg/goacc/acc_on_device-1.f95: Add -std=legacy.
Add cath-all warning.
* gfortran.dg/internal_pack_9.f90: Rename subroutine to
avoid type error.
* gfortran.dg/internal_pack_9.f90: Add -std=legacy. Add
warnings for type mismatch.
* gfortran.dg/pr39937.f: Add -std=legacy and type warnings. Move
here from
* gfortran.fortran-torture/compile/pr39937.f: Move to gfortran.dg.
Index: fortran/frontend-passes.c
===
--- fortran/frontend-passes.c (Revision 274623)
+++ fortran/frontend-passes.c (Arbeitskopie)
@@ -5369,25 +5369,22 @@ gfc_code_walker (gfc_code **c, walk_code_fn_t code
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. */
+/* Common tests for argument checking for both functions and subroutines. */
+
static int
-check_externals_expr (gfc_expr **ep, int *walk_subtrees ATTRIBUTE_UNUSED,
- void *data ATTRIBUTE_UNUSED)
+check_externals_procedure (gfc_symbol *sym, locus *loc, gfc_actual_arglist *actual)
{
- gfc_expr *e = *ep;
- gfc_symbol *sym, *def_sym;
gfc_gsymbol *gsym;
+ gfc_symbol *def_sym = NULL;
- if (e->expr_type != EXPR_FUNCTION)
+ if (sym == NULL || sym->attr.is_bind_c)
return 0;
- sym = e->value.function.esym;
-
- if (sym == NULL || sym->attr.is_bind_c)
+ if (sym->attr.proc != PROC_EXTERNAL && sym->attr.proc != PROC_UNKNOWN)
return 0;
- if (sym->attr.proc != PROC_EXTERNAL && sym->attr.proc != PROC_UNKNOWN)
+ if (sym->attr.if_source == IFSRC_IFBODY || sym->attr.if_source == IFSRC_DECL)
return 0;
gsym = gfc_find_gsymbol (gfc_gsym_root, sym->name);
@@ -5394,15 +5391,39 @@ static int
if (gsym == NULL)
return 0;
- gfc_find_symbol (sym->name, gsym->ns, 0, _sym);
+ if (gsym->ns)
+gfc_find_symbol (sym->name, gsym->ns, 0, _sym);
- if (sym && def_sym)
-gfc_procedure_use (def_sym, >value.function.actual, >where);
+ if (def_sym)
+{
+ gfc_procedure_use (def_sym, , loc);
+ return 0;
+}
+ /* First time we have seen this procedure called. Let's create an
+ "interface" from the call and put it into a new namespace. */
+ gfc_namespace *save_ns;
+ gfc_symbol *new_sym;
+
+ gsym->where = *loc;
+ save_ns = gfc_current_ns;
+ gsym->ns = gfc_get_namespace (gfc_current_ns, 0);
+ gsym->ns->proc_name = sym;
+
+ gfc_get_symbol (sym->name, gsym->ns, _sym);
+ gcc_assert (new_sym);
+ new_sym->attr = sym->attr;
+ new_sym->attr.if_source = IFSRC_DECL;
+ gfc_current_ns = gsym->ns;
+
+ gfc_get_formal_from_actual_arglist (new_sym, actual);
+ gfc_current_ns = save_ns;
+
return 0;
+
}
-/* Callback for external code. */
+/* Callback for calls of external routines. */
static int
check_externals_code (gfc_code **c, int *walk_subtrees ATTRIBUTE_UNUSED,
@@ -5409,32 +5430,43 @@ check_externals_code (gfc_code **c, int *walk_subt
void *data ATTRIBUTE_UNUSED)
{
gfc_code *co = *c;
- gfc_symbol *sym, *def_sym;
- gfc_gsymbol *gsym;
+ gfc_symbol *sym;
+ locus *loc;
+ gfc_actual_arglist *actual;
if (co->op != EXEC_CALL)
return 0;
sym = co->resolved_sym;
- if
