https://gcc.gnu.org/bugzilla/show_bug.cgi?id=119889
Bug ID: 119889
Summary: Internal compiler error using bind(C) functionality
Product: gcc
Version: unknown
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: juergen.reuter at desy dot de
Target Milestone: ---
Created attachment 61169
--> https://gcc.gnu.org/bugzilla/attachment.cgi?id=61169&action=edit
Reproducer
The following code below (and attached) triggers an internal compiler error. I
do believe that there is something fishy with that code as it also triggers an
ICE with ifx and Nagfor:
gfortran -c ol_interface.f90
ol_interface.f90:59:63:
59 | tmp_fun => dlsym(lib, "ol_f_n_external_" // trim(proc))
| 1
internal compiler error: in gfc_typenode_for_spec, at
fortran/trans-types.c:1124
0x7fa63338ad8f __libc_start_call_main
../sysdeps/nptl/libc_start_call_main.h:58
0x7fa63338ae3f __libc_start_main_impl
../csu/libc-start.c:392
Reproducer:
module ol_dlfcn
use, intrinsic :: iso_c_binding, only: c_char, c_ptr, c_funptr, &
& c_null_char, c_associated, c_f_procpointer
implicit none
private
public :: dlsym
interface
function c_dlsym(lib, sym) bind(c,name="dlsym")
! void *dlsym(void *lib, const char *sym);
use, intrinsic :: iso_c_binding, only: c_ptr, c_char, c_funptr
implicit none
type(c_ptr), value :: lib
character(kind=c_char), dimension(*), intent(in) :: sym
type(c_funptr) :: c_dlsym
end function c_dlsym
end interface
contains
function dlsym(lib, sym, fatal) result(f_funp)
! fatal: 0=silent (default), 1=warning, 2=error
implicit none
type(c_ptr), intent(in) :: lib
character(len=*), intent(in) :: sym
integer, intent(in), optional :: fatal
type(c_funptr) :: c_funp
procedure(), pointer :: f_funp
c_funp = c_dlsym(lib, trim(sym) // c_null_char)
if (c_associated(c_funp)) then
call c_f_procpointer(c_funp, f_funp)
else
f_funp => null()
end if
end function dlsym
end module ol_dlfcn
module openloops
use, intrinsic :: iso_c_binding, only: c_ptr, c_null_ptr
implicit none
private
type process_handle
type(c_ptr) :: library_handle = c_null_ptr
end type process_handle
contains
function get_process_handle(lib, proc)
use ol_dlfcn, only: dlsym
implicit none
type(c_ptr), intent(in) :: lib
character(len=*), intent(in) :: proc
type(process_handle) :: get_process_handle
procedure(dlsym), pointer :: tmp_fun
! number of external particles
!!! Triggres the ICE
tmp_fun => dlsym(lib, "ol_f_n_external_" // trim(proc))
end function get_process_handle
end module openloops
