Hello all,
I have a use case of C interoperability (with C++, but could be Python or else) where I want to interface polymorphic classes to C, and I want to avoid writing interfaces to all type-bound functions from the parent class also in the extended classes, when they’re only defined in the parent (maybe abstract) class.
So far I think the best case scenario is to define a pointer to the parent class accessor, like in the following example:
module extend_c
use iso_c_binding
implicit none
! The Fortran classes
type :: a
integer :: i = 42
contains
procedure :: get_i
end type a
type, extends(a) :: b
end type b
! The C opaque pointer classes
type, bind(C) :: a_c
type(c_ptr) :: cptr = c_null_ptr
end type a_c
type, bind(C) :: b_c
type(c_ptr) :: cptr = c_null_ptr
end type
contains
! sample function in the parent class
elemental integer function get_i(this)
class(a), intent(in) :: this
get_i = this%i
end function get_i
! its interface is only defined for the interoperable parent class
integer(c_int) function get_i_c(this) bind(C,name="get_i_c")
type(a_c), intent(in) :: this
type(a), pointer :: athis
call c_f_pointer(this%cptr,athis)
get_i_c = get_i(athis)
end function get_i_c
! this is similar to a dynamic_cast
type(a_c) function get_parent_class(this) result(that) bind(C,name="get_parent_class")
type(b_c), intent(in), value :: this
type(b), pointer :: fthis
type(a), pointer :: fthat
call c_f_pointer(this%cptr,fthis)
if (.not.associated(fthis)) return
! Point to parent class
fthat => fthis%a
! Save it in C type
that%cptr = c_loc(fthat)
end function get_parent_class
end module extend_c
! This could be a C program
program blabla
use extend_c
implicit none
type(b), pointer :: bx => null()
type(b_c) :: bc
type(a_c) :: ac
allocate(bx)
bc%cptr = c_loc(bx)
ac = get_parent_class(bc)
print *, get_i_c(ac)
end program blabla
This is similar to what a dynamic_cast
would do in C++.
The example works great with gfortran, but I’m not sure if:
- is it standard conforming to point to the parent class accessor?
- C++/Fortran gurus (@ivanpribec ) is this the best way to achieve that?
- This of course does not work if
type(a)
isabstract
and I fear this case would be a dead end?
Thank you all!