Fortran derived types containing pointers to be accessible from C

Question

I have a Fortran code with many derived types containing pointers. I am writing a C++ code which needs to access these variables. I cannot rewrite these derived types withou

Answer 1

You can write some interoperable accessor procedures in Fortran that operate on the derived type and expose the necessary variables to the C++ code. This is very similar to how general C++ code interacts with private member variables of a class.

You can use the C address of an object of type SIMPLEF as an opaque handle in the C++ code - the type in Fortran does not have to have the BIND(C) attribute to allow objects of that type to be passed to C_LOC (though objects of that type will need to have the TARGET attribute).

For array data, you may need to provide several entry points for the data getters, to allow appropriate coordination of the memory buffer used to transfer the data from Fortran to C.

MODULE simple
  IMPLICIT NONE
  ! An example of an non-interoperable type (no BIND(C)).
  TYPE :: SIMPLEF
    INTEGER :: A
    ! Note that given the problem description, the component B 
    ! appears to have value semantics.  If so, as of Fortran 2003 
    ! this should be an ALLOCATABLE component.  Because it is 
    ! a pointer component, we will default initialize it to 
    ! help avoid its pointer association status becoming 
    ! inadvertently undefined 
    INTEGER, POINTER :: B(:) => NULL()
  END TYPE SIMPLEF
CONTAINS
  FUNCTION GetHandle() RESULT(handle) BIND(C, NAME='GetHandle')
    USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR, C_LOC
    TYPE(C_PTR) :: handle
    TYPE(SIMPLEF), POINTER :: p
    !***
    ! For the sake of example we are exposing an interface that 
    ! allows client code to create an object.  Perhaps in your 
    ! case the object already exists and its lifetime is managed 
    ! in some other way, in which case:
    !
    !   handle = C_LOC(existing_object_with_target_attribute)
    !
    ! and you are done - no need for ReleaseHandle.
    ALLOCATE(p)
    ! Perhaps some constructory sort of stuff here?
    p%A = 666
    ! Use the C address of the object as an opaque handle.
    handle = C_LOC(p)
  END FUNCTION GetHandle

  ! If you create objects, you need to be able to destroy them.
  SUBROUTINE ReleaseHandle(handle) BIND(C, NAME='ReleaseHandle')
    USE, INTRINSIC :: ISO_C_BINDING, ONLY: C_PTR, C_F_POINTER
    TYPE(C_PTR), INTENT(IN), VALUE :: handle
    TYPE(SIMPLEF), POINTER :: p
    !***
    CALL C_F_POINTER(handle, p)
    DEALLOCATE(p)
  END SUBROUTINE ReleaseHandle

  SUBROUTINE SetA(handle, a) BIND(C, NAME='SetA')
    USE, INTRINSIC :: ISO_C_BINDING, ONLY:  &
        C_PTR, C_F_POINTER, C_INT
    TYPE(C_PTR), INTENT(IN), VALUE :: handle
    INTEGER(C_INT), INTENT(IN), VALUE :: a  
    TYPE(SIMPLEF), POINTER :: p
    !***
    CALL C_F_POINTER(handle, p)
    p%A = a
  END SUBROUTINE SetA

  FUNCTION QueryA(handle) RESULT(a) BIND(C, NAME='QueryA')
    USE, INTRINSIC :: ISO_C_BINDING, ONLY:  &
        C_PTR, C_F_POINTER, C_INT
    TYPE(C_PTR), INTENT(IN), VALUE :: handle
    INTEGER(C_INT) :: a  
    TYPE(SIMPLEF), POINTER :: p
    !***
    CALL C_F_POINTER(handle, p)
    a = p%A
  END FUNCTION QueryA

  SUBROUTINE SetB(handle, data, data_size) BIND(C, NAME='SetB')
    USE, INTRINSIC :: ISO_C_BINDING, ONLY:  &
        C_PTR, C_F_POINTER, C_INT
    TYPE(C_PTR), INTENT(IN), VALUE :: handle
    INTEGER(C_INT), INTENT(IN), VALUE :: data_size
    INTEGER(C_INT), INTENT(IN) :: data(data_size)
    TYPE(SIMPLEF), POINTER :: p
    !***
    CALL C_F_POINTER(handle, p)
    ! Allocate p%B to appropriate size.
    !
    ! Assuming here the pointer association status of p%B is always 
    ! defined or dissociated, never undefined.  This is much easier 
    ! with allocatable components.
    IF (ASSOCIATED(p%B)) THEN
      IF (SIZE(p%B) /= data_size) THEN
        DEALLOCATE(p%B)
        ALLOCATE(p%B(data_size))
      END IF
    ELSE
      ALLOCATE(p%B(data_size))
    END IF
    p%B = data
  END SUBROUTINE SetB

  SUBROUTINE QueryBSize(handle, data_size) BIND(C, NAME='QueryBSize')
    USE, INTRINSIC :: ISO_C_BINDING, ONLY:  &
        C_PTR, C_F_POINTER, C_INT
    TYPE(C_PTR), INTENT(IN), VALUE :: handle
    INTEGER(C_INT), INTENT(OUT) :: data_size
    TYPE(SIMPLEF), POINTER :: p
    !***
    CALL C_F_POINTER(handle, p)
    ! See comments about assumed association status above.
    IF (ASSOCIATED(p%B)) THEN
      data_size = SIZE(p%B, KIND=C_INT)
    ELSE
      data_size = 0_C_INT
    END IF
  END SUBROUTINE QueryBSize

  SUBROUTINE QueryBData(handle, data) BIND(C, NAME='QueryBData')
    USE, INTRINSIC :: ISO_C_BINDING, ONLY:  &
        C_PTR, C_F_POINTER, C_INT
    TYPE(C_PTR), INTENT(IN), VALUE :: handle
    INTEGER(C_INT), INTENT(OUT) :: data(*)
    TYPE(SIMPLEF), POINTER :: p
    !***
    CALL C_F_POINTER(handle, p)
    ! See comments about assumed association status above.
    IF (ASSOCIATED(p%B)) THEN
      data(:SIZE(p%B)) = p%B
    ELSE
      ! Someone is being silly.
    END IF
  END SUBROUTINE QueryBData

  ! ...etc...
