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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@198032 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index af13708..7e0e7b4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index 8f7cad7..1b967fa 100644 (file)
--- a/gcc/fortran/interface.c
+++ b/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;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 4035e12..c10ffdc 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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.

diff --git a/gcc/testsuite/gfortran.dg/proc_ptr_42.f90 b/gcc/testsuite/gfortran.dg/proc_ptr_42.f90
new file mode 100644 (file)
index 0000000..8556fdf
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/proc_ptr_42.f90
@@ -0,0 +1,36 @@
+! { 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" } }