Merge pull request #153 from swig-fortran/deferred-array-typemaps

Add deferred-size array typemaps

Author: sethrj

Examples/test-suite/fortran/fortran_array_typemap_runme.F90

@@ -7,6 +7,8 @@ program fortran_array_typemap_runme
 
   call test_ptr_size
   call test_fixed
+  call test_deferred
+  call test_deferred_2d
 
 contains
 
@@ -26,7 +28,7 @@ subroutine test_ptr_size
   ASSERT(accum(int_values) == 2 * 4)
 end subroutine
 
-! Test two-argument (pointer + size) -> dynamic
+! Test hard-coded dimensions
 subroutine test_fixed
   use fortran_array_typemap
   use ISO_C_BINDING
@@ -52,6 +54,36 @@ subroutine test_fixed
   ASSERT(cpp_sum(dbl_values) == sum(dbl_values))
 end subroutine
 
-end program
+! Test deferred-size arrays
+subroutine test_deferred
+  use fortran_array_typemap
+  use ISO_C_BINDING
+  implicit none
+  real(C_DOUBLE), dimension(5) :: dbl_values
+  integer :: i
 
+  dbl_values = [(i * 2.0d0, i = 1, size(dbl_values))]
 
+  ASSERT(cpp_dynamic_sum(size(dbl_values), dbl_values) == sum(dbl_values))
+
+end subroutine
+
+! Test deferred-size arrays
+subroutine test_deferred_2d
+  use fortran_array_typemap
+  use ISO_C_BINDING
+  implicit none
+  real(C_DOUBLE), dimension(3,2) :: points
+  real(C_DOUBLE), dimension(3) :: avg_points = [-1, -1, -1]
+
+  points(:,1) = [-10, 10, 4]
+  points(:,2) = [10, 10, 0]
+  call average_points(size(points, 2), points, avg_points)
+
+  ASSERT(avg_points(1) == 0.0d0)
+  ASSERT(avg_points(2) == 10.0d0)
+  ASSERT(avg_points(3) == 2.0d0)
+
+end subroutine
+
+end program

Examples/test-suite/fortran_array_typemap.i

@@ -58,3 +58,46 @@ double cpp_sum(const double inp[3][2]) {
 }
 %}
 
+/* Test variable-size arguments */
+
+%apply SWIGTYPE ARRAY[] { const double* inp, const double inpv[] };
+
+%inline %{
+double cpp_dynamic_sum(int count, const double *inp) {
+  const double *end = inp + count;
+  const double *v;
+  double value = 0;
+  for (v = inp; v != end; ++v) {
+    value += *v;
+  }
+  return value;
+}
+
+double cpp_dynamic_sum_arr(int inpc, const double inpv[]) {
+  return cpp_dynamic_sum(inpc, inpv);
+}
+%}
+
+/* Test mixed fixed/variable size */
+
+%apply SWIGTYPE ARRAY[][ANY] { const double points[][3] };
+%apply SWIGTYPE ARRAY[ANY] { double avg[3] };
+
+%inline %{
+void average_points(int count, const double points[][3], double avg[3]) {
+  int i, j;
+  double norm;
+  avg[0] = avg[1] = avg[2] = 0.0;
+  for (i = 0; i < count; ++i) {
+    for (j = 0; j < 3; ++j) {
+      avg[j] += points[i][j];
+    }
+  }
+
+  norm = 1.0 / (double)count;
+  for (j = 0; j < 3; ++j) {
+    avg[j] *= norm;
+  }
+}
+%}
+

Lib/fortran/typemaps.i

@@ -35,7 +35,7 @@ $2 = $input->size;
  *
  * To apply these to a function `void foo(const int x[4]);`:
  *
- * %apply SWIGTYPE ARRAY[ANY] {const  int x[4] };
+ * %apply SWIGTYPE ARRAY[ANY] {const int x[4] };
  */
 
 %apply FORTRAN_INTRINSIC_TYPE& { SWIGTYPE ARRAY[ANY], SWIGTYPE ARRAY[ANY][ANY], SWIGTYPE ARRAY[ANY][ANY][ANY] }
@@ -69,3 +69,15 @@ $result = $1_temp}
  "$typemap(bindc, $1_basetype), dimension($1_dim2,$1_dim1,$1_dim0)"
 
 
+/* -------------------------------------------------------------------------
+ * Interact natively with Fortran deferred-size arrays.
+ *
+ * To apply these to a function `void foo(const int* x);`:
+ *
+ * %apply SWIGTYPE ARRAY[] {const int* x };
+ */
+
+%apply SWIGTYPE ARRAY[ANY] { SWIGTYPE ARRAY[] };
+%apply SWIGTYPE ARRAY[ANY][ANY] { SWIGTYPE ARRAY[][ANY] };
+%apply SWIGTYPE ARRAY[ANY][ANY][ANY] { SWIGTYPE ARRAY[][ANY][ANY] };
+

Source/Modules/fortran.cxx

@@ -136,24 +136,32 @@ int fix_fortran_dims(Node *n, const char *tmap_name, String *typemap) {
   if (!is_checkdims)
     return SWIG_OK;
 
-  SwigType* t = Getattr(n, "type");
-  ASSERT_OR_PRINT_NODE(SwigType_isarray(t), n);
-  int ndim = SwigType_array_ndim(t);
-  for (int i = 0; i < ndim; i++) {
-    String *dim = SwigType_array_getdim(t, i);
-    if (dim && Len(dim) > 0 && !is_fortran_intexpr(dim)) {
-      Swig_warning(WARN_LANG_IDENTIFIER, input_file, line_number,
-                   "Array dimension expression '%s' is incompatible with Fortran\n",
-                   dim);
+  SwigType *t = Getattr(n, "type");
+
+  if (SwigType_isarray(t)) {
+    int ndim = SwigType_array_ndim(t);
+    for (int i = 0; i < ndim; i++) {
+      String *dim = SwigType_array_getdim(t, i);
+      if (dim && Len(dim) > 0 && !is_fortran_intexpr(dim)) {
+        Swig_warning(WARN_LANG_IDENTIFIER, input_file, line_number, "Array dimension expression '%s' is incompatible with Fortran\n", dim);
+        Delete(dim);
+        return SWIG_ERROR;
+      }
       Delete(dim);
-      return SWIG_ERROR;
     }
-    Delete(dim);
-  }
 
-  // Replace empty dimensions with assumed-size dimension
-  Replaceall(typemap, "dimension()", "dimension(*)");
-  Replaceall(typemap, ",)", ",*)");
+    // Replace empty dimensions with assumed-size dimension
+    Replaceall(typemap, "dimension()", "dimension(*)");
+    Replaceall(typemap, ",)", ",*)");
+  } else if (SwigType_ispointer(t)) {
+    // Note that we use `imname` instead of `lname` since it was temporarily changed for typemap matching for ftype. Pointers should only have a single
+    // dimension, so we replace with deferred size.
+    String *dimname = NewStringf("%s_dim0", Getattr(n, "imname"));
+    Replaceall(typemap, dimname, "*");
+    Delete(dimname);
+  } else {
+    ASSERT_OR_PRINT_NODE(false, n);
+  }
 
   return SWIG_OK;
 }