Merge pull request #141 from swig-fortran/abstract-interfaces

Automated generation of *abstract* bind(C) interface

Author: sethrj

Doc/Manual/src/Fortran.md

@@ -1857,6 +1857,7 @@ Fortran standard's specification and naming of the components of a module.
 <tr><td><code>fbegin     </code></td><td>Code before the `module` statement </td></tr>
 <tr><td><code>fuse       </code></td><td>"use" statements                   </td></tr>
 <tr><td><code>fdecl      </code></td><td>Module declarations                </td></tr>
+<tr><td><code>fabstract</code></td><td>Abstract interfaces for callbacks</td></tr>
 <tr><td><code>finterfaces</code></td><td>Procedure interfaces for C code    </td></tr>
 <tr><td><code>fsubprograms</code></td><td>Fortran module subprograms        </td></tr>
 </tbody>

Examples/fortran/funcptr/example.c

@@ -1,19 +1,19 @@
 /* File : example.c */
 
-int do_op(int a, int b, int (*op)(int,int)) {
-  return (*op)(a,b);
+int do_op(int a, int b, int (*op)(int, int)) {
+  return (*op)(a, b);
 }
 
 int add(int a, int b) {
-  return a+b;
+  return a + b;
 }
 
 int sub(int a, int b) {
-  return a-b;
+  return a - b;
 }
 
 int mul(int a, int b) {
-  return a*b;
+  return a * b;
 }
 
-int (*funcvar)(int,int) = add;
+int (*funcvar)(int, int) = add;

Examples/fortran/funcptr/example.h

@@ -1,9 +1,11 @@
 /* file: example.h */
 
-extern int do_op(int,int, int (*op)(int,int));
-extern int add(int,int);
-extern int sub(int,int);
-extern int mul(int,int);
+typedef int (*binary_func)(int, int);
 
-extern int (*funcvar)(int,int);
+extern int do_op(int, int, binary_func);
+extern int add(int, int);
+extern int sub(int, int);
+extern int mul(int, int);
+
+extern int (*funcvar)(int, int);
 

Examples/fortran/funcptr/example.i

@@ -4,8 +4,14 @@
 #include "example.h"
 %}
 
+%fortrancallback("%s") binary_op;
+int binary_op(int a, int b);
+
+/* Function pointer: f(int, int) ->  int */
+typedef int (*binary_func)(int, int);
+
 /* Wrap a function taking a pointer to a function */
-extern int  do_op(int a, int b, int (*op)(int, int));
+extern int do_op(int a, int b, binary_func op);
 
 /* Now install a bunch of "ops" as constants */
 %constant int (*ADD)(int,int) = add;

Examples/fortran/funcptr/runme.f90

@@ -4,16 +4,6 @@ module fortran_ops
   implicit none
   public
 
-  abstract interface
-    ! Interface corresponding to the C typedef "BinaryOp"
-    function binary_op(aa, bb) bind(C)  result(cc)
-      use, intrinsic :: ISO_C_BINDING
-      integer(C_INT), intent(in), value :: aa
-      integer(C_INT), intent(in), value :: bb
-      integer(C_INT) :: cc
-    end function
-  end interface
-  
 contains
   ! Fortran function that we can export so that
   ! it's available to C code
@@ -39,19 +29,16 @@ program fortran_funptr_runme
   integer, parameter :: STDOUT = OUTPUT_UNIT
   integer(C_INT) :: a = 4
   integer(C_INT) :: b = 3
-  type(C_FUNPTR) :: temp_funptr
-  procedure(binary_op), pointer :: my_ffunc => null()
+  procedure(binary_op), pointer :: fptr => null()
 
