Merge branch 'master' into fix/macos_ci

Author: eddelbuettel

ChangeLog

@@ -1,13 +1,51 @@
+
 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
+
 2026-10-23  Dirk Eddelbuettel  <edd@debian.org>
 
 	* 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/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) {};
@@ -166,6 +184,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 +215,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()

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" )

inst/tinytest/test_internal_function_cpp11.R

@@ -29,3 +29,7 @@ expect_equal( fun(38), 42 )
 #    test.internal_function_concatenate <- function(){
 fun <- getConcatenate()
 expect_equal( fun("Hello"," World"), "Hello World" )
+
+## too few arguments raise an error rather than reading the missing ones
+## from uninitialized memory (#1521)
+expect_error( fun("Hello"), "expecting 2, got 1" )

inst/tinytest/test_module.R

@@ -41,6 +41,21 @@ expect_true(is_void(bla@.Data))
 expect_true(is_void(bla1@.Data))
 expect_true(is_void(bla2@.Data))
 
+## module functions must be called with at least as many arguments as
+## the C++ function takes, rather than reading the missing ones from
+## uninitialized memory (#1521)
+expect_error( foo( 2L ), "expecting 2, got 1" )
+expect_error( bar(), "expecting 1, got 0" )
+expect_equal( foo_formals(), 20.0 )
+expect_equal( foo_formals( y = 3.0 ), 6.0 )
+expect_error( foo_short_formals(), "expecting 2, got 1" )
+
+## formals<- finds the .External() call wherever it is in the body, e.g.
+## inside the block that coverage tools (covr) wrap each statement in
+wrapped <- quote({ if (TRUE) { covr:::count("key"); .External(entry, pointer, ...) } })
+expect_equal( deparse( Rcpp:::.cppfunction_set_external_args( wrapped, c("x", "y") ) ),
+              deparse( quote({ if (TRUE) { covr:::count("key"); .External(entry, pointer, x, y) } }) ) )
+
 w <- new( ModuleWorld )
 expect_equal( w$greet(), "hello" )
 w$set( "hello world" )
@@ -85,6 +100,27 @@ expect_equal( w$x, 2.0 )
 
 expect_error( { w$y <- 3 } )
 
+## every class_::property() overload; the free getter + member setter one
+## did not return *this, which aborted loading the whole module (#1519)
+p <- new( ModuleProperties )
+p$get_set <- 1.0
+expect_equal( p$get_set, 1.0 )
+p$get_const_set <- 2.0
+expect_equal( p$get_const_set, 2.0 )
+p$get_set_free <- 3.0
+expect_equal( p$get_set_free, 3.0 )
+p$get_const_set_free <- 4.0
+expect_equal( p$get_const_set_free, 4.0 )
+p$get_free_set <- 5.0
+expect_equal( p$get_free_set, 5.0 )
+p$get_free_set_free <- 6.0
+expect_equal( p$get_free_set_free, 6.0 )
+
+expect_equal( c(p$get, p$get_const, p$get_free), c(6.0, 6.0, 6.0) )
+expect_error( { p$get <- 7.0 } )
+expect_error( { p$get_const <- 7.0 } )
+expect_error( { p$get_free <- 7.0 } )
+
 #    test.Module.member <- function(){
 w <- new( ModuleNumber )
 expect_equal( w$x, 0.0 )
@@ -123,3 +159,10 @@ gctorture(TRUE)
 res <- gadget$value()
 gctorture(FALSE)
 expect_identical( res, c(1, 2, 3) )
+
+#    test.Module.finalize.dummy <- function(){
+## an object created without arguments for a class lacking a default
+## constructor holds the dummy pointer; finalizing it must be a no-op
+## rather than an error (which used to surface at garbage collection)
+r <- new( ModuleRandomizer )
+expect_identical( r$finalize(), NULL )

src/module.cpp

@@ -108,7 +108,14 @@ RCPP_FUN_4(SEXP, CppField__set, XP_Class cl, SEXP field_xp, SEXP obj, SEXP value
     cl->setProperty(field_xp, obj, value);
     return R_NilValue;
 }
+
+extern SEXP rcpp_dummy_pointer;
+
 RCPP_FUN_2(SEXP, CppObject__finalize, XP_Class cl, SEXP obj) {
+    // an object created without arguments for a class lacking a default
+    // constructor holds the dummy pointer: there is nothing to finalize
+    if (obj == rcpp_dummy_pointer)
+        return R_NilValue;
     cl->run_finalizer(obj);
     return R_NilValue;
 }
@@ -119,6 +126,18 @@ BEGIN_RCPP
     SEXP p = CDR(args);
     XP_Function fun(CAR(p)); p = CDR(p);
     UNPACK_EXTERNAL_ARGS(cargs,p)
+
+    // Module::get_function() and InternalFunction store the arity in the
+    // tag; without this check, parameters beyond those supplied would be
+    // read from uninitialized slots of cargs
+    SEXP arity = R_ExternalPtrTag(fun);
+    if (TYPEOF(arity) == INTSXP && Rf_xlength(arity) == 1 && nargs < INTEGER(arity)[0])
+        Rcpp::stop(
+            "incorrect number of arguments: expecting %d, got %d",
+            INTEGER(arity)[0],
+            nargs
+        );
+
     return fun->operator()(cargs);
 END_RCPP
 }