This is the mail archive of the
gcc-bugs@gcc.gnu.org
mailing list for the GCC project.
[Bug fortran/60507] Passing function call into procedure argument not caught
- From: "janus at gcc dot gnu.org" <gcc-bugzilla at gcc dot gnu dot org>
- To: gcc-bugs at gcc dot gnu dot org
- Date: Tue, 18 Mar 2014 15:33:38 +0000
- Subject: [Bug fortran/60507] Passing function call into procedure argument not caught
- Auto-submitted: auto-generated
- References: <bug-60507-4 at http dot gcc dot gnu dot org/bugzilla/>
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",