re PR fortran/60507 (Passing function call into procedure argument not caught)

2015-01-02  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60507
	* interface.c (is_procptr_result): New function to check if an
	expression is a procedure-pointer result.
	(compare_actual_formal): Use it.

2015-01-02  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/60507
	* gfortran.dg/dummy_procedure_11: New.

From-SVN: r219141

gcc/fortran/interface.c

@@ -2503,6 +2503,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
@@ -2724,10 +2736,10 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
          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 %qs at %L",
@@ -2738,7 +2750,12 @@ compare_actual_formal (gfc_actual_arglist **ap, gfc_formal_arglist *formal,
       /* 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 %qs at %L",

gcc/testsuite/gfortran.dg/dummy_procedure_11.f90

+! { dg-do compile }
+!
+! PR 60507: Passing function call into procedure argument not caught
+!
+! Contributed by Vladimir Fuka <vladimir.fuka@gmail.com>
+
+type :: t
+  procedure(g), pointer, nopass :: ppc => g
+end type
+
+procedure(g), pointer :: pp => g
+type(t)::x
+
+print *, f(g)
+print *, f(g())      ! { dg-error "Expected a procedure for argument" }
+print *, f(pp)
+print *, f(pp())     ! { dg-error "Expected a procedure for argument" }
+print *, f(x%ppc)
+print *, f(x%ppc())  ! { dg-error "Expected a procedure for argument" }
+
+contains
+
+  real function f(fun)
+    procedure(g) :: fun
+    f = fun()
+  end function
+
+  real function g()
+    g = 1.
+  end function
+
+end