END MODULE simple

//~~~~~~
#include <vector>
#include <iostream>

extern "C" void* GetHandle();
extern "C" void ReleaseHandle(void* handle);
extern "C" void SetA(void* handle, int a);
extern "C" int QueryA(void* handle);
extern "C" void SetB(void* handle, const int* data, int data_size);
extern "C" void QueryBSize(void* handle, int* data_size);
extern "C" void QueryBData(void *handle, int *data);

class SimpleF
{
private:
  void *handle;
public:
  SimpleF() 
  { 
    handle = GetHandle(); 
  }

  ~SimpleF() 
  { 
    ReleaseHandle(handle); 
  }

  void SetA(int a) 
  { 
    ::SetA(handle, a); 
  }

  int QueryA()
  { 
    return ::QueryA(handle); 
  }

  void SetB(const std::vector<int>& b)
  {
     ::SetB(handle, &b[0], b.size());
  }

  std::vector<int> QueryB()
  {
    // Get the data size, construct a suitable buffer, populate the buffer.
    int data_size;
    ::QueryBSize(handle, &data_size);
    if (data_size == 0) return std::vector<int>();

    std::vector<int> data(data_size);
    ::QueryBData(handle, &data[0]);
    return data;
  }
};

int main()
{
  SimpleF x;
  x.SetA(99);
  std::cout << x.QueryA() << std::endl;

  std::vector<int> testvector(2,100);
  x.SetB(testvector);
  std::cout << x.QueryB()[0] << ' ' << x.QueryB()[1] << std::endl;

  return 0;
}

If your compiler supports the features added to the language with TS29113 "Further Interoperability of Fortran with C", then interoperable procedures can have pointer arguments, which may may simplify writing those accessors. It is intended that the features introduced with that TS will become part of the base language with the next standard revision.