[Bug fortran/64508] [F03] interface check missing for procedure pointer component as actual argument

["janus at gcc dot gnu.org" <gcc-bugzilla@gcc.gnu.org>]

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))