A quick proof-of-concept to wrap a C++ object in a Fortran 2003 object, and honouring the C++ object lifecycle

.gitignore

bin/
*.o
*.mod

.nfs*

README.md

Given Fortran 2003 code to do something like:

In[1]:

   use IntStack_mod, only : IntStack

   type(IntStack) :: stack

   stack = IntStack(10)
   call stack % display()
   
Out[1]:

    IntStack::Display
    (empty)

And subsequently:

In[2]:
   call stack % push(2)
   call stack % push(15)
   call stack % display()

Out[2]:

    IntStack::Display
    2, 15 

Can IntStack be implemented and managed within C++, with simple wrappers being exposed in Fortran?

Answer: YES

---

The code here is a demonstration of that.

main.cpp

#include <iostream>

class IntStack
{
public:
   IntStack(int num) {  top = 0; maxelem = num; s = new int[maxelem]; }
   ~IntStack() { if (s != nullptr) delete[] s; }
   void  push(int t)
   {
      if (top == maxelem) return;
      s[top++] = t;
   }
   int pop()
   {
      if (top == 0) return -1;
      return s[--top];
   }
   void display()
   {
     std::cout << "IntStack::Display\n";
     if (top == 0) { std::cout << "(empty)\n";  return; }
     for (int t=0 ; t < top ; t++) std::cout << s[t] << " ";
     std::cout << "\n";
   }
   int   empty()  {  return top == 0;  }
private:
   int *s;
   int top;
   int maxelem;
};



typedef void * OpaqueObject;

// Function prototypes
extern "C" {
   OpaqueObject GetObject(int);
   void IntStackPush(OpaqueObject, int);
   void IntStackDisplay(OpaqueObject);
   void DeleteObject(OpaqueObject);
}

OpaqueObject GetObject(int s_size) {

   IntStack *s = new IntStack(s_size);

   return (OpaqueObject)s;

}

void IntStackPush(OpaqueObject obj, int i) {

   IntStack *s = (IntStack *)obj;

   s->push(i);

   return;

}

void DeleteObject(OpaqueObject obj) {

   IntStack *s = (IntStack *)obj;

   delete(s);

   return;
}

void IntStackDisplay(OpaqueObject obj) {

   IntStack *s = (IntStack *)obj;

   s->display();

   return;
}

main.f90

module IntStack_wrappers_mod

   use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated

   implicit none

   private

   interface

      function GetObject( s_size ) result( optr )bind(C, name="GetObject")
         import :: c_int, c_ptr

         implicit none

         ! Argument list
         integer(c_int), intent(in), value :: s_size
         ! Function result
         type(c_ptr) :: optr
      end function GetObject

      subroutine IntStackPush( optr, i ) bind(C, name="IntStackPush")
         import :: c_int, c_ptr

         implicit none

         ! Argument list
         type(c_ptr), intent(in), value :: optr
         integer(c_int), intent(in), value :: i
      end subroutine IntStackPush

      subroutine IntStackDisplay( optr ) bind(C, name="IntStackDisplay")
         import :: c_ptr

         implicit none

         ! Argument list
         type(c_ptr), intent(in), value :: optr
      end subroutine IntStackDisplay

      subroutine DeleteObject( optr ) bind(C, name="DeleteObject")
         import :: c_ptr

         implicit none

         ! Argument list
         type(c_ptr), intent(in), value :: optr
      end subroutine DeleteObject

   end interface

   public :: DeleteObject
   public :: IntStackPush
   public :: IntStackDisplay
   public :: GetObject

end module IntStack_wrappers_mod


module IntStack_mod

   use, intrinsic :: iso_c_binding, only : c_int, c_ptr, c_null_ptr, c_associated
   ! The C functions
   use IntStack_wrappers_mod, only : IntStackPush, IntStackDisplay, GetObject, DeleteObject
   implicit none

   public IntStack

   private
    type IntStack
        type(c_ptr) :: optr

    contains
        final :: IntStack_destructor
        procedure, public :: display => stack_display
        procedure, public :: push => stack_push
    end type IntStack

   interface IntStack
      module procedure IntStack_constructor
   end interface IntStack

   contains

   function IntStack_constructor(prob_size) result(this)
       type(IntStack) :: this
       integer(c_int), intent(in) :: prob_size
       this%optr = GetObject( s_size=prob_size )
   end function IntStack_constructor

   subroutine IntStack_destructor(this)
      type(IntStack) :: this
      print*, "Destroying IntStack"
      call DeleteObject(this%optr)
      this%optr = c_null_ptr
   end subroutine

   subroutine stack_display(this)
        class(IntStack), intent(inout) :: this
        call IntStackDisplay(this%optr)
   end subroutine stack_display

   subroutine stack_push(this, t)
        class(IntStack), intent(inout) :: this
        integer(c_int), intent(in) :: t
        call IntStackPush(this%optr, i=t)
   end subroutine stack_push
end module IntStack_mod


subroutine short_lifetime
    use IntStack_mod, only : IntStack

    type(IntStack) :: stack

    stack = IntStack(20)
end subroutine



program p
   use IntStack_mod, only : IntStack

   type(IntStack) :: stack

   stack = IntStack(10)
   call stack % display()

   call stack % push(2)
   call stack % push(15)
   call stack % display()

   ! For a short-lifetime object, we should see the destructor get called.
   call short_lifetime()

end program p

run

#!/usr/bin/env bash

set -e

$CXX -c main.cpp -o mainCXX.o
$FC -c main.f90 -o mainF.o

mkdir -p bin
$CC -o bin/main mainF.o mainCXX.o -lgfortran -lstdc++

./bin/main