wrap returned module objects as the class of the library that returned them (#1532)

* wrap returned module objects as the class of the library that returned them

* Microedit

---------

Co-authored-by: Dirk Eddelbuettel <edd@debian.org>

Author: kevinushey

ChangeLog

@@ -66,6 +66,23 @@
 	* inst/tinytest/cpp/Module.cpp (Module_scope_is_cleared): New
 	* inst/tinytest/test_module.R: Test loading the failing module
 
+	* inst/include/Rcpp/Module.h (internal::module_class_pointer): New
+	per-library record of the class_<Class> registered for a C++ type
+	* inst/include/Rcpp/Module.h (internal::make_new_object): Pass it to
+	the new cpp_object_maker_by_class(), so that objects returned from C++
+	are wrapped as the module class of the library that returned them
+	rather than as another library's class of the same name (#1531)
+	* inst/include/Rcpp/module/class.h (class_::get_instance): Record the
+	class
+	* R/Module.R (cpp_object_maker_by_class): New, looking the class up by
+	its pointer and creating the object through the class's generator
+	* R/Module.R (Module): Register classes by pointer as well
+	* R/zzz.R: Add .classes_by_pointer
+	* inst/tinytest/testRcppCollisionA: New test package
+	* inst/tinytest/testRcppCollisionB: Idem
+	* inst/tinytest/test_module_class_collision.R: Test objects returned
+	by both
+
 2026-10-23  Dirk Eddelbuettel  <edd@debian.org>
 
 	* DESCRIPTION (Version, Date): Roll micro version and date

R/Module.R

@@ -161,6 +161,17 @@ cpp_object_maker <- function(typeid, pointer){
     new( Class, .object_pointer = pointer )
 }
 
+# called by make_new_object() with the module class that the calling library
+# registered for this C++ type, since other libraries' unrelated classes of
+# the same name share its typeid; the object is created through that class's
+# generator, as new() would look the reference class up by name
+cpp_object_maker_by_class <- function(typeid, pointer, class_pointer){
+    Class <- .classes_by_pointer[[ externalptr_address(class_pointer) ]]
+    if( is.null( Class ) )
+        return( cpp_object_maker( typeid, pointer ) )
+    Class@generator$new( .object_pointer = pointer )
+}
+
 Module <- function( module, PACKAGE = methods::getPackageName(where), where = topenv(parent.frame()), mustStart = FALSE ) {
     if (inherits(module, "DLLInfo") && missing(mustStart)) mustStart <- TRUE						# #nocov
     if (inherits(module, "Module")) {
@@ -287,6 +298,7 @@ Module <- function( module, PACKAGE = methods::getPackageName(where), where = to
         # rather than rebuilding it (and all of its method/field objects)
         CLASS@generator <- generators[[ clname ]]
         .classes_map[[ CLASS@typeid ]] <- storage[[ demangled_name ]] <- CLASS
+        .classes_by_pointer[[ externalptr_address( CLASS@pointer ) ]] <- CLASS
 
         # exposing enums values as CLASS.VALUE
         # (should really be CLASS$value but I don't know how to do it)

R/zzz.R

@@ -18,6 +18,7 @@
 .dummyInstancePointer <- new.env() # just something permanent
 
 .classes_map <- new.env()
+.classes_by_pointer <- new.env()
 
 .onLoad <- function(libname, pkgname){
     new_dummyObject(.dummyInstancePointer)   						# nocov start

inst/include/Rcpp/Module.h

@@ -73,10 +73,33 @@ namespace Rcpp{
     } ;
 
     namespace internal {
+
+        // the class_<Class> this shared library registered in a module, if
+        // any. Unrelated classes of the same name in other libraries share
+        // the typeid name, so make_new_object() passes this on for R to pick
+        // the right module class; hidden visibility keeps one per library,
+        // where the dynamic linker would otherwise share it between them
+        template <typename Class>
+        inline attribute_hidden void*& module_class_pointer(){
+            static void* pointer = 0 ;
+            return pointer ;
+        }
+
         template <typename Class>
         SEXP make_new_object( Class* ptr ){
             Rcpp::XPtr<Class> xp( ptr, true ) ;
-            Function maker = Environment::Rcpp_namespace()[ "cpp_object_maker"] ;
+            Environment rcpp = Environment::Rcpp_namespace() ;
+
+            // older versions of Rcpp only have cpp_object_maker()
+            void* class_pointer = module_class_pointer<Class>() ;
+            SEXP maker_by_class = rcpp.get( "cpp_object_maker_by_class" ) ;
+            if( class_pointer != 0 && maker_by_class != R_NilValue ){
+                Shield<SEXP> class_xp( R_MakeExternalPtr( class_pointer, R_NilValue, R_NilValue ) ) ;
+                Function maker( maker_by_class ) ;
+                return maker( typeid(Class).name(), xp, class_xp ) ;
+            }
+
+            Function maker = rcpp[ "cpp_object_maker" ] ;
             return maker( typeid(Class).name() , xp ) ;
         }
     }

inst/include/Rcpp/module/class.h

@@ -89,6 +89,10 @@
                 RCPP_DEBUG_MODULE_2( "class_<%s>::get_instance(). [freshly created] class_pointer = class_pointer\n", DEMANGLE(Class), class_pointer ) ;
 
             }
+
+            // lets objects returned from C++ find this module class
+            internal::module_class_pointer<Class>() = static_cast<class_Base*>( class_pointer ) ;
+
             return class_pointer ;
         }
 

inst/tinytest/testRcppCollisionA/DESCRIPTION

@@ -0,0 +1,11 @@
+Package: testRcppCollisionA
+Type: Package
+Title: Module Class Name Collision Test A
+Version: 0.1
+Author: Kevin Ushey
+Maintainer: Kevin Ushey <kevinushey@gmail.com>
+Description: Exposes a module class whose name is also used by an unrelated
+ class in package testRcppCollisionB, for the Rcpp tests.
+License: GPL (>= 2)
+Imports: methods, Rcpp
+LinkingTo: Rcpp

inst/tinytest/testRcppCollisionA/NAMESPACE

@@ -0,0 +1,3 @@
+useDynLib(testRcppCollisionA)
+import(methods, Rcpp)
+export(Collision, make_collision)

inst/tinytest/testRcppCollisionA/R/zzz.R

@@ -0,0 +1 @@
+loadModule("collision_module", TRUE)

inst/tinytest/testRcppCollisionA/src/module.cpp

@@ -0,0 +1,27 @@
+#include <Rcpp.h>
+
+using namespace Rcpp;
+
+// unrelated to testRcppCollisionB's Collision, but of the same name, and so
+// with the same typeid name
+class Collision {
+public:
+    Collision(double x_) : x(x_) {}
+    double get() { return x; }
+    double x;
+};
+
+RCPP_EXPOSED_CLASS_NODECL(Collision)
+
+Collision make_collision(double x) {
+    return Collision(x);
+}
+
+RCPP_MODULE(collision_module) {
+    class_<Collision>("Collision")
+        .constructor<double>()
+        .method("get", &Collision::get)
+        ;
+
+    function("make_collision", &make_collision);
+}

inst/tinytest/testRcppCollisionB/DESCRIPTION

@@ -0,0 +1,11 @@
+Package: testRcppCollisionB
+Type: Package
+Title: Module Class Name Collision Test B
+Version: 0.1
+Author: Kevin Ushey
+Maintainer: Kevin Ushey <kevinushey@gmail.com>
+Description: Exposes a module class whose name is also used by an unrelated
+ class in package testRcppCollisionA, for the Rcpp tests.
+License: GPL (>= 2)
+Imports: methods, Rcpp
+LinkingTo: Rcpp