Add director support for bools

Author: sethrj

Examples/test-suite/common.mk

@@ -208,6 +208,7 @@ CPP_TEST_CASES += \
 	director_protected_overloaded \
 	director_redefined \
 	director_ref \
+	director_simple \
 	director_smartptr \
 	director_thread \
 	director_unroll \

Examples/test-suite/director_int.i

@@ -0,0 +1,42 @@
+%module(directors="1") director_simple
+
+%feature("director") IntBase;
+%feature("director") BoolBase;
+
+%inline %{
+class IntBase {
+ public:
+  virtual ~IntBase() {}
+  IntBase(int i = 3) { (void)i; }
+  virtual int apply(int x) const { return x * 2; }
+};
+
+class IntDerived : public IntBase {
+ public:
+  virtual int apply(int x) const { return x * 3; }
+};
+
+int apply(const IntBase& b, int x)
+{
+  return b.apply(x);
+}
+
+class BoolBase {
+ public:
+  virtual ~BoolBase() {}
+  BoolBase() {}
+  virtual bool apply(bool a, bool b) const = 0;
+};
+
+class BoolDerived : public BoolBase {
+ public:
+  virtual bool apply(bool a, bool b) const { return a != b; }
+};
+
+bool apply(const BoolBase& base, bool a, bool b)
+{
+  return base.apply(a, b);
+}
+
+%}
+

Examples/test-suite/director_simple.i

@@ -0,0 +1,116 @@
+! File : director_simple_runme.F90
+
+#include "fassert.h"
+
+module director_simple_mod
+  use, intrinsic :: ISO_C_BINDING
+  use ISO_FORTRAN_ENV
+  use director_simple, only : IntBase, BoolBase
+  implicit none
+
+ type, extends(IntBase), public :: MyIntDerived
+   integer(C_INT) :: multiply_by = 1
+   integer(C_INT) :: add_to = 0
+ contains
+  procedure :: apply => MyIntDerived_apply
+ end type MyIntDerived
+  
+ type, extends(BoolBase), public :: MyBoolDerived
+   integer :: call_count = 0
+ contains
+  procedure :: apply => MyBoolDerived_apply
+ end type MyBoolDerived
+  
+contains
+
+function MyIntDerived_apply(self, x) &
+result(myresult)
+use, intrinsic :: ISO_C_BINDING
+class(MyIntDerived) :: self
+integer(C_INT), intent(in) :: x
+integer(C_INT) :: myresult
+
+myresult = x * self%multiply_by + self%add_to
+end function
+
+function MyBoolDerived_apply(self, a, b) &
+result(myresult)
+use, intrinsic :: ISO_C_BINDING
+class(MyBoolDerived) :: self
+logical, intent(in) :: a
+logical, intent(in) :: b
+logical :: myresult
+
+myresult = a .or. b
+self%call_count = self%call_count + 1
+end function
+
+end module
+
+program director_simple_runme
+  call test_director_int
+  call test_director_bool
+contains
+
+subroutine test_director_int
+  use director_simple
+  use director_simple_mod
+  use, intrinsic :: ISO_C_BINDING
+  type(MyIntDerived), target :: myclass
+  class(IntBase), pointer :: baseptr => NULL()
+  class(IntBase), allocatable :: alloc
+
+  ! Allocate and set up callbacks for IntBase class
+  call swig_initialize(myclass, source=IntBase())
+  myclass%multiply_by = 2
+  myclass%add_to = 1
+
+  ! Direct Fortran call
+  ASSERT(myclass%apply(10_c_int) == 21_c_int)
+  ! Call through C director
+  ASSERT(apply(myclass, 10_c_int) == 21_c_int)
+  ! Call through C via IntBase pointer
+  baseptr => myclass
+  ASSERT(apply(baseptr, 10_c_int) == 21_c_int)
+
+  myclass%multiply_by = 3
+  ASSERT(apply(baseptr, 10_c_int) == 31_c_int)
+
+  call myclass%release()
+
+  ! Allocate a C++ daughter class and call it as well
+  allocate(alloc, source=IntBase())
+  ASSERT(apply(alloc, 2_c_int) == 4_c_int)
+  call alloc%release()
+  deallocate(alloc)
+
+  allocate(alloc, source=IntDerived())
+  ASSERT(apply(alloc, 2_c_int) == 6_c_int)
+  call alloc%release()
+  deallocate(alloc)
+
+end subroutine
+
+subroutine test_director_bool
+  use director_simple
+  use director_simple_mod
+  use, intrinsic :: ISO_C_BINDING
+  type(MyBoolDerived), target :: myclass
+
+  ! Allocate and set up callbacks for BoolBase class
+  call swig_initialize(myclass, source=BoolBase())
+
+  ! Direct Fortran call
+  ASSERT(myclass%apply(.true., .false.))
+  ASSERT(.not. myclass%apply(.false., .false.))
+  ! Call through C director
+  ASSERT(apply(myclass, .true., .false.))
+  ASSERT(.not. apply(myclass, .false., .false.))
+  ASSERT(myclass%call_count == 4)
+
+  call myclass%release()
+
+end subroutine
+end program
+
+

Examples/test-suite/fortran/director_int_runme.F90

@@ -352,7 +352,7 @@ SWIGINTERN void SWIG_assign(SwigClassWrapper* self, SwigClassWrapper other) {
 // Raw pointers act mostly like value types, but they don't have to accept the exact type (polymorphic input, non-polymorphic output). Intent is 'in' because
 // we're not modifying the pointer or memory status.
 %apply SWIGTYPE { SWIGTYPE* };
-%typemap(ftype, in="class($fortranclassname), intent(in)", nofortransubroutine=1) SWIGTYPE*
+%typemap(ftype, in="class($fortranclassname)", nofortransubroutine=1) SWIGTYPE*
   "type($fortranclassname)"
 %typemap(in, noblock=1) SWIGTYPE* {
   $1 = ($1_ltype)$input->cptr;

Examples/test-suite/fortran/director_simple_runme.F90

@@ -100,6 +100,12 @@ SWIGINTERN SwigArrayWrapper SwigArrayWrapper_uninitialized() {
   %typemap(fout, fragment="SWIG_fout"{CPPTYPE}, noblock=1) MATCHTYPE {
   call %fortrantm(fout, CPPTYPE)($1, $result)
   }
+  %typemap(fdirectorin, fragment="SWIG_fout"{CPPTYPE}, noblock=1) MATCHTYPE {
+  call %fortrantm(fout, CPPTYPE)($input, $1)
+  }
+  %typemap(fdirectorout, fragment="SWIG_fin"{CPPTYPE}, noblock=1) MATCHTYPE {
+  call %fortrantm(fin, CPPTYPE)($1, $result)
+  }
 %enddef
 
 /*!
@@ -395,6 +401,11 @@ $input = &temp;%}
 // Define special fin/fout typemaps for logical<->c_int
 %fortran_typemap_finout(bool, bool)
 
+%typemap(directorin, noblock=1) bool (int temp)
+%{temp = $1 ? 1 : 0;
+$input = &temp;%}
+%typemap(directorout) bool "$result = (bool)$1;"
+
 // Treat const references like values
 %apply bool { const bool& };
 // ... except our 'in' typemap has to create a temporary