add c++ Fortran polymorph example

Author: scivision

CMakeLists.txt

@@ -1,4 +1,4 @@
-cmake_minimum_required(VERSION 3.14...3.21)
+cmake_minimum_required(VERSION 3.14...3.23)
 
 project(Fortran_C_CXX_interface
 LANGUAGES C CXX Fortran

src/cxx/CMakeLists.txt

@@ -6,6 +6,10 @@ target_include_directories(struct_cxx PRIVATE ${CMAKE_CURRENT_SOURCE_DIR}/../c)
 add_library(error_cxx OBJECT error_lib.cxx)
 
 # -- C++ calling Fortran
+add_executable(cpp_poly_fcn poly_fcn_main.cpp)
+target_link_libraries(cpp_poly_fcn PRIVATE poly_fcn_fortran)
+add_test(NAME C++_Fortran_poly_fcn COMMAND cpp_poly_fcn)
+
 add_executable(cxx_fortran_bool bool_main.cxx)
 target_link_libraries(cxx_fortran_bool PRIVATE bool_fortran)
 add_test(NAME C++_Fortran_bool COMMAND cxx_fortran_bool)

src/cxx/poly_fcn_main.cpp

@@ -0,0 +1,50 @@
+// C++ calling polymorphic Fortran object
+// based on https://github.com/mattzett/fortran_tests
+#include <array>
+#include <iostream>
+
+extern "C" void objconstruct_C(int*, void**, float**, const size_t*, const size_t*);
+extern "C" void objuse_C(int*, void*);
+
+int main() {
+
+ // pointers for various fortran data
+void* objptr1;
+void* objptr2;
+int objtype;
+float* arrptr;
+
+const size_t lx1=2;
+const size_t ly1=2;
+
+// Object 1`
+objtype=1;
+std::array<float, lx1*ly1> x1;
+x1 = {1, 2, 3, 4};
+arrptr = &x1.front();
+objconstruct_C(&objtype, &objptr1, &arrptr, &lx1, &ly1);
+std::cout << "Use object 1" << std::endl;
+objuse_C(&objtype, &objptr1);
+
+// Object 2
+objtype=2;
+const size_t lx2=2;
+const size_t ly2=3;
+std::array<float, lx2*ly2> x2;
+x2 = {6,5,4,3,2,1};
+arrptr = &x2.front();
+objconstruct_C(&objtype, &objptr2, &arrptr, &lx2, &ly2);
+std::cout << "Use object 2" << std::endl;
+objuse_C(&objtype,&objptr2);
+
+// show that objects persist
+std::cout << "Use object 1 again" << std::endl;
+objtype=1;
+objuse_C(&objtype, &objptr1);
+
+std::cout << "Use object 2 again" << std::endl;
+objtype=2;
+objuse_C(&objtype, &objptr2);
+
+return EXIT_SUCCESS;
+}

src/fortran/CMakeLists.txt

@@ -6,6 +6,8 @@ add_library(error_fortran OBJECT error_lib.f90)
 
 add_library(pointer_fortran OBJECT pointer_lib.f90)
 
+add_library(poly_fcn_fortran OBJECT poly_data_lib.f90 poly_fcn_lib.f90)
+
 add_library(struct_fortran OBJECT struct_lib.f90)
 
 add_library(submodule_fortran OBJECT module.f90 submodule.f90)

src/fortran/poly_data_lib.f90

@@ -0,0 +1,81 @@
+module datamod_poly
+!! from https://github.com/mattzett/fortran_tests
+
+use, intrinsic :: iso_c_binding, only : c_float, c_int
+
+implicit none (type, external)
+
+type, abstract :: dataobj_poly
+!! derived type definition containing data and procedures
+real(c_float), dimension(:,:), pointer :: dataval
+integer(c_int) :: lx,ly
+
+contains
+  procedure :: set_data
+  procedure :: print_data
+!    final :: destructor
+end type dataobj_poly
+
+type, extends(dataobj_poly) :: data1
+integer :: datstat
+contains
+  procedure :: print_data=>print_data1
+end type data1
+
+type, extends(dataobj_poly) :: data2
+real(c_float) :: datmag
+contains
+  procedure :: print_data=>print_data2
+end type data2
+
+contains
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!! type-bound procedures
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+subroutine set_data(self,array)
+  class(dataobj_poly), intent(inout) :: self
+  real(c_float), dimension(:,:), intent(in) :: array
+
+  self%lx=size(array,1)
+  self%ly=size(array,2)
+  allocate(self%dataval(self%lx,self%ly))
+  self%dataval(:,:)=array(:,:)
+end subroutine set_data
+
+
+subroutine print_data(self)
+!! the default print is as a row vector
+  class(dataobj_poly), intent(inout) :: self
+
+  print*, 'Stored data:  '
+  print*, self%dataval(:,:)
+end subroutine print_data
+
+
+subroutine print_data1(self)
+!! objects of type1 will print out as a matrix on the console
+  class(data1), intent(inout) :: self
+  integer :: ix
+
+  print*, 'Stored data:  '
+  do ix=1,self%lx
+    print '(100F4.1)', self%dataval(ix,:)
+  end do
+end subroutine print_data1
+
+
+subroutine print_data2(self)
+!! objects of type2 will print out as a column vector on the console
+  class(data2), intent(inout) :: self
+  integer :: ix,iy
+
+  print*, 'Stored data:  '
+  do ix=1,self%lx
+    do iy=1,self%ly
+      print '(f4.1)', self%dataval(ix,iy)
+    end do
+  end do
+end subroutine print_data2
+
+end module datamod_poly

src/fortran/poly_fcn_lib.f90

@@ -0,0 +1,83 @@
+module c_interface_poly
+!! top-level procedures that C will call to manipulate a Fortran object
+!! from https://github.com/mattzett/fortran_tests
+
+  use datamod_poly, only: dataobj_poly,data1,data2
+  use, intrinsic :: iso_c_binding, only: c_loc,c_ptr,c_f_pointer,c_int, c_float, c_size_t
+  implicit none (type, external)
+
+contains
+
+subroutine objconstruct_C(objtype,cptr_f90obj,cptr_indata,lx,ly) bind(C, name='objconstruct_C')
+!! return a c pointer to a fortran polymorphic object that is created by this routine; in this case we
+!! are passing the object type to be created from the C main program
+  integer(c_int), intent(in) :: objtype
+  type(c_ptr), intent(inout) :: cptr_f90obj
+  type(c_ptr), intent(in) :: cptr_indata
+  integer(c_size_t), intent(in) :: lx,ly
+  class(dataobj_poly), pointer :: obj
+  type(data1), pointer :: tmpobj1    !< declared as pointers so they don't auto-allocate when we return
+  type(data2), pointer :: tmpobj2    !< ditto
+  real(c_float), dimension(:,:), pointer :: fortdata
+
+  !> nullify for sake of clarity and good practice
+  nullify(tmpobj1, tmpobj2)
+
+  !> allocate derived type, note that c_loc only works on a static type (i.e. not polymorphic class), hence the tmpobj's
+  select case (objtype)
+    case (1)
+      allocate(data1::obj)
+      allocate(tmpobj1)
+      cptr_f90obj=c_loc(tmpobj1)
+      obj=>tmpobj1
+    case (2)
+      allocate(data2::obj)
+      allocate(tmpobj2)
+      cptr_f90obj=c_loc(tmpobj2)
+      obj=>tmpobj2
+    case default
+      error stop 'unable to identify object type during construction'
+  end select
+
+  !> initialize some test data, and call methods to print
+  print*, 'Initializing test data...'
+  call c_f_pointer(cptr_indata,fortdata,shape=[lx,ly])
+  call obj%set_data(fortdata)
+
+  !! note lack of deallocate and nullify here; we need memory allocated to persist past the return.
+end subroutine objconstruct_C
+
+
+!> Use some of the polymorphic object methods and data
+subroutine objuse_C(objtype,objC) bind(C, name='objuse_C')
+  type(c_ptr), intent(in) :: objC
+  integer(c_int), intent(in) :: objtype
+  class(dataobj_poly),pointer :: obj
+
+  obj=>set_pointer_dyntype(objtype,objC)
+  call obj%print_data()
+end subroutine objuse_C
+
+
+!> set fortran object pointer dynamic type to what is indicated in objtype.  Convert C pointer using
+!    declared static types (c_f_pointer will not work on a polymorphic object).
+function set_pointer_dyntype(objtype, objC) result(obj)
+  type(c_ptr), intent(in) :: objC
+  integer(c_int), intent(in) :: objtype
+  class(dataobj_poly), pointer :: obj
+  type(data1), pointer :: obj1
+  type(data2), pointer :: obj2
+
+  select case (objtype)
+    case (1)
+      call c_f_pointer(objC,obj1)
+      obj=>obj1
+    case (2)
+      call c_f_pointer(objC,obj2)
+      obj=>obj2
+    case default
+      error stop 'unable to identify object type during conversion from C to fortran class pointer'
+  end select
+end function set_pointer_dyntype
+
+end module c_interface_poly