-  write(STDOUT,*) "SWIG-wrapped C function pointer:", do_op(a,b,add)
-  write(STDOUT,*) "SWIG-wrapped C function pointer:", do_op(a,b,sub)
-  write(STDOUT,*) "SWIG-wrapped C function pointer:", do_op(a,b,mul)
+  call c_f_procpointer(add, fptr)
+  write(STDOUT,*) "SWIG-wrapped C function pointer:", do_op(a, b, fptr)
+  call c_f_procpointer(sub, fptr)                                 
+  write(STDOUT,*) "SWIG-wrapped C function pointer:", do_op(a, b, fptr)
+  call c_f_procpointer(mul, fptr)                                 
+  write(STDOUT,*) "SWIG-wrapped C function pointer:", do_op(a, b, fptr)
 
   ! Convert Fortran function to C function pointer
-  temp_funptr = c_funloc(fortran_mul)
-  write(STDOUT,*) "C call to Fortran function:", do_op(a,b,temp_funptr)
-
-  ! Convert C function pointer to a Fortran function pointer
-  call c_f_procpointer(add, my_ffunc)
-  write(STDOUT,*) "Fortran direct call to C function:", my_ffunc(a,b)
+  write(STDOUT,*) "C call to Fortran function:", do_op(a, b, fortran_mul)
 
 end program

Examples/test-suite/fortran/Makefile.in

@@ -22,6 +22,7 @@ top_builddir = @top_builddir@
 
 CPP_TEST_CASES = \
 	fortran_bindc \
+	fortran_callback \
 	fortran_naming \
 	fortran_onlywrapped \
 	fortran_openacc \
@@ -31,6 +32,7 @@ CPP_TEST_CASES = \
 C_TEST_CASES = \
 	fortran_array_typemap \
 	fortran_bindc_c \
+	fortran_callback_c \
 	fortran_global_const \
 
 FAILING_CPP_TESTS += \

Examples/test-suite/fortran/fortran_callback_runme.F90

@@ -0,0 +1,75 @@
+! File : fortran_callback_runme.F90
+
+#include "fassert.h"
+
+module fortran_callback_mod
+  use, intrinsic :: ISO_C_BINDING
+  use ISO_FORTRAN_ENV
+  implicit none
+  integer, parameter :: STDOUT = OUTPUT_UNIT
+  integer(C_INT), save, public :: module_int
+contains
+
+function myexp(left, right) bind(C) &
+    result(fresult)
+  use, intrinsic :: ISO_C_BINDING
+  integer(C_INT), intent(in), value :: left
+  integer(C_INT), intent(in), value :: right
+  integer(C_INT) :: fresult
+
+  fresult = left ** right
+end function
+  
+function mywrite() bind(C) &
+    result(fresult)
+  use, intrinsic :: ISO_C_BINDING
+  integer(C_INT) :: fresult
+  ! write(STDOUT,*) "Hi there"
+  fresult = 256_c_int
+end function
+
+subroutine store_an_int(i) bind(C)
+  use, intrinsic :: ISO_C_BINDING
+  integer(C_INT), value, intent(in) :: i
+  ! write(STDOUT,*) "Got an integer: ", i
+  module_int = i
+end subroutine
+  
+end module
+
+program fortran_callback_runme
+  call test_callback
+contains
+
+subroutine test_callback
+  use fortran_callback
+  use fortran_callback_mod
+  integer(C_INT) :: i
+  procedure(call_binary_cb), pointer :: unused => NULL()
+  procedure(binary_op), pointer :: bin_op_ptr => NULL()
+
+  ! Use callbacks with Fortran module pointers
+  bin_op_ptr => myexp
+  i = call_binary(myexp, 2, 3)
+  ASSERT(i == 8)
+  i = call_things(mywrite)
+  ASSERT(i == 256)
+  call also_call_things(store_an_int, 999)
+  ASSERT(module_int == 999)
+
+  ! Get a C callback
+  bin_op_ptr => get_a_callback("mul")
+  ASSERT(associated(bin_op_ptr))
+  ASSERT(bin_op_ptr(2, 5) == 10)
+
+  bin_op_ptr => get_a_callback("add")
+  ASSERT(associated(bin_op_ptr))
+  ASSERT(bin_op_ptr(2, 5) == 7)
+
+  bin_op_ptr => get_a_callback("nopenope")
+  ASSERT(.not. associated(bin_op_ptr))
+
+end subroutine
+end program
+
+

