R shared_ptr fixes

Fix problems in shared_ptr wrappers where the class names were
not consistent when using the shared_ptr template or the actual
underlying type. Move $R_class substitution to typemaps.

Issue #2386

4 files changed, 57 insertions, 73 deletions

diff --git a/CHANGES.current b/CHANGES.current
index 2ad66dd59..c82d1221b 100644
--- a/CHANGES.current
+++ b/CHANGES.current
@@ -7,6 +7,11 @@ the issue number to the end of the URL: https://github.com/swig/swig/issues/
 Version 4.1.0 (in progress)
 ===========================
 
+2022-10-24: wsfulton, AndLLA
+            [R] #2386 Fix problems in shared_ptr wrappers where the class names
+            were not consistent when using the shared_ptr template or the actual
+            underlying type.
+
 2022-10-24: wsfulton
             [R] Add support for special variable replacement in the $typemap()
             special variable macro for R specific typemaps (rtype, rtypecheck,
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 059adf1da..d1e343cb3 100644
--- a/Examples/test-suite/r/li_boost_shared_ptr_runme.R
+++ b/Examples/test-suite/r/li_boost_shared_ptr_runme.R
@@ -83,7 +83,7 @@ testSuite <- function() {
 	if (FALSE) {
 	  # pass by shared_ptr pointer reference
 	  k = Klass("me oh my")
-	  kret = smartpointerpointerreftest(k) # undefined class _p_p_SwigBoost__shared_ptrT_Space__Klass_t
+	  kret = smartpointerpointerreftest(k)
 	  val = kret$getValue()
 	  unittest("me oh my smartpointerpointerreftest", val)
 	  testSuite_verifyCount(2, k)
@@ -93,7 +93,7 @@ testSuite <- function() {
 	if (FALSE) {
 	  # pass by shared_ptr pointer reference
 	  k = Klass("me oh my");
-	  kret = smartpointerpointerreftest(k); # undefined class _p_p_SwigBoost__shared_ptrT_Space__Klass_t
+	  kret = smartpointerpointerreftest(k);
 	  val = kret$getValue()
 	  unittest("me oh my smartpointerpointerreftest", val);
 	  testSuite_verifyCount(2, k);
@@ -104,10 +104,10 @@ testSuite <- function() {
 	{
 	  k = Klass("me oh my");
 	  kret = constsmartpointertest(k);
-	  val = Klass_getValue(kret) # kret$getValue(); - method not defined
+	  val = Klass_getValue(kret);
 	  unittest("me oh my", val);
 	  testSuite_verifyCount(2, k);
-	  # testSuite_verifyCount(2, kret); # -> use_count not defined on _p_SwigBoost__shared_ptrT_Space__Klass_const_t
+	  testSuite_verifyCount(2, kret);
 	}
 
   # const pass by shared_ptr pointer
@@ -117,7 +117,7 @@ testSuite <- function() {
     val = Klass_getValue(kret)
     unittest("me oh my", val)
     testSuite_verifyCount(2, k)
-    # testSuite_verifyCount(2, kret) # -> use_count not defined on _p_SwigBoost__shared_ptrT_Space__Klass_const_t
+    testSuite_verifyCount(2, kret)
   }
 
   # const pass by shared_ptr reference
@@ -127,7 +127,7 @@ testSuite <- function() {
     val = Klass_getValue(kret)
     unittest("me oh my", val)
     testSuite_verifyCount(2, k)
-    # testSuite_verifyCount(2, kret) # -> use_count not defined for _p_SwigBoost__shared_ptrT_Space__Klass_const_t
+    testSuite_verifyCount(2, kret)
   }
 
   # pass by value
@@ -137,7 +137,7 @@ testSuite <- function() {
     val = kret$getValue();
     unittest("me oh my valuetest", val);
     testSuite_verifyCount(1, k);
-    # testSuite_verifyCount(1, kret); # -> use_count not defined on _p_Space__Klass
+    testSuite_verifyCount(1, kret);
   }
 
   # pass by pointer
@@ -147,7 +147,7 @@ testSuite <- function() {
     val = kret$getValue();
     unittest("me oh my pointertest", val);
     testSuite_verifyCount(1, k);
-    # testSuite_verifyCount(1, kret); # -> use_count not defined on _p_Space__Klass
+    testSuite_verifyCount(1, kret);
   }
 
   # pass by reference
@@ -157,17 +157,17 @@ testSuite <- function() {
     val = kret$getValue();
     unittest("me oh my reftest", val);
     testSuite_verifyCount(1, k);
-    #testSuite_verifyCount(1, kret); # -> use_count not defined on _p_Space__Klass
+    testSuite_verifyCount(1, kret);
   }
 
   # pass by pointer reference
   {
     k = Klass("me oh my");
-    kret = pointerreftest(k); # -> class not defined _p_p_Space__Klass
+    kret = pointerreftest(k);
     val = kret$getValue();
     unittest("me oh my pointerreftest", val);
     testSuite_verifyCount(1, k);
-    # testSuite_verifyCount(1, kret); # -> use_count not defined on _p_Space__Klass
+    testSuite_verifyCount(1, kret);
   }
 
   # null tests
@@ -239,7 +239,7 @@ testSuite <- function() {
     k = pointerownertest();
     val = k$getValue();
     unittest("pointerownertest", val);
-    # testSuite_verifyCount(1, k); # -> use_count not defined for _p_Space__Klass
+    testSuite_verifyCount(1, k);
   }
 
   {
@@ -286,7 +286,7 @@ testSuite <- function() {
   # pass by shared_ptr pointer reference (mixed)
   if (FALSE) {
     k = KlassDerived("me oh my");
-    kret = smartpointerpointerreftest(k); # undefined class _p_p_SwigBoost__shared_ptrT_Space__Klass_t
+    kret = smartpointerpointerreftest(k);
     val = kret$getValue();
     unittest("me oh my derivedsmartptrpointerreftest-Derived", val);
     testSuite_verifyCount(2, k); # includes two extra references for upcasts in the proxy classes
@@ -313,7 +313,7 @@ testSuite <- function() {
     val = kret$getValue();
     unittest("me oh my derivedpointertest-Derived", val);
     testSuite_verifyCount(1, k);
-    # testSuite_verifyCount(1, kret); -> use_count not defined for _p_Space__KlassDerived
+    testSuite_verifyCount(1, kret);
   }
 
   # pass by ref (mixed)
@@ -340,12 +340,12 @@ testSuite <- function() {
     unittest(overload_rawbyval(k), "rawbyval")
     unittest(overload_rawbyref(k), "rawbyref")
     unittest(overload_rawbyptr(k), "rawbyptr")
-    # unittest(overload_rawbyptrref(k), "rawbyptrref") --> undefined for _p_SwigBoost__shared_ptrT_Space__Klass_t
+    unittest(overload_rawbyptrref(k), "rawbyptrref")
 
     unittest(overload_smartbyval(k), "smartbyval")
     unittest(overload_smartbyref(k), "smartbyref")
     unittest(overload_smartbyptr(k), "smartbyptr")
-    # unittest(overload_smartbyptrref(k), "smartbyptrref") --> undefined for _p_SwigBoost__shared_ptrT_Space__Klass_t
+    unittest(overload_smartbyptrref(k), "smartbyptrref")
   }
 
   # Derived class
@@ -355,12 +355,12 @@ testSuite <- function() {
     unittest(overload_rawbyval(k), "rawbyval")
     unittest(overload_rawbyref(k), "rawbyref")
     unittest(overload_rawbyptr(k), "rawbyptr")
-    # unittest(overload_rawbyptrref(k), "rawbyptrref") --> undefined for _p_SwigBoost__shared_ptrT_Space__KlassDerived_t
+    unittest(overload_rawbyptrref(k), "rawbyptrref")
 
     unittest(overload_smartbyval(k), "smartbyval")
     unittest(overload_smartbyref(k), "smartbyref")
     unittest(overload_smartbyptr(k), "smartbyptr")
-    # unittest(overload_smartbyptrref(k), "smartbyptrref") --> undefined for _p_SwigBoost__shared_ptrT_Space__KlassDerived_t
+    unittest(overload_smartbyptrref(k), "smartbyptrref")
   }
 
   # 3rd derived class
@@ -370,12 +370,12 @@ testSuite <- function() {
     unittest(overload_rawbyval(k), "rawbyval")
     unittest(overload_rawbyref(k), "rawbyref")
     unittest(overload_rawbyptr(k), "rawbyptr")
-    # unittest(overload_rawbyptrref(k), "rawbyptrref") --> undefined for _p_SwigBoost__shared_ptrT_Space__Klass3rdDerived_t
+    unittest(overload_rawbyptrref(k), "rawbyptrref")
 
     unittest(overload_smartbyval(k), "smartbyval")
     unittest(overload_smartbyref(k), "smartbyref")
     unittest(overload_smartbyptr(k), "smartbyptr")
-    # unittest(overload_smartbyptrref(k), "smartbyptrref") --> undefined for _p_SwigBoost__shared_ptrT_Space__Klass3rdDerived_t
+    unittest(overload_smartbyptrref(k), "smartbyptrref")
   }
 
   #
@@ -573,7 +573,7 @@ testSuite <- function() {
     kglobal = GlobalValue_get();
     val = kglobal$getValue();
     unittest("global value", val);
-    # testSuite_verifyCount(1, kglobal); # -> use_count undefined for _p_Space__Klass
+    testSuite_verifyCount(1, kglobal);
     testSuite_verifyCount(1, k);
     unittest("global value", GlobalValue_get()$getValue());
 
@@ -600,7 +600,7 @@ testSuite <- function() {
     kglobal = GlobalPointer_get();
     val = kglobal$getValue();
     unittest("global pointer", val);
-    # testSuite_verifyCount(1, kglobal); -> use_count undefined for _p_Space__Klass
+    testSuite_verifyCount(1, kglobal);
     testSuite_verifyCount(1, k);
     GlobalPointer_set(NULL);
   }
@@ -614,7 +614,7 @@ testSuite <- function() {
     kglobal = GlobalReference_get();
     val = kglobal$getValue();
     unittest("global reference", val);
-    # testSuite_verifyCount(1, kglobal); # -> use_count undefined for _p_Space__Klass
+    testSuite_verifyCount(1, kglobal);
     testSuite_verifyCount(1, k);
 
     bNotCatched = F
@@ -652,16 +652,16 @@ for (i in 1:10) {
 
 # wait for the GC to collect unused objects
 
-for (i in 1:10) {
-  invisible(gc(verbose = F, full = T))
-
-  if (Klass_getTotal_count() == 1) {
-    break
-  }
-
-  print(paste("Still waiting for GC to collect ", Klass_getTotal_count()-1, " objects, ", i))
-  Sys.sleep(1)
-}
+#for (i in 1:10) {
+#  invisible(gc(verbose = F, full = T))
+#
+#  if (Klass_getTotal_count() == 1) {
+#    break
+#  }
+#
+#  print(paste("Still waiting for GC to collect ", Klass_getTotal_count()-1, " objects, ", i))
+#  Sys.sleep(1)
+#}
 
 # Expect
 unittest(shared_ptr_wrapper_count(), NOT_COUNTING())
diff --git a/Lib/r/boost_shared_ptr.i b/Lib/r/boost_shared_ptr.i
index 87c89b5f9..13f041fbb 100644
--- a/Lib/r/boost_shared_ptr.i
+++ b/Lib/r/boost_shared_ptr.i
@@ -394,6 +394,25 @@
 #error "typemaps for $1_type not available"
 %}
 
+%typemap(rtype)      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 > *&
+  "$typemap(rtype, TYPE)"
+
+%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 > *,
+                     SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE > *&
+ %{ if (inherits($input, "ExternalReference")) $input = slot($input,"ref"); %}
+
+%typemap(scoerceout) 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 > *&
+  %{ $result <- if (is.null($result)) $result
+  else new("$typemap(rtype, TYPE)", ref=$result); %}
+
 
 %template() SWIG_SHARED_PTR_QNAMESPACE::shared_ptr< CONST TYPE >;
 
diff --git a/Source/Modules/r.cxx b/Source/Modules/r.cxx
index 3d9cab0d4..e1fd422dd 100644
--- a/Source/Modules/r.cxx
+++ b/Source/Modules/r.cxx
@@ -2088,21 +2088,6 @@ int R::functionWrapper(Node *n) {
   /*If the user gave us something to convert the result in  */
   if ((tm = Swig_typemap_lookup("scoerceout", n, Swig_cresult_name(), sfun))) {
     Replaceall(tm,"$result","ans");
-    if (constructor) {
-      Node * parent = Getattr(n, "parentNode");
-      String * smartname = Getattr(parent, "feature:smartptr");
-      if (smartname) { // SmartName handling - has to be aligned to the other implementation in this file
-        SwigType *spt = Swig_cparse_type(smartname);
-        String *smart = SwigType_typedef_resolve_all(spt);
-        String *smart_rname = SwigType_manglestr(smart);
-        String *smart_rname_p = NewStringf("_p%s", smart_rname);
-        Replaceall(tm, "$R_class", smart_rname_p);
-        Delete(spt);
-        Delete(smart);
-        Delete(smart_rname);
-        Delete(smart_rname_p);
-      }
-    }
     if (debugMode) {
       Printf(stdout, "Calling replace B: %s, %s, %s\n", Getattr(n, "type"), Getattr(n, "sym:name"), getNSpace());
     }
@@ -2328,31 +2313,6 @@ void R::registerClass(Node *n) {
 
     Printf(s_classes, "setClass('%s', contains = %s)\n", sname, base);
     Delete(base);
-    String *smartptr = Getattr(n, "feature:smartptr");
-    if (smartptr) {// SmartName handling - has to be aligned to the other implementation in this file
-      List *l = Getattr(n, "bases");
-      SwigType *spt = Swig_cparse_type(smartptr);
-      String *smart = SwigType_typedef_resolve_all(spt);
-      String *smart_rname = SwigType_manglestr(smart);
-      Printf(s_classes, "setClass('_p%s', contains = c('%s'", smart_rname, sname);
-      Delete(spt);
-      Delete(smart);
-      Delete(smart_rname);
-      for(int i = 0; i < Len(l); i++) {
-	Node * b = Getitem(l, i);
-	smartptr = Getattr(b, "feature:smartptr");
-	if (smartptr) {
-	  spt = Swig_cparse_type(smartptr);
-	  smart = SwigType_typedef_resolve_all(spt);
-	  smart_rname = SwigType_manglestr(smart);
-	  Printf(s_classes, ", '_p%s'", smart_rname);
-	  Delete(spt);
-	  Delete(smart);
-	  Delete(smart_rname);
-	}
-      }
-      Printf(s_classes, "))\n");
-    }
   }
 }