re PR fortran/56814 (Bogus Interface mismatch in dummy procedure)

2013-04-17  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56814
	* interface.c (check_result_characteristics): Get result from interface
	if present.


2013-04-17  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/56814
	* gfortran.dg/proc_ptr_42.f90: New.

From-SVN: r198032

gcc/fortran/ChangeLog

+2013-04-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56814
+	* interface.c (check_result_characteristics): Get result from interface
+	if present.
+
 2013-04-17  Janne Blomqvist  <jb@gcc.gnu.org>
 
 	PR fortran/40958

gcc/fortran/interface.c

@@ -1188,8 +1188,15 @@ check_result_characteristics (gfc_symbol *s1, gfc_symbol *s2,
 {
   gfc_symbol *r1, *r2;
 
-  r1 = s1->result ? s1->result : s1;
-  r2 = s2->result ? s2->result : s2;
+  if (s1->ts.interface && s1->ts.interface->result)
+    r1 = s1->ts.interface->result;
+  else
+    r1 = s1->result ? s1->result : s1;
+
+  if (s2->ts.interface && s2->ts.interface->result)
+    r2 = s2->ts.interface->result;
+  else
+    r2 = s2->result ? s2->result : s2;
 
   if (r1->ts.type == BT_UNKNOWN)
     return true;

gcc/testsuite/ChangeLog

+2013-04-17  Janus Weil  <janus@gcc.gnu.org>
+
+	PR fortran/56814
+	* gfortran.dg/proc_ptr_42.f90: New.
+
 2013-04-17  Eric Botcazou  <ebotcazou@adacore.com>
 
 	* gnat.dg/discr41.ad[sb]: New test.

gcc/testsuite/gfortran.dg/proc_ptr_42.f90

+! { dg-do compile }
+!
+! PR 56814: [4.8/4.9 Regression] Bogus Interface mismatch in dummy procedure
+!
+! Contributed by Marco Restelli <mrestelli@gmail.com>
+
+module m1
+  abstract interface
+    pure function i_f(x) result(d)
+    real, intent(in) :: x(:,:)
+    real :: d(size(x,1),size(x,2))
+    end function
+  end interface
+
+  procedure(i_f), pointer :: f => null()
+end module
+
+module m2
+contains
+  pure subroutine ns_dirdata(fun)
+    interface
+    pure function fun(x) result(d)
+      real, intent(in) :: x(:,:)
+      real :: d(size(x,1),size(x,2))
+    end function
+    end interface
+  end subroutine
+end module
+
+program p
+ use m1
+ use m2
+  call ns_dirdata(f)
+end
+
+! { dg-final { cleanup-modules "m1 m2" } }