[Patch, Fortran] PR39850: Too strict checking for procedures as actual argument

[Janus Weil <janus at gcc dot gnu dot org>]

Hi all,

the attached patch loosens the checking for function/subroutine
attributes in procedure actual arguments (and procedure pointer
assignments). Now this is done only if both the actual and the formal
arg have an explicit interface (and are not just declared with
EXTERNAL). It was done wrongly in two test cases in the testsuite
(interface_21.f90 and proc_decl_8.f90).

Moreover the patch includes a small bugfix, which I discovered just by
reading through the code in gfc_compare_interface. Fixing this also
revealed an error in the test case proc_ptr_11.f90.

Regtested on x86_64-unknown-linux-gnu. Ok for trunk?

Cheers,
Janus


2009-06-20  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39850
	* interface.c (gfc_compare_interfaces): Only check attr.function and
	attr.subroutine if both interfaces are explicit. Plus another bugfix.


2009-06-20  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/39850
	* gfortran.dg/interface_19.f90: Add 'cleanup-modules'.
	* gfortran.dg/interface_20.f90: Ditto.
	* gfortran.dg/interface_21.f90: Fix invalid test case.
	* gfortran.dg/interface_22.f90: Add 'cleanup-modules'.
	* gfortran.dg/interface_30.f90: New.
	* gfortran.dg/proc_decl_8.f90: Fix invalid test case.
	* gfortran.dg/proc_ptr_11.f90: Ditto.

Index: gcc/testsuite/gfortran.dg/interface_22.f90
===================================================================
--- gcc/testsuite/gfortran.dg/interface_22.f90	(revision 148747)
+++ gcc/testsuite/gfortran.dg/interface_22.f90	(working copy)
@@ -23,3 +23,6 @@ module gswap
     module procedure sreal, schar, sint => sreal ! { dg-error "Syntax error in MODULE PROCEDURE statement" }
   end interface swap
 end module gswap
+
+! { dg-final { cleanup-modules "foo g gswap" } }
+
Index: gcc/testsuite/gfortran.dg/proc_ptr_11.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_ptr_11.f90	(revision 148747)
+++ gcc/testsuite/gfortran.dg/proc_ptr_11.f90	(working copy)
@@ -55,7 +55,7 @@ program bsp
     end function add
 
     integer function f(x)
-      integer :: x
+      integer,intent(in) :: x
       f = 317 + x
     end function
 
Index: gcc/testsuite/gfortran.dg/interface_19.f90
===================================================================
--- gcc/testsuite/gfortran.dg/interface_19.f90	(revision 148747)
+++ gcc/testsuite/gfortran.dg/interface_19.f90	(working copy)
@@ -27,3 +27,6 @@ intrinsic dcos
 call sub()
 call sub(dcos)
 end
+
+! { dg-final { cleanup-modules "m" } }
+
Index: gcc/testsuite/gfortran.dg/interface_21.f90
===================================================================
--- gcc/testsuite/gfortran.dg/interface_21.f90	(revision 148747)
+++ gcc/testsuite/gfortran.dg/interface_21.f90	(working copy)
@@ -17,6 +17,9 @@ end module m
 
 use m
 implicit none
-EXTERNAL foo  ! implicit interface is undefined
-call sub(foo) ! { dg-error "is not a function" }
+EXTERNAL foo
+call sub(foo)
 end
+
+! { dg-final { cleanup-modules "m" } }
+
Index: gcc/testsuite/gfortran.dg/proc_decl_8.f90
===================================================================
--- gcc/testsuite/gfortran.dg/proc_decl_8.f90	(revision 148747)
+++ gcc/testsuite/gfortran.dg/proc_decl_8.f90	(working copy)
@@ -18,8 +18,8 @@ end module m
 
 use m
 implicit none
-EXTERNAL foo  ! interface is undefined
+EXTERNAL foo
 procedure(cos) :: foo ! { dg-error "Duplicate EXTERNAL attribute specified" }
-call sub(foo)         ! { dg-error "is not a function" }
+call sub(foo)
 end
 ! { dg-final { cleanup-modules "m" } }
Index: gcc/testsuite/gfortran.dg/interface_20.f90
===================================================================
--- gcc/testsuite/gfortran.dg/interface_20.f90	(revision 148747)
+++ gcc/testsuite/gfortran.dg/interface_20.f90	(working copy)
@@ -18,3 +18,6 @@ implicit none
 intrinsic cos
 call sub(cos) ! { dg-error "wrong number of arguments" }
 end
+
+! { dg-final { cleanup-modules "m" } }
+
Index: gcc/fortran/interface.c
===================================================================
--- gcc/fortran/interface.c	(revision 148747)
+++ gcc/fortran/interface.c	(working copy)
@@ -939,20 +939,6 @@ gfc_compare_interfaces (gfc_symbol *s1, 
 {
   gfc_formal_arglist *f1, *f2;
 
-  if (s1->attr.function && !s2->attr.function)
-    {
-      if (errmsg != NULL)
-	snprintf (errmsg, err_len, "'%s' is not a function", s2->name);
-      return 0;
-    }
-
-  if (s1->attr.subroutine && s2->attr.function)
-    {
-      if (errmsg != NULL)
-	snprintf (errmsg, err_len, "'%s' is not a subroutine", s2->name);
-      return 0;
-    }
-
   /* If the arguments are functions, check type and kind
      (only for dummy procedures and procedure pointer assignments).  */
   if ((s1->attr.dummy || s1->attr.proc_pointer)
@@ -967,14 +953,26 @@ gfc_compare_interfaces (gfc_symbol *s1, 
 		      "of '%s'", s2->name);
 	  return 0;
 	}
-      if (s1->attr.if_source == IFSRC_DECL)
-	return 1;
     }
 
   if (s1->attr.if_source == IFSRC_UNKNOWN
       || s2->attr.if_source == IFSRC_UNKNOWN)
     return 1;
 
+  if (s1->attr.function && !s2->attr.function)
+    {
+      if (errmsg != NULL)
+	snprintf (errmsg, err_len, "'%s' is not a function", s2->name);
+      return 0;
+    }
+
+  if (s1->attr.subroutine && s2->attr.function)
+    {
+      if (errmsg != NULL)
+	snprintf (errmsg, err_len, "'%s' is not a subroutine", s2->name);
+      return 0;
+    }
+
   f1 = s1->formal;
   f2 = s2->formal;
 

! { dg-do compile }
!
! PR39850: Too strict checking for procedures as actual argument
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>

real function func()
 func = 42.0
end function func

program test
  external func  ! subroutine or implicitly typed real function
  call sub(func) ! Error: Interface mismatch in dummy procedure 'a' at (1): 'func' is not a function
contains
  subroutine sub(a)
   real, external :: a
   print *, a(0.4)
  end subroutine sub
end