Skip to content

Instantly share code, notes, and snippets.

@pelson
Last active February 27, 2019 11:58
Show Gist options
  • Save pelson/9473d2fe3c3c781d8ced50686b49ebf6 to your computer and use it in GitHub Desktop.
Save pelson/9473d2fe3c3c781d8ced50686b49ebf6 to your computer and use it in GitHub Desktop.
A quick proof-of-concept to wrap a C++ object in a Fortran 2003 object, and honouring the C++ object lifecycle
bin/
*.o
*.mod
.nfs*

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.

#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;
}
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
#!/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
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment