CptrWrapper.F90 Source File

module ud2f_CptrWrapper
   use, intrinsic :: iso_c_binding, only: c_ptr, C_NULL_PTR, c_associated
   implicit none
   private

   public :: CptrWrapper

!================================ CPTRWRAPPER ==================================
! Base class to wrap type(c_ptr) instances used for udunits2 objects that cannot 
! interface directly to fortran. Each extended class must provide a subroutine
! to free the memory associated with cptr_
   type, abstract :: CptrWrapper
      private
      type(c_ptr) :: cptr_ = C_NULL_PTR
   contains
      procedure :: get_cptr
      procedure :: set_cptr
      procedure :: is_free
      procedure :: free
      procedure(I_free_memory), deferred :: free_memory
   end type CptrWrapper

   abstract interface

      subroutine I_free_memory(this)
         import :: CptrWrapper
         class(CptrWrapper), intent(in) :: this
      end subroutine I_Free_Memory

   end interface

contains

   type(c_ptr) function get_cptr(this)
      class(CptrWrapper), intent(in) :: this

      get_cptr = this%cptr_

   end function get_cptr

   subroutine set_cptr(this, cptr)
      class(CptrWrapper), intent(inout) :: this
      type(c_ptr), intent(in) :: cptr
      this%cptr_ = cptr
   end subroutine set_cptr

   logical function is_free(this)
      class(CptrWrapper), intent(in) :: this

      is_free = .not. c_associated(this%cptr_)

   end function is_free

   ! Free up memory pointed to by cptr_ and set cptr_ to c_null_ptr
   subroutine free(this)
      class(CptrWrapper), intent(inout) :: this

      if(this%is_free()) return
      call this%free_memory()
      this%cptr_ = c_null_ptr

   end subroutine free

end module ud2f_CptrWrapper