Type mismatch for passed external function

This obvious and simple patch fixes a 15/16 regression where the
typespec of a global function was in the RESULT clause and not
in the symbol itself.

gcc/fortran/ChangeLog:

	PR fortran/120355
	* interface.cc (compare_parameter): If the global function has a
	result clause, take typespec from there for the comparison against
	the dummy argument.

gcc/testsuite/ChangeLog:

	PR fortran/120355
	* gfortran.dg/interface_62.f90: New test.

diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 753f589ff6779acc155d1b02ed0856ba4ab35e6a..b8542920ce79efeeb061294cac0f90aca36f4442 100644 (file)
--- a/gcc/fortran/interface.cc
+++ b/gcc/fortran/interface.cc
@@ -2547,7 +2547,14 @@ compare_parameter (gfc_symbol *formal, gfc_expr *actual,
                        }
                      else if (formal->attr.function)
                        {
-                         if (!gfc_compare_types (&global_asym->ts,
+                         gfc_typespec ts;
+
+                         if (global_asym->result)
+                           ts = global_asym->result->ts;
+                         else
+                           ts = global_asym->ts;
+
+                         if (!gfc_compare_types (&ts,
                                                  &formal->ts))
                            {
                              gfc_error ("Type mismatch at %L passing global "

diff --git a/gcc/testsuite/gfortran.dg/interface_62.f90 b/gcc/testsuite/gfortran.dg/interface_62.f90
new file mode 100644 (file)
index 0000000..19d4325
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/interface_62.f90
@@ -0,0 +1,39 @@
+! { dg-do compile }
+! PR fortran/120355 - this was rejected because the typespec from
+! the RESULT clause was not picked up.
+! Test case jsberg@bnl.gov.
+
+program p
+  implicit none
+  integer :: i,j
+  interface
+     function s(x) result(y)
+       implicit none
+       integer, intent(in) :: x
+       integer :: y
+     end function s
+  end interface
+  i = 0
+  call t(s,i,j)
+contains
+  subroutine t(f,x,y)
+    implicit none
+    integer, intent(in) :: x
+    integer, intent(out) :: y
+    interface
+       function f(x) result(y)
+         implicit none
+         integer, intent(in) :: x
+         integer :: y
+       end function f
+    end interface
+    y = f(x)
+  end subroutine t
+end program p
+
+function s(x) result(y)
+  implicit none
+  integer, intent(in) :: x
+  integer :: y
+  y = 1 - x
+end function s