https://gcc.gnu.org/g:c474a50b42ac3f7561f628916cf58810044986b3
commit r16-4332-gc474a50b42ac3f7561f628916cf58810044986b3 Author: Harald Anlauf <[email protected]> Date: Thu Oct 9 18:43:22 2025 +0200 Fortran: fix "unstable" interfaces of external procedures [PR122206] In the testcase repeated invocations of a function showed an apparently unstable interface. This was caused by trying to guess an (inappropriate) interface of the external procedure after processing of the procedure arguments in gfc_conv_procedure_call. The mis-guessed interface showed up in subsequent uses of the procedure symbol in gfc_conv_procedure_call. The solution is to check for an existing interface of an external procedure before trying to wildly guess based on just the actual arguments. PR fortran/122206 gcc/fortran/ChangeLog: * trans-types.cc (gfc_get_function_type): Do not clobber an existing procedure interface. gcc/testsuite/ChangeLog: * gfortran.dg/interface_abstract_6.f90: New test. Diff: --- gcc/fortran/trans-types.cc | 1 + gcc/testsuite/gfortran.dg/interface_abstract_6.f90 | 53 ++++++++++++++++++++++ 2 files changed, 54 insertions(+) diff --git a/gcc/fortran/trans-types.cc b/gcc/fortran/trans-types.cc index 26645b0f7f67..dfdac600c24d 100644 --- a/gcc/fortran/trans-types.cc +++ b/gcc/fortran/trans-types.cc @@ -3441,6 +3441,7 @@ gfc_get_function_type (gfc_symbol * sym, gfc_actual_arglist *actual_args, } } if (sym->backend_decl == error_mark_node && actual_args != NULL + && sym->ts.interface == NULL && sym->formal == NULL && (sym->attr.proc == PROC_EXTERNAL || sym->attr.proc == PROC_UNKNOWN)) gfc_get_formal_from_actual_arglist (sym, actual_args); diff --git a/gcc/testsuite/gfortran.dg/interface_abstract_6.f90 b/gcc/testsuite/gfortran.dg/interface_abstract_6.f90 new file mode 100644 index 000000000000..05b9a4e805f2 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_abstract_6.f90 @@ -0,0 +1,53 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/122206 +! +! Verify that procedure interfaces are "stable" + +module test_example + use, intrinsic :: iso_c_binding, only: c_double, c_int + implicit none + + abstract interface + function simple_interface(iarg1, arg2) bind(c) result(res) + import c_double, c_int + integer(c_int), value, intent(in) :: iarg1 + real(c_double), value, intent(in) :: arg2 + real(c_double) :: res + end function simple_interface + end interface + + procedure(simple_interface), bind(c,name="simple_function") :: simple_function + + interface + function other_interface(iarg1, arg2) result(res) + import c_double, c_int + integer(c_int), value, intent(in) :: iarg1 + real(c_double), value, intent(in) :: arg2 + real(c_double) :: res + end function other_interface + end interface + + procedure(other_interface) :: other_function + +contains + subroutine test_example_interface + implicit none + integer(c_int) :: iarg1 = 2 + real(c_double) :: arg2 = 10. + real(c_double) :: val1, val2 + + val1 = simple_function(iarg1, arg2) + val2 = simple_function(iarg1, arg2) + if (val1 /= val2) stop 1 + + val1 = other_function(iarg1, arg2) + val2 = other_function(iarg1, arg2) + if (val1 /= val2) stop 2 + + end subroutine test_example_interface +end module test_example + +! { dg-final { scan-tree-dump-times "simple_function \\(iarg1, arg2\\);" 2 "original"} } +! { dg-final { scan-tree-dump-times "other_function \\(iarg1, arg2\\);" 2 "original"} }
