Hello world,
I have just committed the attached patch as obvious and simple
after regression-testing. Will backport to gcc 15 soonish.
This fixes a 15/16 regression where the code was looking at
the typespec of the symbol which we don't set if there is
a RESULT clause.
Thanks to Harald for pointing out the source of the problem in the PR.
Best regards
Thomas
Type mismatch for passed external function
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 753f589ff67..b8542920ce7 100644
--- 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
index 00000000000..19d4325d552
--- /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 jsb...@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