diff --git a/ChangeLog b/ChangeLog index 402732946..3d8069850 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,16 @@ +2026-10-29 Kevin Ushey + + * inst/include/Rcpp/api/meat/as.h (as_module_object_internal): Check + that the argument is a live module object, raising an error for + deserialized, uninitialized and non-module objects instead of handing + out a NULL or garbage address; a new overload taking the expected C++ + type also requires the object's class to be that type or one that + derives() from it (#1523) + * inst/include/Rcpp/as.h: Use the new overload when converting to + module classes + * inst/tinytest/cpp/Module.cpp: Add a class deriving from another + * inst/tinytest/test_module.R: Test the new checks + 2026-10-23 Dirk Eddelbuettel * DESCRIPTION (Version, Date): Roll micro version and date diff --git a/inst/include/Rcpp/api/meat/as.h b/inst/include/Rcpp/api/meat/as.h index 53f31b1c0..0f61f9ad4 100644 --- a/inst/include/Rcpp/api/meat/as.h +++ b/inst/include/Rcpp/api/meat/as.h @@ -21,10 +21,100 @@ namespace Rcpp{ namespace internal{ + // the address of the C++ object held by the module object whose + // environment is env (see cpp_object_initializer() in R/Module.R) + inline void* module_object_address(const Environment& env){ + SEXP xp = env.get(".pointer") ; + if( xp == R_NilValue ) + throw not_compatible( "Expecting a C++ module object" ) ; + + // the dummy object of a class without a default constructor + if( TYPEOF(xp) != EXTPTRSXP ) + throw not_initialized() ; + + // e.g. a deserialized object + void* ptr = R_ExternalPtrAddr(xp) ; + if( ptr == NULL ) + throw ::Rcpp::exception( "external pointer is not valid" ) ; + + return ptr ; + } + +#ifndef RCPP_NO_MODULES + // whether the module class cl is the C++ class typeinfo_name, or derives + // from it through class_::derives(), which records each parent by its R + // class name, "Rcpp_" followed by its name in the module + inline bool module_class_is( class_Base* cl, Module* module, const char* typeinfo_name ){ + if( cl->has_typeinfo_name(typeinfo_name) ) + return true ; + + std::vector todo(1, cl) ; + std::set seen ; + while( module && !todo.empty() ){ + class_Base* current = todo.back() ; + todo.pop_back() ; + if( !seen.insert(current).second ) + continue ; + + if( current->has_typeinfo_name(typeinfo_name) ) + return true ; + + for( size_t i = 0; i < current->parents.size(); i++ ){ + const std::string& parent = current->parents[i] ; + if( parent.compare(0, 5, "Rcpp_") != 0 ) + continue ; + std::string name = parent.substr(5) ; + if( module->has_class(name) ) + todo.push_back( module->get_class_pointer(name) ) ; + } + } + return false ; + } +#endif + + // packages call this one directly, so it stays; it cannot check the class inline void* as_module_object_internal(SEXP obj){ + if( !Rf_isS4(obj) ) + throw not_compatible( "Expecting a C++ module object" ) ; Environment env(obj) ; - SEXP xp = env.get(".pointer") ; - return R_ExternalPtrAddr(xp ); + return module_object_address(env) ; + } + + inline void* as_module_object_internal(SEXP obj, const char* typeinfo_name){ + if( !Rf_isS4(obj) ){ + throw not_compatible( + "Expecting an object of C++ class '%s'", + demangle(typeinfo_name) + ) ; + } + Environment env(obj) ; + void* ptr = module_object_address(env) ; + +#ifndef RCPP_NO_MODULES + SEXP cppclass = env.get(".cppclass") ; + if( TYPEOF(cppclass) != EXTPTRSXP || R_ExternalPtrAddr(cppclass) == NULL ){ + throw not_compatible( + "Expecting an object of C++ class '%s'", + demangle(typeinfo_name) + ) ; + } + class_Base* cl = reinterpret_cast( R_ExternalPtrAddr(cppclass) ) ; + + SEXP module_xp = env.get(".module") ; + Module* module = NULL ; + if( TYPEOF(module_xp) == EXTPTRSXP ) + module = reinterpret_cast( R_ExternalPtrAddr(module_xp) ) ; + + if( !module_class_is(cl, module, typeinfo_name) ){ + throw not_compatible( + "Expecting an object of C++ class '%s', got an object of class '%s'", + demangle(typeinfo_name), + cl->name + ) ; + } +#endif + + return ptr ; } } diff --git a/inst/include/Rcpp/as.h b/inst/include/Rcpp/as.h index e6990312c..78e189804 100644 --- a/inst/include/Rcpp/as.h +++ b/inst/include/Rcpp/as.h @@ -89,15 +89,17 @@ namespace Rcpp { } void* as_module_object_internal(SEXP obj); + void* as_module_object_internal(SEXP obj, const char* typeinfo_name); template object as_module_object(SEXP x) { - return (T*) as_module_object_internal(x); + return (T*) as_module_object_internal(x, typeid(T).name()); } /** handling object */ template T as(SEXP x, ::Rcpp::traits::r_type_module_object_const_pointer_tag) { typedef typename Rcpp::traits::remove_const::type T_NON_CONST; - return const_cast((T_NON_CONST)as_module_object_internal(x)); + typedef typename Rcpp::traits::un_pointer::type CLASS; + return const_cast((T_NON_CONST)as_module_object_internal(x, typeid(CLASS).name())); } template T as(SEXP x, ::Rcpp::traits::r_type_module_object_pointer_tag) { diff --git a/inst/tinytest/cpp/Module.cpp b/inst/tinytest/cpp/Module.cpp index 7f3132820..e9340cda6 100644 --- a/inst/tinytest/cpp/Module.cpp +++ b/inst/tinytest/cpp/Module.cpp @@ -137,6 +137,24 @@ double Test_get_x_pointer(ModuleTest* x) { return x->value; } +class ModuleBase { +public: + ModuleBase() : value(1.0) {} + virtual ~ModuleBase() {} + double value; +}; + +class ModuleDerived : public ModuleBase { +public: + ModuleDerived() { value = 2.0; } +}; + +RCPP_EXPOSED_CLASS_NODECL(ModuleBase) + +double ModuleBase_value(const ModuleBase& x) { + return x.value; +} + class ModuleGadget { public: ModuleGadget() {} @@ -217,6 +235,17 @@ RCPP_MODULE(demoModule) { .method("get" , &ModuleRandomizer::get) ; + class_("ModuleBase") + .constructor() + ; + + class_("ModuleDerived") + .derives("ModuleBase") + .constructor() + ; + + function("ModuleBase_value", &ModuleBase_value); + class_("ModuleGadget") .constructor() .method("value", static_cast(&ModuleGadget::value)) diff --git a/inst/tinytest/test_module.R b/inst/tinytest/test_module.R index db0edfc60..7c63b029d 100644 --- a/inst/tinytest/test_module.R +++ b/inst/tinytest/test_module.R @@ -75,6 +75,24 @@ expect_equal( attr_Test_get_x_const_pointer(test), 3.0 ) expect_equal( attr_Test_get_x_ref(test), 3.0 ) expect_equal( attr_Test_get_x_pointer(test), 3.0 ) +## module object arguments are validated before their address is handed to +## C++, instead of reinterpreting or dereferencing whatever is there (#1523); +## patterns are regular expressions, as tinytest < 1.3.1 has no 'fixed' +expect_error( Test_get_x_const_ref( new( ModuleWorld ) ), + "Expecting an object of C\\+\\+ class 'ModuleTest', got an object of class 'ModuleWorld'" ) +expect_error( attr_Test_get_x_ref( new( ModuleWorld ) ), + "got an object of class 'ModuleWorld'" ) +expect_error( Test_get_x_pointer( unserialize( serialize( test, NULL ) ) ), + "external pointer is not valid" ) +uninitialized <- new( ModuleTest ) +expect_error( Test_get_x_ref( uninitialized ), "not initialized" ) +expect_error( Test_get_x_const_pointer( 1 ), + "Expecting an object of C\\+\\+ class 'ModuleTest'" ) + +## objects of a class that derives() from the expected one are accepted +expect_equal( ModuleBase_value( new( ModuleBase ) ), 1.0 ) +expect_equal( ModuleBase_value( new( ModuleDerived ) ), 2.0 ) + # test.Module.property <- function(){ w <- new( ModuleNum ) expect_equal( w$x, 0.0 )