Merge pull request #98 from swig-fortran/empty-arrays

Fix empty arrays and add reference-to-view

Doc/Manual/src/Fortran.md

@@ -1246,27 +1246,32 @@ where a class provides a custom `operator->` and unary `operator*`, is not yet
 implemented. All C++ `operator` overloads except for assignment are currently
 ignored.
 
-## Returning array pointers
+## Array pointers
 
-The `<view.i>` library file provides an alternate means of converting to and from Fortran array pointers. It translates `std::pair<T*, size_t>` input and
-output values to and from Fortran array pointers. See the section on [pointers
-and references](#pointers-and-references) for cautions on functions returning
-pointers, but in short, the wrapper code
+The `<std_span.i>` library file provides an example of interacting directly
+with Fortran array pointers. The `std::span` class is proposed for C++20, so
+this file serves mostly as an example of array translation for other
+scientific software libraries that use functionally equivalent classes: storing
+a simple non-owning reference to a contiguous array of data.
+
+Returning a `std::span<T>` yields a Fortran array pointer, and taking a
+*reference* to a span allows a Fortran array pointer to be set.
 ```swig
-#include <view.i>
-%fortran_view(double)
-std::pair<double *, size_t> get_array_ptr();
+#include <std_span.i>
+%template() std::span<int>;
+std::span<int> get_array_ptr();
+void set_array_ptr(std::span<int>& arr);
+void increment(std::span<int> arr);
 ```
 is usable in Fortran as
 ```fortran
-real(C_DOUBLE), pointer :: arrptr(:)
+integer(C_INT), pointer :: arrptr(:)
 arrptr => get_array_ptr()
+call set_array_ptr(arrptr)
+call increment(arrptr)
 ```
-
-Since this library file is so simple, it can be used as a template for creating
-transparent wrappers between Fortran arrays and other C++ data types. Similar
-code is used in the `ForTrilinos` library to treat `Teuchos::ArrayView`
-return values as Fortran array pointers.
+See the section on [pointers and references](#pointers-and-references) for
+cautions on functions returning pointers.
 
 ## Integer types
 

Examples/fortran/bare/example.i

@@ -18,10 +18,6 @@
 %fortranconst approx_pi;
 
 #ifdef SWIGFORTRAN
-%include <typemaps.i>
-
-// Instantiate array pointer conversion for doubles from pair<double*,size_t>
-%fortran_view(double)
 
 // Ignore one of the functions that can't be overloaded correctly
 %ignore cannot_overload(int);

Examples/fortran/thinvec/example.i

@@ -5,13 +5,24 @@
 
 %module example
 
-%include <typemaps.i>
-%fortran_view(int)
-%fortran_view(double)
-
 // Ignore return of types we don't understand (to prevent a warning)
 %ignore ThinVec::data() const;
 
+// Wrap the 'view' types in ThinVec as array pointers
+%include <fortranarray.swg>
+
+%define %thinvec_views(CPPTYPE)
+%fortran_array_pointer(CPPTYPE, std::pair<CPPTYPE*, std::size_t>)
+%typemap(in, noblock=1) std::pair<CPPTYPE*, std::size_t> {
+  $1 = $1_type(static_cast<CPPTYPE*>($input->data), $input->size);
+}
+%typemap(out, noblock=1) std::pair<CPPTYPE*, std::size_t> {
+  $result.data = $1.first;
+  $result.size = $1.second;
+}
+%apply std::pair<CPPTYPE*, std::size_t> { std::pair<const CPPTYPE*, std::size_t> }
+%enddef
+
 /* -------------------------------------------------------------------------
  * Note: since we use %const_cast and %static_cast, which are SWIG-defined
  * macros, we must use {} rather than %{ %} for the typemap. To prevent those
@@ -43,6 +54,10 @@
 // Load the thinvec class definition
 %include "example.h"
 
+// Set up typemaps for "views"
+%thinvec_views(double)
+%thinvec_views(int)
+
 // Instantiate classes
 %template(ThinVecDbl) ThinVec<double>;
 %template(ThinVecInt) ThinVec<int>;

Examples/test-suite/fortran/arrays_runme.F90

@@ -21,7 +21,7 @@ subroutine test_arrays
   got_arr => arr%get_array_i()
   write(0,*) got_arr
 
-  if (any(got_arr /= actual)) stop 1
+  ASSERT(all(got_arr == actual))
 
 end subroutine
 

Examples/test-suite/fortran/fortran_std_span_runme.F90

@@ -0,0 +1,60 @@
+! File : fortran_std_span_runme.F90
+
+#include "fassert.h"
+
+program fortran_std_span_runme
+  implicit none
+
+  call test_std_span
+
+contains
+subroutine test_std_span
+  use fortran_std_span
+  use ISO_C_BINDING
+  implicit none
+  integer(C_INT), dimension(:), pointer :: ptr => null()
+  integer(C_INT), dimension(:), pointer :: local_ptr => null()
+  integer(C_INT), dimension(3) :: expected = [1, 2, 3]
+  integer(C_INT), dimension(:), allocatable, target :: values
+
+  ! Get pointer by value
+  ptr => get_by_value()
+  ASSERT(associated(ptr) .and. size(ptr) == 3)
+  ASSERT(all(ptr == expected))
+
+  ! Get by reference
+  ptr => null()
+  call get_by_reference(ptr)
+  ASSERT(associated(ptr) .and. size(ptr) == 3)
+  ASSERT(all(ptr == expected))
+
+  ! Copy from Fortran pointer
+  ptr => null()
+  allocate(values(4), source = [5, 6, 7, 8])
+  local_ptr => values
+  call copy(local_ptr, ptr)
+  ASSERT(associated(ptr) .and. size(ptr) == 4)
+  ASSERT(all(ptr == values))
+
+  ! Copy directly from Fortran array
+  ptr => null()
+  call copy(values, ptr)
+  ASSERT(associated(ptr) .and. size(ptr) == 4)
+  ASSERT(all(ptr == values))
+
+  ! Modify values
+  ptr => values
+  call increment_and_disassociate(ptr)
+  ASSERT(values(4) == 9)
+  ASSERT(.not. associated(ptr))
+
+  ! Make one pointer point to another
+  ptr => null()
+  local_ptr => values
+  ptr => const_ref(local_ptr)
+  ASSERT(associated(ptr, local_ptr))
+
+end subroutine
+
+end program
+

Examples/test-suite/fortran/li_std_vector_runme.F90

@@ -0,0 +1,31 @@
+! File : li_std_vector_runme.f90
+
+#include "fassert.h"
+
+program li_std_vector_runme
+  use li_std_vector
+  use ISO_C_BINDING
+
+  call test_strings
+contains
+subroutine test_strings
+  implicit none
+  type(StringVector) :: strings!, reversed
+
+  strings = StringVector()
+  call strings%push_back("Sam")
+  call strings%push_back("I am")
+  ASSERT(strings%front() == "Sam")
+  ASSERT(strings%back() == "I am")
+
+  ! XXX The typemaps assume the vector holds POD for views.
+
+!  ! Since RevStringVec takes a string vector by const reference, we must provide it a view. 
+!  reversed = RevStringVec(strings%view())
+!  ! Note that vectors use Fortran indexing
+!  ASSERT(strings%get(1) == "I am")
+!  ASSERT(strings%get(2) == "Sam")
+end subroutine
+
+end program
+

Examples/test-suite/fortran_std_span.i

@@ -0,0 +1,61 @@
+/* File: fortran_std_span.i */
+%module fortran_std_span
+
+%{
+// Simplified span class
+namespace std {
+template<class _Tp, int _Ex = -1>
+class span
+{
+ public:
+  typedef int index_type;
+  typedef _Tp* pointer;
+
+  span() : d_ptr(NULL), d_size(0) {}
+  span(pointer d, index_type s) : d_ptr(d), d_size(s) {}
+  span(pointer first, pointer last) : d_ptr(first), d_size(last - first) {}
+
+  pointer data() const { return d_ptr; }
+  index_type size() const { return d_size; }
+
+ private:
+  pointer d_ptr;
+  index_type d_size;
+};
+} // namespace std
+
+%}
+
+%include <std_span.i>
+
+%template() std::span<int>;
+%template() std::span<const int>;
+
+%inline %{
+std::span<int> get_by_value() {
+  static int tmp[] = {1, 2, 3};
+  return std::span<int>(tmp, tmp + 3);
+}
+
+void get_by_reference(std::span<int>& arr) {
+  arr = get_by_value();
+}
+
+void copy(std::span<const int> src, std::span<const int>& dst) {
+  dst = src;
+}
+
+void increment_and_disassociate(std::span<int>& dst) {
+  int* ptr = dst.data();
+  for (int i = 0; i < dst.size(); ++i)
+    ptr[i]++;
+  dst = std::span<int>();
+}
+
+const std::span<const int>& const_ref(const std::span<const int>& src) {
+  return src;
+}
+
+%}
+
+

Examples/test-suite/typemap_template.i

@@ -27,7 +27,7 @@ template<typename T> struct TemplateTest1 {
 %template(TTint) TemplateTest1< int >;
 
 %inline %{
-  void extratest(const TemplateTest1< YY > &t, 
+  void extratest(const TemplateTest1< YY > &t,
                  const TemplateTest1< ZZ > &tt,
                  const TemplateTest1< int > &ttt)
   {}
@@ -38,3 +38,27 @@ template<typename T> struct TemplateTest1 {
 %inline %{
   void wasbug(TemplateTest1< int >::Double wbug) {}
 %}
+
+/* Test bug where the %apply directive was ignored inside anonymous template
+ * instantiations */
+
+template<class T>
+struct Foo {
+  %typemap(in) Foo<T> ""
+  %apply Foo<T> { const Foo<T> & }
+};
+
+%{
+template<class T> struct Foo {};
+%}
+
+%template(Foo_int) Foo<int>;
+%template() Foo<double>;
+
+%inline %{
+  void this_works(Foo<int> f) {}
+  void this_also_works(const Foo<int>& f) {}
+  void this_also_also_works(Foo<double> f) {}
+  void this_used_to_fail(const Foo<double>& f) {}
+%}
+

Lib/fortran/fortran.swg

@@ -64,6 +64,8 @@
  * findecl    : declare any variables used in converting an input value
  *              ($1_temp)
  * foutdecl   : declare any temporary variables used to convert output values
+ * fargout    : after calling the C++ function, convert the wrapper argument to 
+ *              a mutable Fortran argument (e.g. for a handle `int**`)
  */
 
 /* FRAGMENT OVERRIDES */

Lib/fortran/fortranarray.swg

@@ -108,14 +108,72 @@ end subroutine}
   }
 
   %typemap(fin, noblock=1) CPPTYPE {
-    $1_view => $input(1)
-    $1%data = c_loc($1_view)
-    $1%size = size($input)
+    if (size($input) > 0) then
+      $1_view => $input(1)
+      $1%data = c_loc($1_view)
+      $1%size = size($input)
+    else
+      $1%data = c_null_ptr
+      $1%size = 0
+    end if
   }
 
   // Fortran proxy translation code: convert from imtype 1 to ftype $result
   %typemap(fout, noblock=1) CPPTYPE {
-    call c_f_pointer($1%data, $result, [$1%size])
+    if ($1%size > 0) then
+      call c_f_pointer($1%data, $result, [$1%size])
+    else
+      $result => NULL()
+    endif
+  }
+%enddef
+
+/* ------------------------------------------------------------------------- */
+/*!
+ * \def %fortran_array_pointer_and_ref
+ *
+ * Convert a C++ input argument to an array pointer.
+ *
+ * For example, the function
+ * \code
+   void f(double** data, size_t* size);
+   \endcode
+ * would take a Fortran array pointer as an (INOUT) argument.
+ *
+ * This defines:
+ * - C type interface
+ * - IM type interface
+ * - FIN
+ * - FTYPE array pointer
+ *
+ * which means you still must define the C++ <--> C conversions elsewhere.
+ * Make sure to add the `match="in"` keyword to the `argout` typemap.
+ */
+%define %fortran_array_handle(VTYPE, CPPTYPE...)
+
+  // Input arguments for pointer-by-ref are the same
+  %typemap(ftype, in={$typemap(imtype, VTYPE), dimension(:), pointer, intent(inout)}, noblock=1) CPPTYPE& {
+    $typemap(imtype, VTYPE), dimension(:), pointer
+  }
+  %typemap(fin, match="ftype", noblock=1) CPPTYPE& {
+    if (size($input) > 0) then
+      $1%data = c_loc($input)
+      $1%size = size($input)
+    else
+      $1%data = c_null_ptr
+      $1%size = 0
+    end if
+  }
+  %typemap(imtype) CPPTYPE& = CPPTYPE;
+  %typemap(ctype) CPPTYPE& = CPPTYPE;
+
+  // Update the resulting Fortran pointer.
+  %typemap(fargout, match="argout", noblock=1) CPPTYPE& {
+    if ($1%size > 0) then
+      call c_f_pointer($1%data, $input, [$1%size])
+    else
+      $input => NULL()
+    endif
   }
 %enddef