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

ChangeLog

@@ -1,3 +1,22 @@
+2026-10-29  Kevin Ushey <kevinushey@gmail.com>
+
+	* 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

inst/tinytest/testRcppCollisionB/NAMESPACE

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

inst/tinytest/testRcppCollisionB/R/zzz.R

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

inst/tinytest/testRcppCollisionB/src/module.cpp

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

inst/tinytest/test_module_class_collision.R

@@ -0,0 +1,45 @@
+
+##  Copyright (C) 2026  Kevin Ushey
+##
+##  This file is part of Rcpp.
+##
+##  Rcpp is free software: you can redistribute it and/or modify it
+##  under the terms of the GNU General Public License as published by
+##  the Free Software Foundation, either version 2 of the License, or
+##  (at your option) any later version.
+##
+##  Rcpp is distributed in the hope that it will be useful, but
+##  WITHOUT ANY WARRANTY; without even the implied warranty of
+##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+##  GNU General Public License for more details.
+##
+##  You should have received a copy of the GNU General Public License
+##  along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
+
+## as in test_module_client_package.R
+.onWindows <- .Platform$OS.type == "windows"
+if (.onWindows) exit_file("Skipping on Windows.")
+
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes" && Sys.getenv("RunVerboseRcppTests") == "yes"
+if (! .runThisTest) exit_file("Set 'RunVerboseRcppTests' and 'RunAllRcppTests' to 'yes' to run.")
+
+## testRcppCollisionA and testRcppCollisionB expose unrelated C++ classes
+## that are both named Collision, and so have the same typeid name; objects
+## returned from C++ must be wrapped as the class of the package that
+## returned them (#1531)
+
+td <- tempfile()
+cwd <- getwd()
+dir.create( td )
+pkgs <- c( "testRcppCollisionA", "testRcppCollisionB" )
+for( pkg in pkgs )
+    file.copy( system.file( "tinytest", pkg, package = "Rcpp" ), td, recursive = TRUE )
+setwd( td )
+dir.create( "templib" )
+install.packages( pkgs, "templib", repos = NULL, type = "source" )
+suppressMessages( for( pkg in pkgs ) require( pkg, "templib", character.only = TRUE ) )
+
+expect_equal( testRcppCollisionA::make_collision( 42 )$get(), 42 )
+expect_equal( testRcppCollisionB::make_collision()$get(), c( 1, 1, 1 ) )
+
+on.exit( { setwd( cwd ) ; unlink( td, recursive = TRUE ) } )