https://gcc.gnu.org/g:d8e7a2dbe736a57e4cec0293387a1c558b5a155e
commit r15-9748-gd8e7a2dbe736a57e4cec0293387a1c558b5a155e
Author: Thomas Koenig <tkoe...@gcc.gnu.org>
Date: Fri May 30 13:31:58 2025 +0200
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.
(cherry picked from commit 0e77309047a7b479c89f03dcaf2994e050d0f33e)
Diff:
---
gcc/fortran/interface.cc | 9 ++++++-
gcc/testsuite/gfortran.dg/interface_62.f90 | 39 ++++++++++++++++++++++++++++++
2 files changed, 47 insertions(+), 1 deletion(-)
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc
index 753f589ff677..b8542920ce79 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 000000000000..19d4325d552f
--- /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
