diff options
| author | Thomas Koenig <tkoenig@gcc.gnu.org> | 2025-05-30 13:31:58 +0200 |
|---|---|---|
| committer | Thomas Koenig <tkoenig@gcc.gnu.org> | 2025-05-31 08:45:51 +0200 |
| commit | d8e7a2dbe736a57e4cec0293387a1c558b5a155e (patch) | |
| tree | 6c394e46b3b91dccc10c13fb20e10ed0f4e092ab | |
| parent | 1d3b863c20831dc56f3671ee053d00440c322248 (diff) | |
| download | gcc-d8e7a2dbe736a57e4cec0293387a1c558b5a155e.zip gcc-d8e7a2dbe736a57e4cec0293387a1c558b5a155e.tar.gz gcc-d8e7a2dbe736a57e4cec0293387a1c558b5a155e.tar.bz2 | |
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)
| -rw-r--r-- | gcc/fortran/interface.cc | 9 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/interface_62.f90 | 39 |
2 files changed, 47 insertions, 1 deletions
diff --git a/gcc/fortran/interface.cc b/gcc/fortran/interface.cc index 753f589..b854292 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 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 |