R - Add support for std::vector<std::vector<std::string>>

Closes #2385

6 files changed, 128 insertions, 5 deletions

diff --git a/CHANGES.current b/CHANGES.current
index 9d4160d37..0a23158a2 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -7,6 +7,9 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/
 Version 4.1.0 (in progress)
 ===========================
 
+2022-10-17: wsfulton
+            [R] #2385 Add support for std::vector<std::vector<std::string>>.
+
 2022-10-14: murillo128
 	    [Javascript] #2109 Tweak unsigned long and unsigned long long typemaps
             to create a v8::Number instead of v8::Integer if the value exceeds
diff --git a/Examples/test-suite/common.mk b/Examples/test-suite/common.mk
index 1c70ece4c..4681571e2 100644
--- a/Examples/test-suite/common.mk
+++ b/Examples/test-suite/common.mk
@@ -714,6 +714,7 @@ CPP_STD_TEST_CASES += \
 	li_std_vector_enum \
 	li_std_vector_member_var\
 	li_std_vector_ptr \
+	li_std_vector_vector \
 	li_std_wstring \
 	smart_pointer_inherit \
 	template_typedef_fnc \
diff --git a/Examples/test-suite/li_std_vector_vector.i b/Examples/test-suite/li_std_vector_vector.i
new file mode 100644
index 000000000..fbffc8d81
--- /dev/null
+++ b/Examples/test-suite/li_std_vector_vector.i
@@ -0,0 +1,50 @@
+%module li_std_vector_vector
+
+%include <std_string.i>
+%include <std_vector.i>
+
+namespace std {
+  %template(VectorInt)   vector<int>;
+  %template(VectorString)   vector<string>;
+  %template(VectorVectorInt)   vector<vector<int>>;
+  %template(VectorVectorString)   vector<vector<string>>;
+};
+
+%inline %{
+std::vector<std::string> make_vector_int() {
+    std::vector<std::string> v = {"1", "2", "3", "4", "5"};
+    return v;
+}
+
+std::vector<std::vector<int> > make_vector_vector_int() {
+    std::vector<std::vector<int> > vv;
+    std::vector<int> v = {1, 2, 3, 4, 5};
+    vv.push_back(v);
+    return vv;
+}
+
+std::vector<bool> make_vector_bool() {
+    std::vector<bool> v = {true, false, false, false, true};
+    return v;
+}
+
+std::vector<std::vector<bool> > make_vector_vector_bool() {
+    std::vector<std::vector<bool> > vv;
+    std::vector<bool> v = {false, true, true, true, false};
+    vv.push_back(v);
+    return vv;
+}
+
+std::vector<std::string> make_vector_string() {
+    std::vector<std::string> v = {"aa", "bb", "cc", "dd", "ee"};
+    return v;
+}
+
+std::vector<std::vector<std::string> > make_vector_vector_string() {
+    std::vector<std::vector<std::string> > vv;
+    std::vector<std::string> v = {"1", "2", "3", "4", "5"};
+    vv.push_back(v);
+    return vv;
+}
+
+%}
diff --git a/Examples/test-suite/r/li_std_vector_vector_runme.R b/Examples/test-suite/r/li_std_vector_vector_runme.R
new file mode 100644
index 000000000..c2c8853b2
--- /dev/null
+++ b/Examples/test-suite/r/li_std_vector_vector_runme.R
@@ -0,0 +1,28 @@
+clargs <- commandArgs(trailing=TRUE)
+source(file.path(clargs[1], "unittest.R"))
+
+dyn.load(paste("li_std_vector_vector", .Platform$dynlib.ext, sep=""))
+source("li_std_vector_vector.R")
+cacheMetaData(1)
+
+v = make_vector_int()
+unittest_sequence(v, list(1, 2, 3, 4, 5))
+v = make_vector_vector_int()
+unittest(length(v), 1)
+unittest_sequence(v[[1]], list(1, 2, 3, 4, 5))
+
+v = make_vector_bool()
+unittest_sequence(v, list(TRUE, FALSE, FALSE, FALSE, TRUE))
+print(v)
+v = make_vector_vector_bool()
+unittest(length(v), 1)
+print(v)
+unittest_sequence(v[[1]], list(FALSE, TRUE, TRUE, TRUE, FALSE)) # Does not actually fail if no match, arg, needs fixing
+
+v = make_vector_string()
+unittest_sequence(v, list("aa", "bb", "cc", "dd", "ee"))
+v = make_vector_vector_string()
+unittest(length(v), 1)
+unittest_sequence(v[[1]], list("1", "2", "3", "4", "5"))
+
+q(save="no")
diff --git a/Examples/test-suite/r/unittest.R b/Examples/test-suite/r/unittest.R
index b55b4a3f3..481be8ecc 100644
--- a/Examples/test-suite/r/unittest.R
+++ b/Examples/test-suite/r/unittest.R
@@ -1,8 +1,8 @@
 unittest <- function (x,y) {
   if (all(x==y)) {
-    print("PASS") 
+    print("PASS")
   } else {
-    print("FAIL") 
+    print("FAIL")
     stop("Test failed")
   }
 }
