- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
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
Link Copied
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hello Ned,
If you try to return a "class" from the function, do not matter if it is the base class, the type4 or a polymorphic one (*), I get an internal compiler error. What is strange, because I have a project where I do exactly this (but it is not in a DLL).
If you just return a "type(Test4Type)", everything works INSIDE the function when called from the main routine, but you get an AV in the main project, because to this works, I think you should return a polymorphic class(*) and do a Select Type to use it as your BaseClass.
So, I tried a "new" thing, that is instead of returning the object, to pass a polymorphic class pointer to the routine. I changed the dll exported routine and the main code a little:
function gettype(to_allocate) !DEC$ ATTRIBUTES DLLEXPORT::GETTYPE use BaseModule, only: BaseType use Type4Module, only: Test4Type implicit none class(*), pointer :: to_allocate logical :: gettype write (*,*) 'Inside gettype' nullify (to_allocate) allocate(Test4Type::to_allocate) select type (to_allocate) type is (Test4Type) to_allocate%name = 'Type 4 initial name' end select gettype = .true. end function gettype
Now, the new Main code:
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(to_allocate) result(r) class(*), pointer :: to_allocate logical :: r END function gettype_intf END INTERFACE integer(LPVOID) :: proc_address PROCEDURE(gettype_intf), POINTER :: my_proc class(*), pointer :: t4 logical :: res integer(handle) lib_handle character(len=50) :: 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) res = .false. nullify (t4) res = my_proc(t4) print *, 'result: ', res select type (t4) class is (BaseType) print *, t4 call t4%GetName(name) print*, 'on MAIN: name t4 = ',name class default print *, "t4 is not a BaseType derived class" end select stop end program main
This works.
But you have to pay attention to, at least, two main concerns. Scalability/Maintanance and Memory allocation/deallocation on DLL's, that creates lots of problems. At least was what I could pick up here and there. ;)
I tested the original conde on ifort 14.0.4 and on the new 15 (out on the last week (I think).
None worked with the original code (AV) and with the routine returning in the DLL a polymorphic pointer (Compiler Internal error).
Also, it seems that an "associated" check to the pointer after the DLL routine is called do not works, for some reason. Maybe because the pointer was allocated inside the DLL?
Good luck! :)
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Eduardo,
Thank you so much for taking the time to work on this problem! I am looking forward to downloading a trial of ifort 15 and testing your suggestion.
Regards,
Ned
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Eduardo, would you please provide us with a copy of the source that results in an internal compiler error? Thanks.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hello Steve,
I'm sending attached the project for the DLL. As it is now, it raises an ICE. If you delete the gettext2 function, it compiles fine. It seems that inside DLL's projects, the compiler doesn't like routines that return a "pointer to class".
I managed to get the routine working returning a pointer for type BaseType, like this:
function gettype3() !DEC$ ATTRIBUTES DLLEXPORT::GETTYPE3 use BaseModule, only: BaseType use Type4Module, only: Test4Type implicit none Type(BaseType), pointer :: gettype3 class(*), pointer :: myType write (*,*) 'Inside gettype3' allocate(Test4Type::myType) select type (myType) type is (Test4Type) myType%name = 'Type 4 initial name for gettype 3' end select select type (myType) type is (BaseType) gettype3 => myType end select gettype3 => myType print *, gettype3%name return end function gettype3
But I think the use of a pointer to a class should work. At least it works if it's not a DLL.
Cheers,
Eduardo Jauch
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Thanks., Eduardo. That this is in a DLL is not relevant. If you disable "Check routine interfaces", it compiles. Even better would be to put these functions in a module, since you're required to have an explicit interface for them anyway. If you do that, the error goes away as well.
Escalated as issue DPD200361372.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Hi Steve!
Yes. I have an object that has a member function that returns a polymorphic pointer (class(*)) and it works well. In this case, it is inside a module.
Thanks for the suggestions.
I myself want to explore more this "DLL" side, because I'm thinking in prepare a small "plugin system" for the model that I work on and it is good to explore all the possibilities.
Cheers,
Eduardo.
- Mark as New
- Bookmark
- Subscribe
- Mute
- Subscribe to RSS Feed
- Permalink
- Report Inappropriate Content
Eduardo, I have been told to expect the fix for the problem you reported will be in the 16.0 product release later this year.
- Subscribe to RSS Feed
- Mark Topic as New
- Mark Topic as Read
- Float this Topic for Current User
- Bookmark
- Subscribe
- Printer Friendly Page