This is an issue I recently stumbled upon when trying to expose a class polymorphic object via bind(C)
in Fortran.
Let’s take a simplified C API wrapping Fortran objects (mainly removing the error handling for readability), exposing a constructor for a specific type extending from an abstract base class and a deconstructor for a polymorphic object as well as a method to actually calculate something with such a polymorphic object:
module m_api
use, intrinsic :: iso_c_binding
! Defines the abstract base class (ABC)
use m_abc, only : abc_type
! Defines an implementation extending the ABC,
! usually there is more than one
use m_impl, only : impl_type
implicit none
! Thin wrapper to make class polymorphic object bind(C) compatible
! typedef struct _m_abc* m_abc;
type :: vp_abc
class(abc_type), allocatable :: ptr
end type vp_class
contains
! extern m_abc new_impl(double param);
function new_impl_api(input) result(vabc) bind(C, name="new_impl")
! Void pointer to Fortran data
type(c_ptr) :: vabc
! Actual object exposed to C
type(vp_abc), pointer :: abc
! Some input parameter for this specific implementation
real(c_double), value :: param
allocate(abc)
abc%ptr = impl_type(param)
vabc = c_loc(abc)
end function new_impl_api
! extern void abc_get_prop(m_abc abc, double* val);
subroutine abc_get_prop_api(vabc, val) bind(C, name="abc_get_prop")
! Void pointer to Fortran data
type(c_ptr), value :: vabc
! Actual object exposed to C
type(vp_abc), pointer :: abc
! Output property of the ABC
real(c_double), intent(out) :: val
val = 0.0_c_double
if (c_associated(vabc)) then
call c_f_pointer(vabc, abc)
if (allocated(abc%ptr)) then
call abc%ptr%get_prop(val)
end if
end if
end subroutine get_prop_api
! extern void delete_abc
subroutine delete_abc_api(vabc) bind(C, name="delete_abc")
! Void pointer to Fortran data
type(c_ptr), intent(inout) :: vabc
! Actual object exposed to C
type(vp_abc), pointer :: abc
if (c_associated(vabc)) then
call c_f_pointer(vabc, abc)
deallocate(abc)
vabc = c_null_ptr
end if
end subroutine delete_abc_api
end module m_api
In C one creates an instance of the polymorphic object, with the specific constructor, perform the calculation and than cleanup again:
include <stdio.h>
include "m.h"
int main(void) {
double res;
m_abc obj = new_impl(1.0);
abc_get_prop(obj, &res);
delete_abc(&obj);
printf("Result: %lf\n", res);
return 0;
}
Now the question is, how can I create an API to allow the C side user to query the actual type of the object conveniently and use it as the specific type rather than the abstract type in further calculations? The problem feels like I’m trying to expose the select type
mechanism of Fortran to C.
A more concrete example would be simple-dftd3/api.f90 at main · awvwgk/simple-dftd3 · GitHub.