@@ -15,3 +15,12 @@ unittesttol <- function(x,y,z) {
     stop("Test failed")
   }
 }
+
+unittest_sequence <- function (x,y) {
+  if (setequal(x, y)) {
+    print("PASS")
+  } else {
+    print("FAIL")
+    stop("Test failed")
+  }
+}
diff --git a/Lib/r/std_vector.i b/Lib/r/std_vector.i
index 93d1c6256..62478fe6a 100644
--- a/Lib/r/std_vector.i
+++ b/Lib/r/std_vector.i
@@ -660,6 +660,27 @@
       }
     };
 
+  template <>
+    struct traits_from_ptr<std::vector<std::vector<std::basic_string<char> > > > {
+      static SEXP from (std::vector< std::vector<std::basic_string<char> > > *val, int owner = 0) {
+        SEXP result;
+        // allocate the R list
+        PROTECT(result = Rf_allocVector(VECSXP, val->size()));
+        for (unsigned pos = 0; pos < val->size(); pos++)
+          {
+            // allocate the R vector
+            SET_VECTOR_ELT(result, pos, Rf_allocVector(STRSXP, val->at(pos).size()));
+            // Fill the R vector
+            for (unsigned vpos = 0; vpos < val->at(pos).size(); ++vpos)
+              {
+                CHARACTER_POINTER(VECTOR_ELT(result, pos))[vpos] = Rf_mkChar(val->at(pos).at(vpos).c_str());
+              }
+          }
+        UNPROTECT(1);
+        return(result);
+      }
+    };
+
   template <typename T>
     struct traits_from_ptr< std::vector < std::vector< T > > > {
     static SEXP from (std::vector < std::vector< T > > *val, int owner = 0) {
@@ -887,8 +908,6 @@ std::vector< std::basic_string<char> > *,
    std::vector< std::basic_string<char> > & 
 %{    %}
 
-%apply std::vector< std::basic_string<char> > { std::vector< std::string> };
-
 // all the related integer vectors
 // signed
 %typemap_traits_ptr(SWIG_TYPECHECK_VECTOR, std::vector<signed char>);
@@ -1005,6 +1024,13 @@ std::vector< std::basic_string<char> > *,
 %typemap("rtype") std::vector<std::vector<bool> >, std::vector<std::vector<bool> > *, std::vector<std::vector<bool> > & "list"
 %typemap("scoercein") std::vector< std::vector<bool> >, std::vector<std::vector<bool> > *, std::vector<std::vector<bool> > & "$input = lapply($input, as.logical);"
 
+%typemap_traits_ptr(SWIG_TYPECHECK_VECTOR, std::vector<std::vector<std::basic_string<char> > >);
+%traits_type_name(std::vector< std::vector<std::basic_string<char> > >);
+%typemap("rtypecheck") std::vector<std::vector<std::basic_string<char> > >, std::vector<std::vector<std::basic_string<char> > > *, std::vector<std::vector<std::basic_string<char> > > &
+   %{ is.list($arg) && all(sapply($arg , is.character)) %}
+%typemap("rtype") std::vector<std::vector<std::basic_string<char> > >, std::vector<std::vector<std::basic_string<char> > > *, std::vector<std::vector<std::basic_string<char> > > & "list"
+%typemap("scoercein") std::vector< std::vector<std::basic_string<char> > >, std::vector<std::vector<std::basic_string<char> > > *, std::vector<std::vector<std::basic_string<char> > > & "$input = lapply($input, as.character);"
+
 // we don't want these to be given R classes as they
 // have already been turned into R vectors.
 %typemap(scoerceout) std::vector<double>,
@@ -1049,7 +1075,10 @@ std::vector< std::basic_string<char> > *,
    std::vector< std::vector<double> >&,
    std::vector< std::vector<bool> >,
    std::vector< std::vector<bool> >*,
-   std::vector< std::vector<bool> >&
+   std::vector< std::vector<bool> >&,
+   std::vector< std::vector<std::basic_string<char> > >,
+   std::vector< std::vector<std::basic_string<char> > >*,
+   std::vector< std::vector<std::basic_string<char> > >&
  %{    %}
 
 #if defined(SWIGWORDSIZE64)
@@ -1071,3 +1100,6 @@ std::vector< std::basic_string<char> > *,
  %{    %}
 
 #endif
+
+%apply std::vector< std::basic_string<char> > { std::vector<std::string> };
+%apply std::vector< std::vector< std::basic_string<char> > > { std::vector< std::vector<std::string> > };