Skip to content

Instantly share code, notes, and snippets.

@Luthaf
Last active September 18, 2023 22:40
Show Gist options
  • Save Luthaf/4df78ca52b3caf7fbe0e to your computer and use it in GitHub Desktop.
Save Luthaf/4df78ca52b3caf7fbe0e to your computer and use it in GitHub Desktop.
Calling C++ from Fortran
#include "Foo.hpp"
#include <iostream>
using namespace std;
Foo::Foo(int _a, int _b): a(_a), b(_b){
cout << "C++ side, constructor" << endl;
}
Foo::~Foo(){
cout << "C++ side, destructor" << endl;
}
int Foo::bar(int c) const{
return a + c;
}
double Foo::baz(double d) const{
return d + b;
}
void foo_speaker(string s){
Foo f(4, 2);
cout << s << " Foo(4, 2).bar(3) is: " << f.bar(3) << endl;
}
#ifdef __cplusplus // Are we compiling this with a C++ compiler ?
extern "C" {
class Foo;
typedef Foo FOO;
#else
// From the C side, we use an opaque pointer.
typedef struct FOO FOO;
#endif
// Constructor
FOO* create_foo(int a, int b);
// Destructor
void delete_foo(FOO* foo);
// The const qualificators maps from the member function to pointers to the
// class instances.
int foo_bar(const FOO* foo, int c);
double foo_baz(const FOO* foo, double d);
void foo_speaker(const char* s);
#ifdef __cplusplus
}
#endif
#include <string>
class Foo {
public:
Foo(int a, int b);
~Foo();
int bar(int c) const;
double baz(double d) const;
private:
int a;
int b;
};
void foo_speaker(std::string s);
#include "foo.h"
#include "Foo.hpp"
#include <iostream>
using namespace std;
FOO* create_foo(int a, int b){
cout << "C API, create_foo" << endl;
return new Foo(a, b);
}
void delete_foo(FOO* foo){
cout << "C API, delete_foo" << endl;
delete foo;
}
int foo_bar(const FOO* foo, int c){
return foo->bar(c);
}
double foo_baz(const FOO* foo, double d){
return foo->baz(d);
}
void foo_speaker(const char* s) {
foo_speaker(string(s));
}
! C functions declaration
interface
function create_foo_c(a, b) bind(C, name="create_foo")
use iso_c_binding
implicit none
type(c_ptr) :: create_foo_c
integer(c_int), value :: a
integer(c_int), value :: b
end function
subroutine delete_foo_c(foo) bind(C, name="delete_foo")
use iso_c_binding
implicit none
type(c_ptr), value :: foo
end subroutine
function foo_bar_c(foo, c) bind(C, name="foo_bar")
use iso_c_binding
implicit none
integer(c_int) :: foo_bar_c
! The const qualification is translated into an intent(in)
type(c_ptr), intent(in), value :: foo
integer(c_int), value :: c
end function
function foo_baz_c(foo, c) bind(C, name="foo_baz")
use iso_c_binding
implicit none
real(c_double) :: foo_baz_c
type(c_ptr), intent(in), value :: foo
real(c_double), value :: c
end function
! void functions maps to subroutines
subroutine foo_speaker_c(str) bind(C, name="foo_speaker")
use iso_c_binding
implicit none
character(len=1, kind=C_CHAR), intent(in) :: str(*)
end subroutine
end interface
module libfoo
use iso_c_binding
private
public :: foo, foo_speaker
! Yes, include is a keyword in Fortran !
include "foo_cdef.f90"
! We'll use a Fortan type to represent a C++ class here, in an opaque maner
type foo
private
type(c_ptr) :: ptr ! pointer to the Foo class
contains
! We can bind some functions to this type, allowing for a cleaner syntax.
#ifdef __GNUC__
procedure :: delete => delete_foo_polymorph ! Destructor for gfortran
#else
final :: delete_foo ! Destructor
#endif
! Function member
procedure :: bar => foo_bar
procedure :: baz => foo_baz
end type
! This function will act as the constructor for foo type
interface foo
procedure create_foo
end interface
contains ! Implementation of the functions. We just wrap the C function here.
function create_foo(a, b)
implicit none
type(foo) :: create_foo
integer, intent(in) :: a, b
create_foo%ptr = create_foo_c(a, b)
end function
subroutine delete_foo(this)
implicit none
type(foo) :: this
call delete_foo_c(this%ptr)
end subroutine
! Bounds procedure needs to take a polymorphic (class) argument
subroutine delete_foo_polymorph(this)
implicit none
class(foo) :: this
call delete_foo_c(this%ptr)
end subroutine
integer function foo_bar(this, c)
implicit none
class(foo), intent(in) :: this
integer, intent(in) :: c
foo_bar = foo_bar_c(this%ptr, c)
end function
double precision function foo_baz(this, c)
implicit none
class(foo), intent(in) :: this
double precision, intent(in) :: c
foo_baz = foo_baz_c(this%ptr, c)
end function
subroutine foo_speaker(str)
implicit none
character(len=*), intent(in) :: str
character(len=1, kind=C_CHAR) :: c_str(len_trim(str) + 1)
integer :: N, i
! Converting Fortran string to C string
N = len_trim(str)
do i = 1, N
c_str(i) = str(i:i)
end do
c_str(N + 1) = C_NULL_CHAR
call foo_speaker_c(c_str)
end subroutine
end module
FC = gfortran
CXX = g++
UNAME := $(shell uname -s)
FCFLAGS = -Wall -Wextra
CCFLAGS = -Wall -Wextra
ifeq ($(UNAME_S),Darwin)
LDFLAGS = -lstdc++
else
LDFLAGS = -lc++
endif
all: test.x
test.o : foo_mod.o
%.x : %.o foo_mod.o foo_capi.o Foo.o
${FC} $^ -o $@ ${LDFLAGS}
%.o : %.f90
${FC} ${FCFLAGS} -c $< -o $@
%.o : %.cpp
${CXX} ${CCFLAGS} -c $^ -o $@
.PHONY : clean
clean :
${RM} -rf *.o *.mod test.x
program test
use libfoo
implicit none
type(foo) :: f
! Create an object of type foo
f = foo(3, 4)
! Call bound procedures (member functions)
write(*,*) f%bar(60), " should be ", 63
write(*,*) f%baz(10d0), " should be ", 14.0d0
call foo_speaker("From Fortran!")
! The destructor should be called automatically here, but this is not yet
! implemented in gfortran. So let's do it manually.
#ifdef __GNUC__
call f%delete
#endif
end program
@MartinBeseda
Copy link

Thank you very much! It's really cool to see such an instructive piece of code for Fortran/C++ binding. It would be very interesting, if you could show us the way, how to implement binding for two classes (possibly one of them abstract), where one of them inherits from the other one, what do you think?

@Luthaf
Copy link
Author

Luthaf commented Dec 2, 2019

@MartinBeseda I am sorry I don't know how to do this.

Fortran has its own concept of inheritance with extends, which you may be able to use here:

class Parent {
     virtual void foo() = 0;
}

class Child {
     void foo() override {}
     void non_virtual() {}
}
type :: Parent
    type(c_ptr), private :: parent_handle
contains
    procedure :: foo
end type

type, extends(Parent) :: Child
    type(c_ptr), private :: child_handle
contains
    procedure :: non_virtual
end

Then, if you take care of assigning the right pointers to parent_handle and child_handle, this should work. You will also need to take care to only free the pointers once, either through parent_handle or child_handle

@lke417
Copy link

lke417 commented Jun 28, 2023

Very useful, thanks!

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment