[Patch, fortran] PR25098 - Variable as actual argument for procedure dummy argument allowed

[Paul Thomas <paulthomas2 at wanadoo dot fr>]

:ADDPATCH fortran:

Gfortran does not emit any diagnostic when a variable actual argument is 
passed to a function with a procedure formal argument.  This patch fixes 
that.  It is a very simple patch in which most of the care was devoted 
to ensuring that correct code was not blown out of the water.

The detection of the error is effected in interface.c.  If the actual 
argument is a variable and the formal argument flavor is procedure, the 
only way in which this cannot be an error is if the procedure is already 
compiled but not declared in the current namespace.  This is checked for 
by looking for a gsymbol with the same name that represents a 
procedure.  A bit further downstream, the error message is changed to 
suit this situation.  The testcase checks that the original problem is 
resolved and that good code gets through.

Regtested on FC5/Athlon1700.  OK for trunk and, a week later, for 4.1?

Paul

2006-05-15  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/25098
   * interface.c (compare_parameter): If the actual argument is a
   variable and the formal a procedure, this can only not be an
   error if a gsymbol exists for a procedure of the same name.
   * (compare_actual_formal): Provide a specific error message for
   the case of a variable masquerading as a procedure.

2006-05-15  Paul Thomas  <pault@gcc.gnu.org>

   PR fortran/25098
   * gfortran.dg/dummy_procedure_1.f90: New test.

Index: gcc/fortran/interface.c
===================================================================
*** gcc/fortran/interface.c	(revision 113795)
--- gcc/fortran/interface.c	(working copy)
*************** compare_parameter (gfc_symbol * formal, 
*** 1113,1118 ****
--- 1113,1119 ----
  		   int ranks_must_agree, int is_elemental)
  {
    gfc_ref *ref;
+   gfc_gsymbol *gsym;
  
    if (actual->ts.type == BT_PROCEDURE)
      {
*************** compare_parameter (gfc_symbol * formal, 
*** 1128,1133 ****
--- 1129,1145 ----
  
        return compare_interfaces (formal, actual->symtree->n.sym, 0);
      }
+   else if (actual->expr_type == EXPR_VARIABLE
+ 	     && formal->attr.flavor == FL_PROCEDURE)
+     {
+       /* This parameters are not compatible, unless the procedure
+ 	 has already been compiled in this file.  */
+       gsym = gfc_find_gsymbol (gfc_gsym_root,
+ 			       actual->symtree->n.sym->name);
+       if (gsym == NULL || (gsym->type != GSYM_FUNCTION
+ 			     && gsym->type != GSYM_SUBROUTINE))
+ 	return 0;
+     }
  
    if ((actual->expr_type != EXPR_NULL || actual->ts.type != BT_UNKNOWN)
        && !gfc_compare_types (&formal->ts, &actual->ts))
*************** compare_actual_formal (gfc_actual_arglis
*** 1270,1276 ****
        if (!compare_parameter
  	  (f->sym, a->expr, ranks_must_agree || rank_check, is_elemental))
  	{
! 	  if (where)
  	    gfc_error ("Type/rank mismatch in argument '%s' at %L",
  		       f->sym->name, &a->expr->where);
  	  return 0;
--- 1282,1295 ----
        if (!compare_parameter
  	  (f->sym, a->expr, ranks_must_agree || rank_check, is_elemental))
  	{
! 	  if (where == NULL)
! 	    return 0;
! 
! 	  if (a->expr->expr_type == EXPR_VARIABLE
! 			 && f->sym->attr.flavor == FL_PROCEDURE)
! 	    gfc_error ("Expected a procedure for argument '%s' at %L",
! 		       f->sym->name, &a->expr->where);
! 	  else
  	    gfc_error ("Type/rank mismatch in argument '%s' at %L",
  		       f->sym->name, &a->expr->where);
  	  return 0;
Index: gcc/testsuite/gfortran.dg/dummy_procedure_1.f90
===================================================================
*** gcc/testsuite/gfortran.dg/dummy_procedure_1.f90	(revision 0)
--- gcc/testsuite/gfortran.dg/dummy_procedure_1.f90	(revision 0)
***************
*** 0 ****
--- 1,47 ----
+ ! { dg-do compile }
+ ! Test the patch for PR25098, where passing a variable as an
+ ! actual argument to a formal argument that is a procedure
+ ! went undiagnosed.
+ !
+ ! Based on contribution by Joost VandeVondele  <jv244@cam.ac.uk>
+ !
+ integer function y()
+   y = 1
+ end
+ integer function z()
+   z = 1
+ end
+ 
+ module m1
+ contains
+   subroutine s1(f)
+     interface
+       function f()
+         integer f
+       end function f
+     end interface
+   end subroutine s1
+ end module m1
+ 
+   use m1
+   external y
+   interface
+    function x()
+      integer x
+    end function x
+   end interface
+ 
+   integer :: i, y, z
+   i=1
+   call s1(i) ! { dg-error "Expected a procedure for argument" }
+   call s1(w) ! { dg-error "not allowed as an actual argument" }
+   call s1(x) ! explicit interface
+   call s1(y) ! declared external
+   call s1(z) ! already compiled
+ contains
+   integer function w()
+     w = 1
+   end function w
+ end
+ 
+ ! { dg-final { cleanup-modules "m1" } }
\ No newline at end of file

2006-05-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25098
	* interface.c (compare_parameter): If the actual argument is a
	variable and the formal a procedure, this can only not be an
	error if a gsymbol exists for a procedure of the same name.
	* (compare_actual_formal): Provide a specific error message for
	the case of a variable masquerading as a procedure.

2006-05-15  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/25098
	* gfortran.dg/dummy_procedure_1.f90: New test.