diff --git a/ChangeLog b/ChangeLog index eaeb7acb1..b1e6b7f92 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2025-06-02 Kevin Ushey + + * inst/include/Rcpp.h: Avoid copy when creating Language objects + * inst/include/Rcpp/Language.h: Idem + * inst/include/Rcpp/lgrow.h: Idem + * inst/tinytest/cpp/language.cpp: Idem + * inst/tinytest/test_language.R: Idem + 2025-05-27 Dirk Eddelbuettel * DESCRIPTION (Version, Date): Roll micro version and date diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index d8f4ebe0b..c35b63a42 100644 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -7,6 +7,8 @@ \itemize{ \item Changes in Rcpp API: \itemize{ + \item Fixed an issue where Rcpp::Language would duplicate its arguments + (Kevin in \ghpr{1388}, fixing \ghit{1386}) \item The \code{std::string_view} type is now covered by \code{wrap()} (Lev Kandel in \ghpr{1356} as discussed in \ghit{1357}) \item A last remaining \code{DATAPTR} use has been converted to diff --git a/inst/include/Rcpp.h b/inst/include/Rcpp.h index e518a70ac..bec4f9f41 100644 --- a/inst/include/Rcpp.h +++ b/inst/include/Rcpp.h @@ -32,6 +32,7 @@ #include #include #include +#include #include #include diff --git a/inst/include/Rcpp/Language.h b/inst/include/Rcpp/Language.h index a8575bf07..d893df67a 100644 --- a/inst/include/Rcpp/Language.h +++ b/inst/include/Rcpp/Language.h @@ -104,12 +104,12 @@ namespace Rcpp{ */ template Language_Impl(const std::string& symbol, const T&... t) { - Storage::set__(pairlist(Rf_install(symbol.c_str()), t...) ); + Storage::set__(langlist(Rf_install(symbol.c_str()), t...) ); } template Language_Impl(const Function& function, const T&... t) { - Storage::set__(pairlist(function, t...)); + Storage::set__(langlist(function, t...)); } /** diff --git a/inst/include/Rcpp/lgrow.h b/inst/include/Rcpp/lgrow.h new file mode 100644 index 000000000..f16499a9c --- /dev/null +++ b/inst/include/Rcpp/lgrow.h @@ -0,0 +1,77 @@ +// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*- +// +// lgrow.h: Rcpp R/C++ interface class library -- grow a (LANGSXP) pairlist +// +// Copyright (C) 2010 - 2025 Dirk Eddelbuettel, Romain Francois, and 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 . + +#ifndef Rcpp_lgrow_h +#define Rcpp_lgrow_h + +#include +#include + +namespace Rcpp { + +inline SEXP lgrow(SEXP head, SEXP tail) { + return Rf_lcons(head, tail); +} + +namespace internal { + +// for Named objects +template +inline SEXP lgrow__dispatch(Rcpp::traits::true_type, const T& head, SEXP tail) { + Shield y(wrap(head.object)); + Shield x(Rf_lcons(y, tail)); + SEXP headNameSym = Rf_install(head.name.c_str()); + SET_TAG(x, headNameSym); + return x; +} + +// for all other objects +template +inline SEXP lgrow__dispatch(Rcpp::traits::false_type, const T& head, SEXP tail) { + return lgrow(wrap(head), tail); +} + +} // internal + +template +SEXP lgrow(const T& head, SEXP tail) { + Shield y(tail); + return internal::lgrow__dispatch(typename traits::is_named::type(), head, y); +} + +inline SEXP lgrow(const char* head, SEXP tail) { + Shield y(tail); + return lgrow(Rf_mkString(head), y); +} + +template +SEXP langlist(const T1& t1) { + return lgrow(t1, R_NilValue); +} + +template +SEXP langlist(const T& t1, const TArgs&... args) { + return lgrow(t1, langlist(args...)); +} + +} // namespace Rcpp + +#endif diff --git a/inst/tinytest/cpp/language.cpp b/inst/tinytest/cpp/language.cpp index c06c8a6fb..68aa58fe4 100644 --- a/inst/tinytest/cpp/language.cpp +++ b/inst/tinytest/cpp/language.cpp @@ -272,3 +272,10 @@ Formula runit_formula_SEXP(SEXP form){ return f; } +// [[Rcpp::export]] +SEXP runit_language_modify(Function f) { + auto v = NumericVector::create(0.0, 1.0); + Rcpp::Language call(f, v); + v[0] = 999.0; + return CADR(call); +} diff --git a/inst/tinytest/test_language.R b/inst/tinytest/test_language.R index 3aa85898b..b7eef0b88 100644 --- a/inst/tinytest/test_language.R +++ b/inst/tinytest/test_language.R @@ -139,3 +139,5 @@ expect_equal( runit_formula_SEXP( "x ~ y + z" ), x ~ y + z, info = "Formula( SEX expect_equal( runit_formula_SEXP( parse( text = "x ~ y + z") ), x ~ y + z, info = "Formula( SEXP = EXPRSXP )" ) expect_equal( runit_formula_SEXP( list( "x ~ y + z") ), x ~ y + z, info = "Formula( SEXP = VECSXP(1 = STRSXP) )" ) expect_equal( runit_formula_SEXP( list( x ~ y + z) ), x ~ y + z, info = "Formula( SEXP = VECSXP(1 = formula) )" ) + +expect_equal( runit_language_modify(sum), c(999, 1), info = "Language objects don't duplicate their arguments" )