[Bug fortran/60507] Passing function call into procedure argument not caught

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

http://gcc.gnu.org/bugzilla/show_bug.cgi?id=60507

--- Comment #4 from janus at gcc dot gnu.org ---
(In reply to janus from comment #3)
> The patch in comment #2 ICEs on this extended test case:

Here is a better patch which works on comment 2:


Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c    (revision 208566)
+++ gcc/fortran/interface.c    (working copy)
@@ -2506,6 +2506,18 @@ gfc_has_vector_subscript (gfc_expr *e)
 }


+static bool
+is_procptr_result (gfc_expr *expr)
+{
+  gfc_component *c = gfc_get_proc_ptr_comp (expr);
+  if (c)
+    return (c->ts.interface && (c->ts.interface->attr.proc_pointer == 1));
+  else
+    return ((expr->symtree->n.sym->result != expr->symtree->n.sym)
+        && (expr->symtree->n.sym->result->attr.proc_pointer == 1));
+}
+
+
 /* Given formal and actual argument lists, see if they are compatible.
    If they are compatible, the actual argument list is sorted to
    correspond with the formal list, and elements for missing optional
@@ -2727,10 +2739,10 @@ compare_actual_formal (gfc_actual_arglist **ap, gf
          argument is provided for a procedure pointer formal argument.  */
       if (f->sym->attr.proc_pointer
       && !((a->expr->expr_type == EXPR_VARIABLE
-        && a->expr->symtree->n.sym->attr.proc_pointer)
+        && (a->expr->symtree->n.sym->attr.proc_pointer
+            || gfc_is_proc_ptr_comp (a->expr)))
            || (a->expr->expr_type == EXPR_FUNCTION
-           && a->expr->symtree->n.sym->result->attr.proc_pointer)
-           || gfc_is_proc_ptr_comp (a->expr)))
+           && is_procptr_result (a->expr))))
     {
       if (where)
         gfc_error ("Expected a procedure pointer for argument '%s' at %L",
@@ -2741,7 +2753,12 @@ compare_actual_formal (gfc_actual_arglist **ap, gf
       /* Satisfy F03:12.4.1.3 by ensuring that a procedure actual argument is
      provided for a procedure formal argument.  */
       if (f->sym->attr.flavor == FL_PROCEDURE
-      && gfc_expr_attr (a->expr).flavor != FL_PROCEDURE)
+      && !((a->expr->expr_type == EXPR_VARIABLE
+        && (a->expr->symtree->n.sym->attr.flavor == FL_PROCEDURE
+            || a->expr->symtree->n.sym->attr.proc_pointer
+            || gfc_is_proc_ptr_comp (a->expr)))
+           || (a->expr->expr_type == EXPR_FUNCTION
+           && is_procptr_result (a->expr))))
     {
       if (where)
         gfc_error ("Expected a procedure for argument '%s' at %L",