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.
This commit is contained in:
Harald Anlauf 2025-10-09 18:43:22 +02:00
parent 579de8f529
commit c474a50b42
2 changed files with 54 additions and 0 deletions

View File

@ -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);

View File

@ -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"} }