Quantcast
Channel: Intel® Fortran Compiler
Viewing all articles
Browse latest Browse all 3270

Using extended derived type in a DLL

$
0
0

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

Viewing all articles
Browse latest Browse all 3270

Latest Images

Trending Articles



Latest Images

<script src="https://jsc.adskeeper.com/r/s/rssing.com.1596347.js" async> </script>