Overloading fixes for R and rtypecheck typemap

- Fix for special variable $argtype expansion in rtypecheck typemap.
- Remove unnecessary () brackets when using rtypecheck typemap for
  single parameter functions.
- Add rtypecheck typemaps for shared_ptr so that NULL can be used
  in overloaded functions taking shared_ptr.

4 files changed, 26 insertions, 13 deletions

diff --git a/CHANGES.current b/CHANGES.current
index 693f8f3bf..4e374adf5 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -21,3 +21,7 @@ Version 4.1.1 (in progress)
             Example of new improved error message:
               Error in use_count(k) :
                 cannot find overloaded function for use_count with argtypes (NULL)
+
+2022-10-27: wsfulton
+            [R] Allow NULL to be used in overloaded functions taking shared_ptr.
+            Also fixes special variable $argtype expansion in rtypecheck typemaps.
diff --git a/Examples/test-suite/r/li_boost_shared_ptr_runme.R b/Examples/test-suite/r/li_boost_shared_ptr_runme.R
index ec8c66dcf..0b0a0b770 100644
--- a/Examples/test-suite/r/li_boost_shared_ptr_runme.R
+++ b/Examples/test-suite/r/li_boost_shared_ptr_runme.R
@@ -512,7 +512,7 @@ testSuite <- function() {
     testSuite_verifyCount(1, kmember);
     testSuite_verifyCount(1, k);
 
-    delete_MemberVariables(m); # m.delete();
+    delete_MemberVariables(m);
     testSuite_verifyCount(1, kmember);
     testSuite_verifyCount(1, k);
   }
@@ -532,7 +532,7 @@ testSuite <- function() {
     testSuite_verifyCount(1, kmember);
     testSuite_verifyCount(1, k);
 
-    delete_MemberVariables(m); # m.delete();
+    delete_MemberVariables(m);
     testSuite_verifyCount(1, kmember);
     testSuite_verifyCount(1, k);
   }
@@ -552,7 +552,7 @@ testSuite <- function() {
     testSuite_verifyCount(1, kmember);
     testSuite_verifyCount(1, k);
 
-    delete_MemberVariables(m); # m.delete();
+    delete_MemberVariables(m);
     testSuite_verifyCount(1, kmember);
     testSuite_verifyCount(1, k);
   }
@@ -570,7 +570,7 @@ testSuite <- function() {
     k = m$SmartMemberValue;
     if (!is.null(k))
       stop("expected null");
-    testSuite_verifyCount(0, k); # this does not work for nulls
+    testSuite_verifyCount(0, k);
 
     # plain by value
     bNotCatched = F
diff --git a/Lib/r/boost_shared_ptr.i b/Lib/r/boost_shared_ptr.i
index 13f041fbb..fde6ae56b 100644
--- a/Lib/r/boost_shared_ptr.i
+++ b/Lib/r/boost_shared_ptr.i
@@ -400,6 +400,12 @@
                      SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE > *&
   "$typemap(rtype, TYPE)"
 
+%typemap(rtypecheck) SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE >,
+                     SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE > &,
+                     SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE > *,
+                     SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE > *&
+  "(extends($argtype, '$typemap(rtype, TYPE)') && length($arg) == 1) || is.null($arg)"
+
 %typemap(scoercein)  SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE >,
                      SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE > &,
                      SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE > *,
diff --git a/Source/Modules/r.cxx b/Source/Modules/r.cxx
index e3d69329b..c8b34cb54 100644
--- a/Source/Modules/r.cxx
+++ b/Source/Modules/r.cxx
@@ -1595,7 +1595,7 @@ void R::dispatchFunction(Node *n) {
 	first_compare = false;
       }
       Printv(f->code, "if (", NIL);
-      for (p =pi, j = 0 ; j < num_arguments ; j++) {
+      for (p = pi, j = 0 ; j < num_arguments ; j++) {
 	if (debugMode) {
 	  Swig_print_node(p);
 	}
@@ -1606,21 +1606,24 @@ void R::dispatchFunction(Node *n) {
 
 	String *tmcheck = Swig_typemap_lookup("rtypecheck", p, "", 0);
 	if (tmcheck) {
-	  String *tmp = NewString("");
-	  Printf(tmp, "argv[[%d]]", j+1);
-	  Replaceall(tmcheck, "$arg", tmp);
-	  Printf(tmp, "argtype[%d]", j+1);
-	  Replaceall(tmcheck, "$argtype", tmp);
+	  String *tmp_argtype = NewStringf("argtypes[%d]", j+1);
+	  Replaceall(tmcheck, "$argtype", tmp_argtype);
+	  String *tmp_arg = NewStringf("argv[[%d]]", j+1);
+	  Replaceall(tmcheck, "$arg", tmp_arg);
 	  if (tm) {
 	    Replaceall(tmcheck, "$rtype", tm);
 	  }
 	  if (debugMode) {
 	    Printf(stdout, "<rtypecheck>%s\n", tmcheck);
 	  }
-	  Printf(f->code, "%s(%s)",
-		 j == 0 ? "" : " && ",
-		 tmcheck);
+	  if (num_arguments == 1) {
+	    Printf(f->code, "%s", tmcheck);
+	  } else {
+	    Printf(f->code, "%s(%s)", j == 0 ? "" : " && ", tmcheck);
+	  }
 	  p = Getattr(p, "tmap:in:next");
+	  Delete(tmp_arg);
+	  Delete(tmp_argtype);
 	  continue;
 	}
 	// Below should be migrated into rtypecheck typemaps