https://gcc.gnu.org/bugzilla/show_bug.cgi?id=64508
janus at gcc dot gnu.org changed:
What |Removed |Added
----------------------------------------------------------------------------
Status|UNCONFIRMED |ASSIGNED
Last reconfirmed| |2015-01-06
Assignee|unassigned at gcc dot gnu.org |janus at gcc dot gnu.org
Ever confirmed|0 |1
--- Comment #1 from janus at gcc dot gnu.org ---
Draft patch (regtest cleanly):
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c (Revision 219257)
+++ gcc/fortran/interface.c (Arbeitskopie)
@@ -1922,6 +1922,8 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
{
gfc_ref *ref;
bool rank_check, is_pointer;
+ char err[200];
+ gfc_component *ppc;
/* If the formal arg has type BT_VOID, it's to one of the iso_c_binding
procs c_f_pointer or c_f_procpointer, and we need to accept most
@@ -1942,7 +1944,6 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
if (actual->ts.type == BT_PROCEDURE)
{
- char err[200];
gfc_symbol *act_sym = actual->symtree->n.sym;
if (formal->attr.flavor != FL_PROCEDURE)
@@ -1976,6 +1977,19 @@ compare_parameter (gfc_symbol *formal, gfc_expr *a
return 1;
}
+ ppc = gfc_get_proc_ptr_comp (actual);
+ if (ppc)
+ {
+ if (!gfc_compare_interfaces (formal, ppc->ts.interface, ppc->name, 0, 1,
+ err, sizeof(err), NULL, NULL))
+ {
+ if (where)
+ gfc_error ("Interface mismatch in dummy procedure %qs at %L: %s",
+ formal->name, &actual->where, err);
+ return 0;
+ }
+ }
+
/* F2008, C1241. */
if (formal->attr.pointer && formal->attr.contiguous
&& !gfc_is_simply_contiguous (actual, true))