Examples/test-suite/fortran/funcptr_runme.F90

@@ -2,20 +2,39 @@
 
 #include "fassert.h"
 
+module funcptr_mod
+  use, intrinsic :: ISO_C_BINDING
+  implicit none
+contains
+
+function myexp(left, right) bind(C) &
+    result(fresult)
+  use, intrinsic :: ISO_C_BINDING
+  integer(C_INT), intent(in), value :: left
+  integer(C_INT), intent(in), value :: right
+  integer(C_INT) :: fresult
+
+  fresult = left ** right
+end function
+  
+end module
+
 program funcptr_runme
   use funcptr
+  use funcptr_mod
   use ISO_C_BINDING
   implicit none
-  type(C_FUNPTR) :: fp
+  procedure(SWIGTYPE_f_int_int__int), pointer :: fp
 
-  ! Add
-  call set_handle(0, fp)
+  ! Get the C++ function handle, which starts out as 'add'
+  fp => get_funcvar()
+  ASSERT(fp(2, 3) == 5)
   ASSERT(do_op(2, 3, fp) == 5)
 
-  ! Subtract
-  call set_handle(1, fp)
-  call set_funcvar(fp)
-  ASSERT(do_op(2, 3, get_funcvar()) == -1)
+  ! Set the function handle
+  call set_funcvar(myexp)
+  ! Get it back, then call it from C++
+  ASSERT(do_op(2, 3, get_funcvar()) == 8)
 
 end program
 

Examples/test-suite/fortran_callback.i

@@ -0,0 +1,81 @@
+%module fortran_callback
+
+#ifndef __cplusplus
+// Directly bind all functions: don't create proxy wrappers
+%fortranbindc;
+#endif
+
+// Declare callback signature
+%fortrancallback("%s");
+#ifdef __cplusplus
+extern "C" {
+#endif
+int binary_op(int left, int right);
+void stupid_op(int left, int right);
+void stupider_op();
+#ifdef __cplusplus
+} // end extern
+#endif
+%nofortrancallback;
+
+// Create callbacks and define functions
+%callback("%s_cb");
+
+%inline %{
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+int add(int left, int right) { return left + right; }
+int mul(int left, int right) { return left * right; }
+
+#ifdef __cplusplus
+} // end extern
+#endif
+%}
+
+%nocallback;
+
+// Declare callback signature *and* create function with wrapper
+%fortrancallback("%s_cb") call_binary;
+
+%{
+#include <string.h>
+#include <stdio.h>
+%}
+
+%inline %{
+#ifdef __cplusplus
+extern "C" {
+#endif
+
+typedef int also_an_int;
+
+typedef int (*binary_op_cb)(int, int);
+int call_binary(binary_op_cb fptr, int left, also_an_int right)
+{ return (*fptr)(left, right); }
+
+#ifdef __cplusplus
+} // end extern
+#endif
+
+typedef int (*noarg_cb)(void);
+int call_things(noarg_cb fptr)
+{ return (*fptr)(); }
+
+typedef void (*one_int_cb)(int);
+void also_call_things(one_int_cb fptr, int val)
+{ return (*fptr)(val); }
+
+binary_op_cb get_a_callback(const char* name) {
+  if (strcmp(name, "add") == 0) {
+    return &add;
+  } if (strcmp(name, "mul") == 0) {
+    return &mul;
+  }
+  printf("Invalid callback name '%s'\n", name);
+  return NULL;
+}
+
+%}
+

Examples/test-suite/fortran_callback_c.i

@@ -0,0 +1,4 @@
+%module fortran_callback_c
+
+%include "fortran_callback.i"
+