Merge branch 'master' into bugfix/module-boot-exceptions

Author: eddelbuettel

.github/workflows/macos.yaml

@@ -15,7 +15,6 @@ jobs:
       matrix:
         include:
           - {os: macos-latest}
-          - {os: macos-14}
           #- {os: ubuntu-latest}
           #- {os: ubuntu-24.04-arm}
 

ChangeLog

@@ -1,5 +1,46 @@
+2026-10-31  Dirk Eddelbuettel  <edd@debian.org>
+
+	* .github/workflows/macos.yaml (jobs): Retire macos-14 (but retain
+	macos-latest)
+
 2026-10-29  Kevin Ushey <kevinushey@gmail.com>
 
+	* inst/include/Rcpp/module/Module_Add_Property.h: Return *this from
+	the property() overload taking a free-function getter and a member
+	function setter, which fell off the end and trapped at module load
+	(#1519)
+	* inst/tinytest/cpp/Module.cpp: Expose one property per property()
+	overload
+	* inst/tinytest/test_module.R: Test them
+
+	* src/module.cpp (InternalFunction_invoke): Raise an error when fewer
+	arguments are supplied than the arity stored in the function pointer's
+	tag, instead of reading the missing ones from uninitialized memory
+	(#1521)
+	* inst/include/Rcpp/module/Module.h (Module::get_function): Store the
+	arity of module functions in the pointer tag
+	* inst/include/Rcpp/InternalFunction.h: Idem for InternalFunction
+	* inst/tinytest/cpp/Module.cpp: Add module functions with formals
+	* inst/tinytest/test_module.R: Test calls with too few arguments
+	* inst/tinytest/test_internal_function.R: Idem
+	* inst/tinytest/test_internal_function_cpp11.R: Idem
+
+	* R/00_classes.R (.cppfunction_formals_gets): Find the .External() call
+	in the body of the function instead of assuming it is the second
+	element, which it is not once coverage tools have instrumented the body
+	* R/00_classes.R (.cppfunction_set_external_args): New helper
+	* inst/tinytest/test_module.R: Test it with an instrumented body
+	* 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
+
 	* inst/include/Rcpp/Module.h (RCPP_MODULE): Wrap the module boot
 	function in BEGIN_RCPP / END_RCPP so that an exception thrown while the
 	module initializes raises an R error instead of terminating the session
@@ -16,6 +57,15 @@
 	* DESCRIPTION (Version, Date): Roll micro version and date
 	* inst/include/Rcpp/config.h: Idem
 
+2026-10-22  Kevin Ushey  <kevinushey@gmail.com>
+
+	* src/module.cpp (CppObject__finalize): Make finalize() a no-op for a
+	module object that was never constructed (created without arguments for a
+	class without a default constructor); it used to fail on the dummy
+	pointer, and the failure surfaced as an error message at garbage
+	collection
+	* inst/tinytest/test_module.R: Add test
+
 2026-10-22  Michael Sumner <mdsumner@gmail.com>
 
 	* R/00_classes.R: Define C++Field, C++OverloadedMethods and

R/00_classes.R

@@ -117,13 +117,23 @@ setClass( "C++Function",
 	contains = "function"
 )
 
-.cppfunction_formals_gets <- function (fun, envir = environment(fun), value) {
-    bd <- body(fun)
-    b2 <- bd[[2L]]
-    for( i in seq_along(value) ){
-        b2[[3L+i]] <- as.name( names(value)[i] )
+## passes the arguments named in 'names' on from the .External(entry,
+## pointer, ...) call in expr; the call is searched for rather than assumed
+## to be a top-level statement, as coverage tools wrap each statement
+.cppfunction_set_external_args <- function( expr, names ){
+    if( !is.call( expr ) )
+        return( expr )
+    if( identical( expr[[1L]], as.name( ".External" ) ) )
+        return( as.call( c( as.list( expr )[1:3], lapply( names, as.name ) ) ) )
+    for( i in seq_along( expr )[-1L] ){
+        if( is.call( expr[[i]] ) )
+            expr[[i]] <- .cppfunction_set_external_args( expr[[i]], names )
     }
-    bd[[2]] <- b2
+    expr
+}
+
+.cppfunction_formals_gets <- function (fun, envir = environment(fun), value) {
+    bd <- .cppfunction_set_external_args( body(fun), names(value) )
     f <- fun@.Data
     formals(f) <- value
     body(f) <- bd

inst/include/Rcpp/InternalFunction.h

@@ -35,18 +35,24 @@ namespace Rcpp{
 
         RCPP_GENERATE_CTOR_ASSIGN(InternalFunction_Impl)
 
+        // the arity goes in the pointer tag, where InternalFunction_invoke
+        // checks it against the number of supplied arguments
+
         template <typename RESULT_TYPE, typename... Args>
         InternalFunction_Impl(const std::function<RESULT_TYPE(Args...)> &fun) {
+            Shield<SEXP> arity(Rf_ScalarInteger(static_cast<int>(sizeof...(Args))));
             set(
                 XPtr<Rcpp::InternalFunctionWithStdFunction::CppFunctionBaseFromStdFunction<RESULT_TYPE, Args...> >(
                     new Rcpp::InternalFunctionWithStdFunction::CppFunctionBaseFromStdFunction<RESULT_TYPE, Args...>(fun),
-                    false
+                    false,
+                    arity
                     )
                 );
         }
         template <typename RESULT_TYPE, typename... T>
         InternalFunction_Impl(RESULT_TYPE (*fun)(T...)) {
-            set(XPtr<CppFunctionN<RESULT_TYPE, T...> >(new CppFunctionN<RESULT_TYPE, T...>(fun), true));
+            Shield<SEXP> arity(Rf_ScalarInteger(static_cast<int>(sizeof...(T))));
+            set(XPtr<CppFunctionN<RESULT_TYPE, T...> >(new CppFunctionN<RESULT_TYPE, T...>(fun), true, arity));
         }
 
         void update(SEXP){}

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<class_Base*> todo(1, cl) ;
+        std::set<class_Base*> 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<class_Base*>( R_ExternalPtrAddr(cppclass) ) ;
+
+        SEXP module_xp = env.get(".module") ;
+        Module* module = NULL ;
+        if( TYPEOF(module_xp) == EXTPTRSXP )
+            module = reinterpret_cast<Module*>( 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 ;
     }
 
 }

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 <typename T> object<T> as_module_object(SEXP x) {
-            return (T*) as_module_object_internal(x);
+            return (T*) as_module_object_internal(x, typeid(T).name());
         }
 
         /** handling object<T> */
         template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_const_pointer_tag) {
             typedef typename Rcpp::traits::remove_const<T>::type T_NON_CONST;
-            return const_cast<T>((T_NON_CONST)as_module_object_internal(x));
+            typedef typename Rcpp::traits::un_pointer<T>::type CLASS;
+            return const_cast<T>((T_NON_CONST)as_module_object_internal(x, typeid(CLASS).name()));
         }
 
         template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_pointer_tag) {

inst/include/Rcpp/module/Module.h

@@ -164,8 +164,12 @@ namespace Rcpp {
             }
             std::string sign ;
             fun->signature( sign, name_.data() ) ;
+
+            // checked against the number of supplied arguments by InternalFunction_invoke
+            Shield<SEXP> arity( Rf_ScalarInteger( fun->nargs() ) ) ;
+
             return List::create(
-                XPtr<CppFunction>( fun, false ),
+                XPtr<CppFunction>( fun, false, arity ),
                 fun->is_void(),
                 fun->docstring,
                 sign,

inst/include/Rcpp/module/Module_Add_Property.h

@@ -83,6 +83,7 @@
 			name_,
 			new CppProperty_GetPointer_SetMethod<Class,PROP>(GetMethod, SetMethod, docstring)
 		) ;
+		return *this ;
 	}
 
 	template <typename PROP>

inst/tinytest/cpp/Module.cpp

@@ -89,6 +89,24 @@ class ModuleNum{
     int y;
 };
 
+class ModuleProperties {
+public:
+    ModuleProperties() : value(0.0) {}
+
+    double get() { return value; }
+    double get_const() const { return value; }
+    void set(double value_) { value = value_; }
+
+    double value;
+};
+
+double ModuleProperties_get(ModuleProperties* p) {
+    return p->value;
+}
+void ModuleProperties_set(ModuleProperties* p, double value) {
+    p->value = value;
+}
+
 class ModuleNumber{
 public:
     ModuleNumber() : x(0.0), y(0) {};
@@ -137,6 +155,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() {}
@@ -166,6 +202,10 @@ RCPP_MODULE(demoModule) {
     function("bla1" , &bla1 );
     function("bla2" , &bla2 );
 
+    // formals with defaults, and formals shorter than the parameter list
+    function("foo_formals", &foo, List::create(_["x"] = 2, _["y"] = 10.0));
+    function("foo_short_formals", &foo, List::create(_["x"] = 2));
+
     function("test_reference", test_reference);
     function("test_const_reference", test_const_reference);
     function("test_const", test_const);
@@ -193,6 +233,21 @@ RCPP_MODULE(demoModule) {
         .property("y", &ModuleNum::getY)
         ;
 
+    // one property per class_::property() overload: getters are member,
+    // const member or free functions, setters are member or free functions
+    class_<ModuleProperties>("ModuleProperties")
+        .constructor()
+        .property("get", &ModuleProperties::get)
+        .property("get_const", &ModuleProperties::get_const)
+        .property("get_free", &ModuleProperties_get, "free getter")
+        .property("get_set", &ModuleProperties::get, &ModuleProperties::set)
+        .property("get_const_set", &ModuleProperties::get_const, &ModuleProperties::set)
+        .property("get_set_free", &ModuleProperties::get, &ModuleProperties_set)
+        .property("get_const_set_free", &ModuleProperties::get_const, &ModuleProperties_set)
+        .property("get_free_set", &ModuleProperties_get, &ModuleProperties::set)
+        .property("get_free_set_free", &ModuleProperties_get, &ModuleProperties_set)
+        ;
+
     class_<ModuleNumber>("ModuleNumber")
 
         .constructor()
@@ -217,6 +272,17 @@ RCPP_MODULE(demoModule) {
         .method("get" , &ModuleRandomizer::get)
         ;
 
+    class_<ModuleBase>("ModuleBase")
+        .constructor()
+        ;
+
+    class_<ModuleDerived>("ModuleDerived")
+        .derives<ModuleBase>("ModuleBase")
+        .constructor()
+        ;
+
+    function("ModuleBase_value", &ModuleBase_value);
+
     class_<ModuleGadget>("ModuleGadget")
         .constructor()
         .method("value", static_cast<void (ModuleGadget::*)(int)>(&ModuleGadget::value))

inst/tinytest/test_internal_function.R

@@ -24,6 +24,10 @@ Rcpp::sourceCpp("cpp/InternalFunction.cpp")
 fun <- getAdd()
 expect_equal( fun(10,32), 42 )
 
+## too few arguments raise an error rather than reading the missing ones
+## from uninitialized memory (#1521)
+expect_error( fun(10), "expecting 2, got 1" )
+
 #    test.internal_function_concatenate <- function(){
 fun <- getConcatenate()
 expect_equal( fun("Hello"," World"), "Hello World" )