Skip to content

Commit 7a14f7d

Browse files
sethrjsethrj
committed
Implement basic SWIG directors
Expose handle class as member variable Complete initial implementation and example
1 parent 8dba6ae commit 7a14f7d

File tree

7 files changed

+1076
-82
lines changed

7 files changed

+1076
-82
lines changed

‎Examples/test-suite/director_int.i

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
%module(directors="1") director_int
2+
3+
%feature("director") Base;
4+
%ignore Base::apply_ignored;
5+
%ignore Base::ignored_pure;
6+
7+
%inline %{
8+
class Base {
9+
public:
10+
virtual ~Base() {}
11+
Base(int i = 3) { (void)i; }
12+
virtual int apply(int x) const { return x * 2; }
13+
};
14+
15+
class Derived : public Base {
16+
public:
17+
virtual int apply(int x) const { return x * 3; }
18+
};
19+
20+
int apply(const Base& b, int x)
21+
{
22+
return b.apply(x);
23+
}
24+
25+
%}
26+

‎Examples/test-suite/fortran/director_int_runme.F90

Lines changed: 76 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,76 @@
1+
! File : director_int_runme.F90
2+
3+
#include "fassert.h"
4+
5+
module director_int_mod
6+
use, intrinsic :: ISO_C_BINDING
7+
use ISO_FORTRAN_ENV
8+
use director_int, only : Base
9+
implicit none
10+
11+
type, extends(Base), public :: MyDerived
12+
integer(C_INT) :: multiply_by = 1
13+
integer(C_INT) :: add_to = 0
14+
contains
15+
procedure :: apply => MyDerived_apply
16+
end type MyDerived
17+
18+
contains
19+
20+
function MyDerived_apply(self, x) &
21+
result(myresult)
22+
use, intrinsic :: ISO_C_BINDING
23+
class(MyDerived), intent(in) :: self
24+
integer(C_INT), intent(in) :: x
25+
integer(C_INT) :: myresult
26+
27+
myresult = x * self%multiply_by + self%add_to
28+
end function
29+
30+
end module
31+
32+
program director_int_runme
33+
call test_director_int
34+
contains
35+
36+
subroutine test_director_int
37+
use director_int
38+
use director_int_mod
39+
use, intrinsic :: ISO_C_BINDING
40+
type(MyDerived), target :: myclass
41+
class(Base), pointer :: baseptr => NULL()
42+
class(Base), allocatable :: alloc
43+
44+
! Allocate and set up callbacks for base class
45+
call swig_initialize(myclass, source=Base())
46+
myclass%multiply_by = 2
47+
myclass%add_to = 1
48+
49+
! Direct Fortran call
50+
ASSERT(myclass%apply(10_c_int) == 21_c_int)
51+
! Call through C director
52+
ASSERT(apply(myclass, 10_c_int) == 21_c_int)
53+
! Call through C via base pointer
54+
baseptr => myclass
55+
ASSERT(apply(baseptr, 10_c_int) == 21_c_int)
56+
57+
myclass%multiply_by = 3
58+
ASSERT(apply(baseptr, 10_c_int) == 31_c_int)
59+
60+
call myclass%release()
61+
62+
! Allocate a C++ daughter class and call it as well
63+
allocate(alloc, source=Base())
64+
ASSERT(apply(alloc, 2_c_int) == 4_c_int)
65+
call alloc%release()
66+
deallocate(alloc)
67+
68+
allocate(alloc, source=Derived())
69+
ASSERT(apply(alloc, 2_c_int) == 6_c_int)
70+
call alloc%release()
71+
deallocate(alloc)
72+
73+
end subroutine
74+
end program
75+
76+

‎Lib/fortran/boost_shared_ptr.i

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -10,8 +10,8 @@
1010

