diff --git a/ChangeLog b/ChangeLog index 402732946..2d3b70f50 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,23 @@ +2026-10-29 Kevin Ushey + + * 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 * DESCRIPTION (Version, Date): Roll micro version and date diff --git a/R/00_classes.R b/R/00_classes.R index 115bd707e..7099367e4 100644 --- a/R/00_classes.R +++ b/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 diff --git a/inst/include/Rcpp/InternalFunction.h b/inst/include/Rcpp/InternalFunction.h index 9a4ad6625..43c37e0a3 100644 --- a/inst/include/Rcpp/InternalFunction.h +++ b/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 InternalFunction_Impl(const std::function &fun) { + Shield arity(Rf_ScalarInteger(static_cast(sizeof...(Args)))); set( XPtr >( new Rcpp::InternalFunctionWithStdFunction::CppFunctionBaseFromStdFunction(fun), - false + false, + arity ) ); } template InternalFunction_Impl(RESULT_TYPE (*fun)(T...)) { - set(XPtr >(new CppFunctionN(fun), true)); + Shield arity(Rf_ScalarInteger(static_cast(sizeof...(T)))); + set(XPtr >(new CppFunctionN(fun), true, arity)); } void update(SEXP){} diff --git a/inst/include/Rcpp/module/Module.h b/inst/include/Rcpp/module/Module.h index 160b53ae5..a8539d7f2 100644 --- a/inst/include/Rcpp/module/Module.h +++ b/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 arity( Rf_ScalarInteger( fun->nargs() ) ) ; + return List::create( - XPtr( fun, false ), + XPtr( fun, false, arity ), fun->is_void(), fun->docstring, sign, diff --git a/inst/tinytest/cpp/Module.cpp b/inst/tinytest/cpp/Module.cpp index 7f3132820..39a65ed53 100644 --- a/inst/tinytest/cpp/Module.cpp +++ b/inst/tinytest/cpp/Module.cpp @@ -166,6 +166,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); diff --git a/inst/tinytest/test_internal_function.R b/inst/tinytest/test_internal_function.R index 939a4dca5..00ef168ee 100644 --- a/inst/tinytest/test_internal_function.R +++ b/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" ) diff --git a/inst/tinytest/test_internal_function_cpp11.R b/inst/tinytest/test_internal_function_cpp11.R index 8ee5c01bc..022b61ceb 100644 --- a/inst/tinytest/test_internal_function_cpp11.R +++ b/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" ) diff --git a/inst/tinytest/test_module.R b/inst/tinytest/test_module.R index db0edfc60..53d344b82 100644 --- a/inst/tinytest/test_module.R +++ b/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" ) diff --git a/src/module.cpp b/src/module.cpp index d90d81ffb..2bcde939c 100644 --- a/src/module.cpp +++ b/src/module.cpp @@ -119,6 +119,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 }