mirror of git://gcc.gnu.org/git/gcc.git
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:
parent
579de8f529
commit
c474a50b42
|
@ -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);
|
||||
|
|
|
@ -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"} }
|
Loading…
Reference in New Issue