1111
// Runtime check for a class wrapper not being const.
1212
%fragment("SWIG_check_sp_nonnull", "runtime", fragment="SwigMemState") %{
13-
#define SWIG_check_sp_nonnull(INPUT, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \
14-
if (!(INPUT)) { \
13+
#define SWIG_check_sp_nonnull(PTR, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \
14+
if (!(PTR)) { \
1515
SWIG_exception_impl(FUNCNAME, SWIG_NullReferenceError, \
1616
"Cannot pass null " TYPENAME " (class " FNAME ") " \
1717
"as a reference", RETURNNULL); \

‎Lib/fortran/classes.swg

Lines changed: 41 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -117,8 +117,8 @@ SWIGINTERN SwigClassWrapper SwigClassWrapper_uninitialized() {
117117

118118
// Runtime check for a class wrapper not being const.
119119
%fragment("SWIG_check_nonnull", "runtime") %{
120-
#define SWIG_check_nonnull(SWIG_CLASS_WRAPPER, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \
121-
if (!(SWIG_CLASS_WRAPPER).cptr) { \
120+
#define SWIG_check_nonnull(PTR, TYPENAME, FNAME, FUNCNAME, RETURNNULL) \
121+
if (!(PTR)) { \
122122
SWIG_exception_impl(FUNCNAME, SWIG_NullReferenceError, \
123123
"Cannot pass null " TYPENAME " (class " FNAME ") " \
124124
"as a reference", RETURNNULL); \
@@ -320,14 +320,14 @@ SWIGINTERN void SWIG_assign(SwigClassWrapper* self, SwigClassWrapper other) {
320320
%typemap(ctype, in="SwigClassWrapper *", null="SwigClassWrapper_uninitialized()", noblock=1, fragment="SwigClassWrapper")
321321
SWIGTYPE
322322
"SwigClassWrapper"
323-
%typemap(imtype, fragment="SwigClassWrapper_f")
323+
%typemap(imtype, in="type(SwigClassWrapper), intent(in)", fragment="SwigClassWrapper_f")
324324
SWIGTYPE
325325
"type(SwigClassWrapper)"
326326
%typemap(ftype, in="type($&fortranclassname), intent(in)", nofortransubroutine=1) SWIGTYPE
327327
"type($&fortranclassname)"
328328

329329
%typemap(in, noblock=1, fragment="SWIG_check_nonnull") SWIGTYPE {
330-
SWIG_check_nonnull(*$input, "$1_ltype", "$&fortranclassname", "$decl", return $null);
330+
SWIG_check_nonnull($input->cptr, "$1_ltype", "$&fortranclassname", "$decl", return $null);
331331
$1 = *(($&1_ltype)($input->cptr));
332332
}
333333

@@ -373,7 +373,7 @@ SWIGINTERN void SWIG_assign(SwigClassWrapper* self, SwigClassWrapper other) {
373373
// Check for non-null reference inputs
374374
%apply SWIGTYPE* { SWIGTYPE& };
375375
%typemap(in, noblock=1, fragment="SWIG_check_nonnull") SWIGTYPE& {
376-
SWIG_check_nonnull(*$input, "$1_type", "$fortranclassname", "$decl", return $null);
376+
SWIG_check_nonnull($input->cptr, "$1_type", "$fortranclassname", "$decl", return $null);
377377
$1 = ($1_ltype)$input->cptr;
378378
}
379379

@@ -397,7 +397,7 @@ SWIGINTERN void SWIG_assign(SwigClassWrapper* self, SwigClassWrapper other) {
397397

398398
// Check for non-null class input "self"
399399
%typemap(in, noblock=1, fragment="SWIG_check_nonnull") SWIGTYPE *self {
400-
SWIG_check_nonnull(*$input, "$1_type", "$*fortranclassname", "$decl", return $null);
400+
SWIG_check_nonnull($input->cptr, "$1_type", "$*fortranclassname", "$decl", return $null);
401401
$1 = ($1_ltype)$input->cptr;
402402
}
403403

@@ -421,3 +421,38 @@ SWIGINTERN void SWIG_assign(SwigClassWrapper* self, SwigClassWrapper other) {
421421
%apply SWIGTYPE *ASSIGNMENT_SELF { SWIGTYPE *DESTRUCTOR_SELF };
422422
%typemap(in) SWIGTYPE *DESTRUCTOR_SELF = SWIGTYPE *;
423423

424+
/*---------------------------------------------------------------------------
425+
* Special class typedefs for directors
426+
*/
427+
%typemap(ftype, in="type($fortranclassname), pointer") SWIGTYPE *swigfhandle
428+
"type($fortranclassname), pointer"
429+
%typemap(fin) SWIGTYPE *swigfhandle
430+
"$1 = c_loc($input)"
431+
%typemap(fout, noblock=1) SWIGTYPE *swigfhandle
432+
{if (c_associated($1)) then
433+
call c_f_pointer($1, $result)
434+
else
435+
$result => NULL()
436+
endif}
437+
438+
%typemap(imtype, in="type(C_PTR), intent(in), value") SWIGTYPE *swigfhandle
439+
"type(C_PTR)"
440+
%typemap(ctype, noblock=1) SWIGTYPE *swigfhandle
441+
"void *"
442+
%typemap(in, noblock=1) SWIGTYPE *swigfhandle
443+
"$1 = ($1_ltype)$input;"
444+
%typemap(out, noblock=1) SWIGTYPE *swigfhandle
445+
"$result = (void*)$1;"
446+
447+
// Convert from C++ to ctype
448+
%typemap(directorin) SWIGTYPE* (SwigClassWrapper temp)
449+
%{temp.cptr = (void*)$1;
450+
temp.cmemflags = 0;
451+
$input = &temp;%}
452+
453+
// Convert from im code to ftype
454+
%typemap(ftype) SWIGTYPE *DIRECTOR_SELF
455+
"class($fortranclassname), pointer"
456+
%typemap(fdirectorin, temp="type($fortranclassname)", noblock=1) SWIGTYPE *DIRECTOR_SELF {$1_temp%swigdata = $input
457+
$1 => swig_dyncast($1_temp)}
458+

‎Lib/fortran/director.swg

Lines changed: 43 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,43 @@
1+
/* -----------------------------------------------------------------------------
2+
* director.swg
3+
*
4+
* This file contains support for director classes so that Fortran proxy
5+
* methods can be called from C++.
6+
* ----------------------------------------------------------------------------- */
7+
8+
#include <string>
9+
#include <exception>
10+
11+
namespace Swig {
12+
/* Base class for director exceptions */
13+
class DirectorException : public std::exception {
14+
protected:
15+
std::string swig_msg;
16+
17+
public:
18+
explicit DirectorException(const char *msg) : swig_msg(msg) {
19+
}
20+
21+
explicit DirectorException(const std::string &msg) : swig_msg(msg) {
22+
}
23+
24+
virtual ~DirectorException() throw() {
25+
}
26+
27+
const char *what() const throw() {
28+
return swig_msg.c_str();
29+
}
30+
};
31+
32+
/* Pure virtual method exception */
33+
class DirectorPureVirtualException : public DirectorException {
34+
public:
35+
explicit DirectorPureVirtualException(const char *method_name) : DirectorException(std::string("Attempt to invoke pure virtual method ") + method_name) {
36+
}
37+
38+
static void raise(const char *method_name) {
39+
throw DirectorPureVirtualException(method_name);
40+
}
41+
};
42+
}
43+

‎Lib/fortran/fundamental.swg

Lines changed: 19 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -159,6 +159,11 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() {
159159
%typemap(fin) CTYPE = FORTRAN_INTRINSIC_TYPE;
160160
%typemap(fout) CTYPE = FORTRAN_INTRINSIC_TYPE;
161161

162+
%typemap(directorin) CTYPE = FORTRAN_INTRINSIC_TYPE;
163+
%typemap(directorout) CTYPE = FORTRAN_INTRINSIC_TYPE;
164+
%typemap(fdirectorin) CTYPE = FORTRAN_INTRINSIC_TYPE;
165+
%typemap(fdirectorout) CTYPE = FORTRAN_INTRINSIC_TYPE;
166+
162167
%typemap(bindc) CTYPE* = FORTRAN_INTRINSIC_TYPE*;
163168

164169
// Fragment for converting array to array wrapper. This needs the intermediate step of assigning the first element to an array pointer to be compatible with
@@ -232,7 +237,7 @@ end subroutine}
232237
* boolean/logical type) has a different fundamental representation even though
233238
* both C_BOOL and bool have the same size. Some structs of primitive types
234239
* (see the %fortran_struct feature) can also be made interoperable.
235-
*
240+
in
236241
* - Arguments in Fortran are passed by pointer reference, and return
237242
* types are passed by value.
238243
* - Returning by const reference is automatically turned into return-by-value
@@ -249,16 +254,17 @@ end subroutine}
249254
*/
250255

251256
// Fundamental types
252-
%typemap(in, noblock=1) FORTRAN_INTRINSIC_TYPE {
253-
$1 = ($1_ltype)(*$input);
254-
}
255-
%typemap(out, noblock=1) FORTRAN_INTRINSIC_TYPE {
256-
$result = ($1_ltype)($1);
257-
}
258-
%typemap(fin) FORTRAN_INTRINSIC_TYPE
259-
"$1 = $input"
260-
%typemap(fout) FORTRAN_INTRINSIC_TYPE
261-
"$result = $1"
257+
%typemap(in) FORTRAN_INTRINSIC_TYPE "$1 = ($1_ltype)(*$input);"
258+
%typemap(out) FORTRAN_INTRINSIC_TYPE "$result = ($1_ltype)($1);"
259+
%typemap(fin) FORTRAN_INTRINSIC_TYPE "$1 = $input"
260+
%typemap(fout) FORTRAN_INTRINSIC_TYPE "$result = $1"
261+
262+
%typemap(directorin, noblock=1) FORTRAN_INTRINSIC_TYPE ($1_ltype temp)
263+
%{temp = $1;
264+
$input = &temp;%}
265+
%typemap(directorout) FORTRAN_INTRINSIC_TYPE "$result = $1;"
266+
%typemap(fdirectorin) FORTRAN_INTRINSIC_TYPE "$1 = $input"
267+
%typemap(fdirectorout) FORTRAN_INTRINSIC_TYPE "$result = $1"
262268

263269
// Pointers can be directly bound
264270
%typemap(bindc, in="$typemap(imtype, $*1_ltype)") FORTRAN_INTRINSIC_TYPE*
@@ -300,7 +306,7 @@ end subroutine}
300306
%typemap(out) const FORTRAN_INTRINSIC_TYPE&
301307
"$result = *$1;"
302308

303-
// Treat rvalue references as const refrerences
309+
// Treat rvalue references as const refererences (i.e. copy the result)
304310
%apply const FORTRAN_INTRINSIC_TYPE& { FORTRAN_INTRINSIC_TYPE&& };
305311

306312
/* -------------------------------------------------------------------------
@@ -334,6 +340,7 @@ end subroutine}
334340
%typemap(ftype) void ""
335341
%typemap(fin) void ""
336342
%typemap(fout) void ""
343+
%typemap(directorin) void ""
337344
%typemap(bindc) void ""
338345

339346
/* -------------------------------------------------------------------------

0 commit comments

Comments
 (0)