-
-
Save Luthaf/4df78ca52b3caf7fbe0e to your computer and use it in GitHub Desktop.
#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 |
Thanks for sharing this!
Many thanks! Very instructive!! Just a minor thing... in Makefile line 4 is UNAME_S := $(shell uname -s), but in line 8 you compare with UNAME and not UNAME_S
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?
@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
Very useful, thanks!
No idea why ... Can you try to run it in a debugger and print the value of the pointer as seen by fortran and C++ code ?