I am trying to find a way to have a DLL that defines a type that extends a base derived type that is used by the main executable. The extended type needs to be able to be accessed by a pointer and it needs to contain type-bound procedures that override procedures in the base type. The main program will not be able to USE the module where the extended type is defined, except indirectly through the DLL. So far I have come up with code that enables the main program to instantiate an object of the extended type, and see public data members, but I get Access Violation when I try to invoke a type-bound procedure. Here's what I have so far. In the code below, the AV happens at "call t4%GetName(name)". Before that line executes, in the debugger I can see that t4%Name equals 'Type 4 initial name' as expected. If any one has suggestions about what I am missing, that would be great.
Main project:
BaseType.f90:
module BaseModule implicit none private public :: BaseType type :: BaseType character(len=50) :: Name contains procedure :: GetName end type BaseType contains subroutine GetName(this, name) implicit none class(BaseType), intent(in) :: this character(len=*), intent(inout) :: name name = this%Name return end subroutine GetName end module BaseModule
main.f90:
program main use ifport use ifwin use, intrinsic :: ISO_C_BINDING, only: & C_F_PROCPOINTER, C_FUNPTR, C_INTPTR_T, & C_NULL_CHAR, C_CHAR, C_ASSOCIATED, C_PTR, c_funloc, & C_NULL_FUNPTR use BaseModule, only: BaseType implicit none interface function GetProcAddress(hModule, lpProcName) & bind(C, name='GetProcAddress') use, intrinsic :: ISO_C_BINDING, only: & C_FUNPTR, C_INTPTR_T, C_CHAR implicit none type(C_FUNPTR) :: GetProcAddress integer(C_INTPTR_T), value :: hModule character(KIND=C_CHAR) :: lpProcName(*) end function GetProcAddress END INTERFACE abstract INTERFACE function gettype_intf() result(tt) import BaseType class(BaseType), pointer :: tt END function gettype_intf END INTERFACE integer(LPVOID) :: proc_address PROCEDURE(gettype_intf), POINTER :: my_proc class(BaseType), pointer :: t4 integer(handle) lib_handle character(len=20) :: name character(len=20) :: procname ! nullify(t4) lib_handle = LoadLibrary(C_CHAR_'Type4lib.dll' // C_NULL_CHAR) if (lib_handle == 0) stop "DLL not loaded" proc_address = GetProcAddress( lib_handle, & C_CHAR_'GETTYPE' // C_NULL_CHAR ) IF (proc_address == 0) STOP 'Unable to obtain procedure address' call C_F_PROCPOINTER(transfer(proc_address,C_NULL_FUNPTR), my_proc) t4 => my_proc() call t4%GetName(name) print*, 'name t4 = ',name stop end program main
DLL project:
(includes BaseType.f90, above)
Test4Type.f90:
module Type4Module use BaseModule, only: BaseType implicit none private public :: Test4Type type, extends (BaseType) :: Test4Type contains procedure :: GetName => get_name end type Test4Type contains subroutine get_name(this, name) implicit none class(Test4Type), intent(in) :: this character(len=*), intent(inout) :: name ! name = this%Name return end subroutine get_name end module Type4Module
Type4DLL.f90:
function gettype() result (tt) !DEC$ ATTRIBUTES DLLEXPORT::GETTYPE use BaseModule, only: BaseType use Type4Module, only: Test4Type implicit none type(Test4Type), pointer :: tt ! allocate(tt) tt%name = 'Type 4 initial name' return end function gettype