From 692242fde226f5616fac5029bbe341c98c0babf7 Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Sat, 15 Aug 2020 13:34:19 -0400 Subject: [PATCH 01/11] add cpp11::preserved to provide encapsulated access to the list of preserved objects --- inst/include/cpp11/protect.hpp | 96 +++++++++++++++++++++++++++++----- 1 file changed, 84 insertions(+), 12 deletions(-) diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index fe5f8aa4..322c95c3 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -25,14 +25,86 @@ class unwind_exception : public std::exception { unwind_exception(SEXP token_) : token(token_) {} }; -static SEXP preserve(SEXP obj) { - PROTECT(obj); - R_PreserveObject(obj); - UNPROTECT(1); - return obj; -} +/// A doubly-linked list of preserved objects, allowing O(1) insertion/release of objects +/// compared to O(N preserved) with R_PreserveObject. +struct { + SEXP insert(SEXP obj) { + if (obj == R_NilValue) { + return R_NilValue; + } + +#ifdef CPP11_USE_PRESERVE_OBJECT + return preserve_(obj); +#endif + + PROTECT(obj); + + // Add a new cell that points to the previous end. + SEXP cell = PROTECT(Rf_cons(list_, CDR(list_))); + SET_TAG(cell, obj); + + SETCDR(list_, cell); + if (CDR(cell) != R_NilValue) { + SETCAR(CDR(cell), cell); + } + + UNPROTECT(2); + + return cell; + } + + void print() { + for (SEXP head = list_; head != R_NilValue; head = CDR(head)) { + REprintf("%x CAR: %x CDR: %x TAG: %x\n", head, CAR(head), CDR(head), TAG(head)); + } + REprintf("---\n"); + } + + // This is currently unused, but client packages could use it to free leaked resources + // in older R versions if needed + void release_all() { +#if !defined(CPP11_USE_PRESERVE_OBJECT) + SEXP first = CDR(list_); + if (first != R_NilValue) { + SETCAR(first, R_NilValue); + SETCDR(list_, R_NilValue); + } +#endif + } + + void release(SEXP token) { + if (token == R_NilValue) { + return; + } + +#ifdef CPP11_USE_PRESERVE_OBJECT + R_ReleaseObject(token); + return; +#endif + + SEXP before = CAR(token); + SEXP after = CDR(token); + + if (before == R_NilValue && after == R_NilValue) { + Rf_error("should never happen"); + } + + SETCDR(before, after); + if (after != R_NilValue) { + SETCAR(after, before); + } + } + + // private: + static SEXP preserve_(SEXP obj) { + PROTECT(obj); + R_PreserveObject(obj); + UNPROTECT(1); + } + + SEXP list_ = preserve_(Rf_cons(R_NilValue, R_NilValue)); -static SEXP protect_list = preserve(Rf_cons(R_NilValue, R_NilValue)); +} preserved; inline SEXP protect_sexp(SEXP obj) { if (obj == R_NilValue) { @@ -45,10 +117,10 @@ inline SEXP protect_sexp(SEXP obj) { PROTECT(obj); // Add a new cell that points to the previous end. - SEXP cell = PROTECT(Rf_cons(protect_list, CDR(protect_list))); + SEXP cell = PROTECT(Rf_cons(preserved.list_, CDR(preserved.list_))); SET_TAG(cell, obj); - SETCDR(protect_list, cell); + SETCDR(preserved.list_, cell); if (CDR(cell) != R_NilValue) { SETCAR(CDR(cell), cell); } @@ -59,7 +131,7 @@ inline SEXP protect_sexp(SEXP obj) { } inline void print_protect() { - SEXP head = protect_list; + SEXP head = preserved.list_; while (head != R_NilValue) { REprintf("%x CAR: %x CDR: %x TAG: %x\n", head, CAR(head), CDR(head), TAG(head)); head = CDR(head); @@ -71,10 +143,10 @@ inline void print_protect() { * older R versions if needed */ inline void release_existing_protections() { #if !defined(CPP11_USE_PRESERVE_OBJECT) - SEXP first = CDR(protect_list); + SEXP first = CDR(preserved.list_); if (first != R_NilValue) { SETCAR(first, R_NilValue); - SETCDR(protect_list, R_NilValue); + SETCDR(preserved.list_, R_NilValue); } #endif } From 76009ffc03a8fa4655b9373bdef3ff884dcc5304 Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Sat, 15 Aug 2020 17:43:06 -0400 Subject: [PATCH 02/11] replace protect_sexp with preserved.insert --- .gitignore | 1 + R/utils.R | 2 + cpp11test/src/protect.cpp | 8 +- cpp11test/src/test-sexp.cpp | 1 + inst/include/cpp11/doubles.hpp | 8 +- inst/include/cpp11/integers.hpp | 10 +- inst/include/cpp11/list.hpp | 12 +- inst/include/cpp11/logicals.hpp | 12 +- inst/include/cpp11/protect.hpp | 243 +++++++++++++------------------- inst/include/cpp11/r_vector.hpp | 40 +++--- inst/include/cpp11/raws.hpp | 12 +- inst/include/cpp11/strings.hpp | 14 +- tests/testthat/test-source.R | 4 +- vignettes/internals.Rmd | 6 +- 14 files changed, 162 insertions(+), 211 deletions(-) diff --git a/.gitignore b/.gitignore index ee4d3997..f2639ad9 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,4 @@ cpp11test/src/*.so compile_flags.txt inst/doc vignettes/*_cache +compile_commands.json diff --git a/R/utils.R b/R/utils.R index e84e48fa..8f075b93 100644 --- a/R/utils.R +++ b/R/utils.R @@ -67,3 +67,5 @@ is_interactive <- function() { } interactive() } + +`.preserve_list` <- pairlist(NA, NA) diff --git a/cpp11test/src/protect.cpp b/cpp11test/src/protect.cpp index 230317dc..04ddf0ac 100644 --- a/cpp11test/src/protect.cpp +++ b/cpp11test/src/protect.cpp @@ -18,8 +18,8 @@ [[cpp11::register]] void protect_one_cpp11_(SEXP x, int n) { for (R_xlen_t i = 0; i < n; ++i) { - SEXP p = cpp11::protect_sexp(x); - cpp11::release_protect(p); + SEXP p = cpp11::preserved.insert(x); + cpp11::preserved.release(p); } } @@ -63,12 +63,12 @@ [[cpp11::register]] void protect_many_cpp11_(int n) { std::vector res; for (R_xlen_t i = 0; i < n; ++i) { - res.push_back(cpp11::protect_sexp(Rf_ScalarInteger(n))); + res.push_back(cpp11::preserved.insert(Rf_ScalarInteger(n))); } for (R_xlen_t i = n - 1; i >= 0; --i) { SEXP x = res[i]; - cpp11::release_protect(x); + cpp11::preserved.release(x); res.pop_back(); } } diff --git a/cpp11test/src/test-sexp.cpp b/cpp11test/src/test-sexp.cpp index 59c15de0..c41e1e41 100644 --- a/cpp11test/src/test-sexp.cpp +++ b/cpp11test/src/test-sexp.cpp @@ -15,6 +15,7 @@ context("sexp-C++") { expect_true(Rf_inherits(out, "data.frame")); } + test_that("scalar constructors work") { using namespace cpp11::literals; cpp11::writable::list out({ diff --git a/inst/include/cpp11/doubles.hpp b/inst/include/cpp11/doubles.hpp index be3e6fac..abfea8b2 100644 --- a/inst/include/cpp11/doubles.hpp +++ b/inst/include/cpp11/doubles.hpp @@ -79,7 +79,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](REALSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -95,7 +95,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -106,8 +106,8 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { data_ = data_ == R_NilValue ? safe[Rf_allocVector](REALSXP, new_capacity) : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); - release_protect(old_protect); + protect_ = preserved.insert(data_); + preserved.release(old_protect); data_p_ = REAL(data_); capacity_ = new_capacity; diff --git a/inst/include/cpp11/integers.hpp b/inst/include/cpp11/integers.hpp index 59466378..87414c7e 100644 --- a/inst/include/cpp11/integers.hpp +++ b/inst/include/cpp11/integers.hpp @@ -9,7 +9,7 @@ #include "cpp11/as.hpp" // for as_sexp #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -83,10 +83,10 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { SEXP old_protect = protect_; // Protect the new data - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); // Release the old protection; - release_protect(old_protect); + preserved.release(old_protect); data_p_ = INTEGER(data_); capacity_ = new_capacity; @@ -96,7 +96,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](INTSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -112,7 +112,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } diff --git a/inst/include/cpp11/list.hpp b/inst/include/cpp11/list.hpp index 0cf0bb85..33cae85c 100644 --- a/inst/include/cpp11/list.hpp +++ b/inst/include/cpp11/list.hpp @@ -5,7 +5,7 @@ #include "cpp11/R.hpp" // for SEXP, SEXPREC, SET_VECTOR_ELT #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for protect_sexp, preserved.release #include "cpp11/r_string.hpp" // for r_string #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -75,7 +75,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](VECSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); auto it = il.begin(); for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { SET_VECTOR_ELT(data_, i, *it); @@ -86,7 +86,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](VECSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -102,7 +102,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -114,8 +114,8 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); - release_protect(old_protect); + protect_ = preserved.insert(data_); + preserved.release(old_protect); capacity_ = new_capacity; } diff --git a/inst/include/cpp11/logicals.hpp b/inst/include/cpp11/logicals.hpp index b82db60b..e1c66ff0 100644 --- a/inst/include/cpp11/logicals.hpp +++ b/inst/include/cpp11/logicals.hpp @@ -7,7 +7,7 @@ #include "cpp11/R.hpp" // for Rboolean, SEXP, SEXPREC, Rf_all... #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -71,7 +71,7 @@ inline r_vector::proxy::operator Rboolean() const { template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(Rf_allocVector(LGLSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); auto it = il.begin(); for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { SET_LOGICAL_ELT(data_, i, *it); @@ -82,7 +82,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](LGLSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -98,7 +98,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -109,9 +109,9 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { data_ = data_ == R_NilValue ? safe[Rf_allocVector](LGLSXP, new_capacity) : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); - release_protect(old_protect); + preserved.release(old_protect); data_p_ = reinterpret_cast(LOGICAL(data_)); capacity_ = new_capacity; diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index 322c95c3..db8f121f 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -25,154 +25,6 @@ class unwind_exception : public std::exception { unwind_exception(SEXP token_) : token(token_) {} }; -/// A doubly-linked list of preserved objects, allowing O(1) insertion/release of objects -/// compared to O(N preserved) with R_PreserveObject. -struct { - SEXP insert(SEXP obj) { - if (obj == R_NilValue) { - return R_NilValue; - } - -#ifdef CPP11_USE_PRESERVE_OBJECT - return preserve_(obj); -#endif - - PROTECT(obj); - - // Add a new cell that points to the previous end. - SEXP cell = PROTECT(Rf_cons(list_, CDR(list_))); - SET_TAG(cell, obj); - - SETCDR(list_, cell); - if (CDR(cell) != R_NilValue) { - SETCAR(CDR(cell), cell); - } - - UNPROTECT(2); - - return cell; - } - - void print() { - for (SEXP head = list_; head != R_NilValue; head = CDR(head)) { - REprintf("%x CAR: %x CDR: %x TAG: %x\n", head, CAR(head), CDR(head), TAG(head)); - } - REprintf("---\n"); - } - - // This is currently unused, but client packages could use it to free leaked resources - // in older R versions if needed - void release_all() { -#if !defined(CPP11_USE_PRESERVE_OBJECT) - SEXP first = CDR(list_); - if (first != R_NilValue) { - SETCAR(first, R_NilValue); - SETCDR(list_, R_NilValue); - } -#endif - } - - void release(SEXP token) { - if (token == R_NilValue) { - return; - } - -#ifdef CPP11_USE_PRESERVE_OBJECT - R_ReleaseObject(token); - return; -#endif - - SEXP before = CAR(token); - SEXP after = CDR(token); - - if (before == R_NilValue && after == R_NilValue) { - Rf_error("should never happen"); - } - - SETCDR(before, after); - if (after != R_NilValue) { - SETCAR(after, before); - } - } - - // private: - static SEXP preserve_(SEXP obj) { - PROTECT(obj); - R_PreserveObject(obj); - UNPROTECT(1); - } - - SEXP list_ = preserve_(Rf_cons(R_NilValue, R_NilValue)); - -} preserved; - -inline SEXP protect_sexp(SEXP obj) { - if (obj == R_NilValue) { - return R_NilValue; - } -#ifdef CPP11_USE_PRESERVE_OBJECT - R_PreserveObject(obj); - return obj; -#endif - PROTECT(obj); - - // Add a new cell that points to the previous end. - SEXP cell = PROTECT(Rf_cons(preserved.list_, CDR(preserved.list_))); - SET_TAG(cell, obj); - - SETCDR(preserved.list_, cell); - if (CDR(cell) != R_NilValue) { - SETCAR(CDR(cell), cell); - } - - UNPROTECT(2); - - return cell; -} - -inline void print_protect() { - SEXP head = preserved.list_; - while (head != R_NilValue) { - REprintf("%x CAR: %x CDR: %x TAG: %x\n", head, CAR(head), CDR(head), TAG(head)); - head = CDR(head); - } - REprintf("---\n"); -} - -/* This is currently unused, but client packages could use it to free leaked resources in - * older R versions if needed */ -inline void release_existing_protections() { -#if !defined(CPP11_USE_PRESERVE_OBJECT) - SEXP first = CDR(preserved.list_); - if (first != R_NilValue) { - SETCAR(first, R_NilValue); - SETCDR(preserved.list_, R_NilValue); - } -#endif -} - -inline void release_protect(SEXP protect) { - if (protect == R_NilValue) { - return; - } -#ifdef CPP11_USE_PRESERVE_OBJECT - R_ReleaseObject(protect); - return; -#endif - - SEXP before = CAR(protect); - SEXP after = CDR(protect); - - if (before == R_NilValue && after == R_NilValue) { - Rf_error("should never happen"); - } - - SETCDR(before, after); - if (after != R_NilValue) { - SETCAR(after, before); - } -} - #ifdef HAS_UNWIND_PROTECT namespace internal { @@ -351,4 +203,99 @@ void warning(const std::string& fmt, Args... args) { safe[Rf_warning](fmt.c_str(), args...); } +/// A doubly-linked list of preserved objects, allowing O(1) insertion/release of +/// objects compared to O(N preserved) with R_PreserveObject. +static struct { + SEXP insert(SEXP obj) { + if (obj == R_NilValue) { + return R_NilValue; + } + +#ifdef CPP11_USE_PRESERVE_OBJECT + PROTECT(obj); + R_PreserveObject(obj); + UNPROTECT(1); + return obj; +#endif + + PROTECT(obj); + + // Add a new cell that points to the previous end. + SEXP cell = PROTECT(Rf_cons(list_, CDR(list_))); + + SET_TAG(cell, obj); + + SETCDR(list_, cell); + + if (CDR(cell) != R_NilValue) { + SETCAR(CDR(cell), cell); + } + + UNPROTECT(2); + + return cell; + } + + void print() { + for (SEXP head = list_; head != R_NilValue; head = CDR(head)) { + REprintf("%x CAR: %x CDR: %x TAG: %x\n", head, CAR(head), CDR(head), TAG(head)); + } + REprintf("---\n"); + } + + // This is currently unused, but client packages could use it to free leaked resources + // in older R versions if needed + void release_all() { +#if !defined(CPP11_USE_PRESERVE_OBJECT) + SEXP first = CDR(list_); + if (first != R_NilValue) { + SETCAR(first, R_NilValue); + SETCDR(list_, R_NilValue); + } +#endif + } + + void release(SEXP token) { + if (token == R_NilValue) { + return; + } + +#ifdef CPP11_USE_PRESERVE_OBJECT + R_ReleaseObject(token); + return; +#endif + + SEXP before = CAR(token); + + SEXP after = CDR(token); + + if (before == R_NilValue && after == R_NilValue) { + Rf_error("should never happen"); + } + + SETCDR(before, after); + + if (after != R_NilValue) { + SETCAR(after, before); + } + } + + private: + static SEXP get_preserve_list() { + static SEXP list_singleton = R_NilValue; + + if (list_singleton == R_NilValue) { + // The .preserve_list singleton is a member of cpp11::: and is managed by the R + // runtime. It cannot be constructed a header since many translation units may be + // compiled, resulting in unrelated instances of each static variable. + SEXP ns = safe[Rf_findVarInFrame](R_NamespaceRegistry, safe[Rf_install]("cpp11")); + list_singleton = safe[Rf_findVar](safe[Rf_install](".preserve_list"), ns); + } + + return list_singleton; + } + + SEXP list_ = get_preserve_list(); +} preserved; + } // namespace cpp11 diff --git a/inst/include/cpp11/r_vector.hpp b/inst/include/cpp11/r_vector.hpp index 3912e48e..ae300650 100644 --- a/inst/include/cpp11/r_vector.hpp +++ b/inst/include/cpp11/r_vector.hpp @@ -15,7 +15,7 @@ #include "cpp11/R.hpp" // for R_xlen_t, SEXP, SEXPREC, Rf_xle... #include "cpp11/attribute_proxy.hpp" // for attribute_proxy -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_string.hpp" // for r_string #include "cpp11/sexp.hpp" // for sexp @@ -80,12 +80,12 @@ class r_vector { SEXP old_protect = protect_; data_ = rhs.data_; - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); is_altrep_ = rhs.is_altrep_; data_p_ = rhs.data_p_; length_ = rhs.length_; - release_protect(old_protect); + preserved.release(old_protect); return *this; }; @@ -94,12 +94,12 @@ class r_vector { SEXP old_protect = protect_; data_ = rhs.data_; - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); is_altrep_ = rhs.is_altrep_; data_p_ = rhs.data_p_; length_ = rhs.length_; - release_protect(old_protect); + preserved.release(old_protect); }; bool is_altrep() const; @@ -178,7 +178,7 @@ class r_vector { const_iterator find(const r_string& name) const; - ~r_vector() { release_protect(protect_); } + ~r_vector() { preserved.release(protect_); } private: SEXP data_ = R_NilValue; @@ -359,7 +359,7 @@ class r_vector : public cpp11::r_vector { template inline r_vector::r_vector(const SEXP data) : data_(valid_type(data)), - protect_(protect_sexp(data)), + protect_(preserved.insert(data)), is_altrep_(ALTREP(data)), data_p_(get_p(ALTREP(data), data)), length_(Rf_xlength(data)) {} @@ -367,7 +367,7 @@ inline r_vector::r_vector(const SEXP data) template inline r_vector::r_vector(const SEXP data, bool is_altrep) : data_(valid_type(data)), - protect_(protect_sexp(data)), + protect_(preserved.insert(data)), is_altrep_(is_altrep), data_p_(get_p(is_altrep, data)), length_(Rf_xlength(data)) {} @@ -630,23 +630,23 @@ inline typename r_vector::iterator r_vector::end() const { template inline r_vector::r_vector(const SEXP& data) : cpp11::r_vector(safe[Rf_shallow_duplicate](data)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) {} template inline r_vector::r_vector(const SEXP& data, bool is_altrep) : cpp11::r_vector(safe[Rf_shallow_duplicate](data), is_altrep), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) {} template inline r_vector::r_vector(SEXP&& data) - : cpp11::r_vector(data), protect_(protect_sexp(data_)), capacity_(length_) {} + : cpp11::r_vector(data), protect_(preserved.insert(data_)), capacity_(length_) {} template inline r_vector::r_vector(SEXP&& data, bool is_altrep) : cpp11::r_vector(data, is_altrep), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) {} template @@ -678,7 +678,7 @@ inline r_vector::r_vector(R_xlen_t size) : r_vector() { template inline r_vector::~r_vector() { - release_protect(protect_); + preserved.release(protect_); } #ifdef LONG_VECTOR_SUPPORT @@ -761,12 +761,12 @@ inline typename r_vector::iterator r_vector::find(const r_string& name) co template inline r_vector::r_vector(const r_vector& rhs) : cpp11::r_vector(safe[Rf_shallow_duplicate](rhs)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(rhs.capacity_) {} template inline r_vector::r_vector(r_vector&& rhs) - : cpp11::r_vector(rhs), protect_(protect_sexp(data_)), capacity_(rhs.capacity_) { + : cpp11::r_vector(rhs), protect_(preserved.insert(data_)), capacity_(rhs.capacity_) { rhs.data_ = R_NilValue; rhs.protect_ = R_NilValue; } @@ -774,7 +774,7 @@ inline r_vector::r_vector(r_vector&& rhs) template inline r_vector::r_vector(const cpp11::r_vector& rhs) : cpp11::r_vector(safe[Rf_shallow_duplicate](rhs)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(rhs.length_) {} // We don't release the old object until the end in case we throw an exception @@ -790,9 +790,9 @@ inline r_vector& r_vector::operator=(const r_vector& rhs) { auto old_protect = protect_; data_ = safe[Rf_shallow_duplicate](rhs.data_); - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); - release_protect(old_protect); + preserved.release(old_protect); capacity_ = rhs.capacity_; @@ -810,9 +810,9 @@ inline r_vector& r_vector::operator=(r_vector&& rhs) { SEXP old_protect = protect_; data_ = rhs.data_; - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); - release_protect(old_protect); + preserved.release(old_protect); capacity_ = rhs.capacity_; diff --git a/inst/include/cpp11/raws.hpp b/inst/include/cpp11/raws.hpp index 6d9e0cba..aec4e4df 100644 --- a/inst/include/cpp11/raws.hpp +++ b/inst/include/cpp11/raws.hpp @@ -8,7 +8,7 @@ #include "cpp11/R.hpp" // for RAW, SEXP, SEXPREC, Rf_allocVector #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for protect_sexp, preserved.release #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -78,7 +78,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](RAWSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); auto it = il.begin(); for (R_xlen_t i = 0; i < capacity_; ++i, ++it) { data_p_[i] = *it; @@ -89,7 +89,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](RAWSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -106,7 +106,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -118,8 +118,8 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); - release_protect(old_protect); + protect_ = preserved.insert(data_); + preserved.release(old_protect); data_p_ = reinterpret_cast(RAW(data_)); capacity_ = new_capacity; diff --git a/inst/include/cpp11/strings.hpp b/inst/include/cpp11/strings.hpp index 4614017f..f626480a 100644 --- a/inst/include/cpp11/strings.hpp +++ b/inst/include/cpp11/strings.hpp @@ -7,7 +7,7 @@ #include "cpp11/as.hpp" // for as_sexp #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, unwind_protect +#include "cpp11/protect.hpp" // for preserved.insert, unwind_protect #include "cpp11/r_string.hpp" // for r_string #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp @@ -91,7 +91,7 @@ inline SEXP alloc_if_charsxp(const SEXP data) { template <> inline r_vector::r_vector(const SEXP& data) : cpp11::r_vector(alloc_or_copy(data)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) { if (TYPEOF(data) == CHARSXP) { SET_STRING_ELT(data_, 0, data); @@ -101,7 +101,7 @@ inline r_vector::r_vector(const SEXP& data) template <> inline r_vector::r_vector(SEXP&& data) : cpp11::r_vector(alloc_if_charsxp(data)), - protect_(protect_sexp(data_)), + protect_(preserved.insert(data_)), capacity_(length_) { if (TYPEOF(data) == CHARSXP) { SET_STRING_ELT(data_, 0, data); @@ -124,7 +124,7 @@ template <> inline r_vector::r_vector(std::initializer_list il) : cpp11::r_vector(safe[Rf_allocVector](STRSXP, il.size())), capacity_(il.size()) { - protect_ = protect_sexp(data_); + protect_ = preserved.insert(data_); int n_protected = 0; try { @@ -140,7 +140,7 @@ inline r_vector::r_vector(std::initializer_list il) UNPROTECT(n_protected); }); } catch (const unwind_exception& e) { - release_protect(protect_); + preserved.release(protect_); UNPROTECT(n_protected); throw e; } @@ -152,8 +152,8 @@ inline void r_vector::reserve(R_xlen_t new_capacity) { : safe[Rf_xlengthgets](data_, new_capacity); SEXP old_protect = protect_; - protect_ = protect_sexp(data_); - release_protect(old_protect); + protect_ = preserved.insert(data_); + preserved.release(old_protect); capacity_ = new_capacity; } diff --git a/tests/testthat/test-source.R b/tests/testthat/test-source.R index 1bb3c4c8..ef0d1b3b 100644 --- a/tests/testthat/test-source.R +++ b/tests/testthat/test-source.R @@ -15,9 +15,9 @@ test_that("cpp_source works with the `code` parameter", { return total; } ', clean = TRUE) - on.exit(dyn.unload(dll_info[["path"]])) + on.exit(dyn.unload(dll_info[["path"]])) - expect_equal(num_odd(as.integer(c(1:10, 15, 23))), 7) + expect_equal(num_odd(as.integer(c(1:10, 15, 23))), 7) }) test_that("cpp_source works with the `file` parameter", { diff --git a/vignettes/internals.Rmd b/vignettes/internals.Rmd index 3dfba0b3..c7b1649c 100644 --- a/vignettes/internals.Rmd +++ b/vignettes/internals.Rmd @@ -115,8 +115,8 @@ cpp11 uses an idea proposed by [Luke Tierney](https://github.com/RcppCore/Rcpp/i Each node in the list uses the head (`CAR`) part to point to the previous node, and the `CDR` part to point to the next node. The `TAG` is used to point to the object being protected. The head and tail of the list have `R_NilValue` as their `CAR` and `CDR` pointers respectively. -Calling `protect_sexp()` with a regular R object will add a new node to the list and return a protect token corresponding to the node added. -Calling `release_protect()` on this returned token will release the protection by unlinking the node from the linked list. +Calling `preserved.insert()` with a regular R object will add a new node to the list and return a protect token corresponding to the node added. +Calling `preserved.release()` on this returned token will release the protection by unlinking the node from the linked list. This scheme scales in O(1) time to release or insert an object vs O(N) or worse time with `R_PreserveObject()` / `R_ReleaseObject()`. @@ -146,5 +146,5 @@ None of these options is perfect, here are some pros and cons for each. 3. Was ruled out partially because the implementation would be somewhat tricky and more because performance would suffer greatly. 4. is what we now do in cpp11. It leaks protected objects when there are R API errors. -If packages are concerned about the leaked memory they can call `cpp11::release_existing_protections()` as needed to release the current protections for all objects managed by cpp11. +If packages are concerned about the leaked memory they can call `cpp11::preserved.release_all()` as needed to release the current protections for all objects managed by cpp11. This is not done automatically because in some cases the protections should persist beyond the `.Call()` boundry, e.g. in vroom altrep objects for example. From e3aa704ee870223f59f34db2a45a5fa0b31348ad Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Sat, 15 Aug 2020 17:43:29 -0400 Subject: [PATCH 03/11] fix sexp.hpp --- inst/include/cpp11/sexp.hpp | 26 ++++++++++++++++---------- 1 file changed, 16 insertions(+), 10 deletions(-) diff --git a/inst/include/cpp11/sexp.hpp b/inst/include/cpp11/sexp.hpp index 73d59bd8..1517c5af 100644 --- a/inst/include/cpp11/sexp.hpp +++ b/inst/include/cpp11/sexp.hpp @@ -6,7 +6,7 @@ #include "cpp11/R.hpp" // for SEXP, SEXPREC, REAL_ELT, R_NilV... #include "cpp11/attribute_proxy.hpp" // for attribute_proxy -#include "cpp11/protect.hpp" // for protect_sexp, release_protect +#include "cpp11/protect.hpp" // for preserved namespace cpp11 { @@ -14,31 +14,37 @@ namespace cpp11 { class sexp { private: SEXP data_ = R_NilValue; - SEXP protect_ = R_NilValue; + SEXP preserve_token_ = R_NilValue; public: sexp() = default; - sexp(SEXP data) : data_(data), protect_(protect_sexp(data_)) { - // REprintf("created %x %x : %i\n", data_, protect_, protect_head_size()); + + sexp(SEXP data) : data_(data), preserve_token_(preserved.insert(data_)) { + // REprintf("created %x %x : %i\n", data_, preserve_token_, protect_head_size()); } + sexp(const sexp& rhs) { data_ = rhs.data_; - protect_ = protect_sexp(data_); - // REprintf("copied %x new protect %x : %i\n", rhs.data_, protect_, + preserve_token_ = preserved.insert(data_); + // REprintf("copied %x new protect %x : %i\n", rhs.data_, preserve_token_, // protect_head_size()); } + sexp(sexp&& rhs) { data_ = rhs.data_; - protect_ = rhs.protect_; + preserve_token_ = rhs.preserve_token_; rhs.data_ = R_NilValue; - rhs.protect_ = R_NilValue; + rhs.preserve_token_ = R_NilValue; // REprintf("moved %x : %i\n", rhs.data_, protect_head_size()); } + sexp& operator=(const sexp& rhs) { + preserved.release(preserve_token_); + data_ = rhs.data_; - protect_ = protect_sexp(data_); + preserve_token_ = preserved.insert(data_); // REprintf("assigned %x : %i\n", rhs.data_, protect_head_size()); return *this; } @@ -49,7 +55,7 @@ class sexp { //*this = tmp; //} - ~sexp() { release_protect(protect_); } + ~sexp() { preserved.release(preserve_token_); } attribute_proxy attr(const char* name) const { return attribute_proxy(*this, name); From 7a266dea48f836a63ca5abd0b91ceffe45a42945 Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Sat, 15 Aug 2020 22:19:01 -0400 Subject: [PATCH 04/11] HACK: just define preserve_list in the global env --- inst/include/cpp11/protect.hpp | 14 ++++++++++++-- inst/include/cpp11/r_vector.hpp | 4 +++- 2 files changed, 15 insertions(+), 3 deletions(-) diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index db8f121f..87c3a9f7 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -288,8 +288,18 @@ static struct { // The .preserve_list singleton is a member of cpp11::: and is managed by the R // runtime. It cannot be constructed a header since many translation units may be // compiled, resulting in unrelated instances of each static variable. - SEXP ns = safe[Rf_findVarInFrame](R_NamespaceRegistry, safe[Rf_install]("cpp11")); - list_singleton = safe[Rf_findVar](safe[Rf_install](".preserve_list"), ns); + + // FIXME how can we create the cpp11 namespace when it doesn't already exist? + SEXP list_singleton_sym = safe[Rf_install](".cpp11_preserve_list"); + + list_singleton = safe[Rf_findVarInFrame](R_GlobalEnv, list_singleton_sym); + + if (list_singleton == R_UnboundValue) { + list_singleton = PROTECT(Rf_cons(R_NilValue, R_NilValue)); + R_PreserveObject(list_singleton); + UNPROTECT(1); + safe[Rf_defineVar](list_singleton_sym, list_singleton, R_GlobalEnv); + } } return list_singleton; diff --git a/inst/include/cpp11/r_vector.hpp b/inst/include/cpp11/r_vector.hpp index ae300650..628fe2b9 100644 --- a/inst/include/cpp11/r_vector.hpp +++ b/inst/include/cpp11/r_vector.hpp @@ -766,7 +766,9 @@ inline r_vector::r_vector(const r_vector& rhs) template inline r_vector::r_vector(r_vector&& rhs) - : cpp11::r_vector(rhs), protect_(preserved.insert(data_)), capacity_(rhs.capacity_) { + : cpp11::r_vector(rhs), + protect_(preserved.insert(data_)), + capacity_(rhs.capacity_) { rhs.data_ = R_NilValue; rhs.protect_ = R_NilValue; } From 9c5dd1520e107c40b397c590c3db11bb9e3a2017 Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Tue, 8 Sep 2020 10:48:17 -0400 Subject: [PATCH 05/11] Set the preserve list as a global option Rather than an object in the global environment. Using an option is consistent with CRAN policies, whereas it is against policy for a package to modify the global environment --- inst/include/cpp11/protect.hpp | 23 +++++++++++++++++------ 1 file changed, 17 insertions(+), 6 deletions(-) diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index 87c3a9f7..e4601534 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -281,6 +281,18 @@ static struct { } private: + static void set_option(SEXP name, SEXP value) { + SEXP opt = SYMVALUE(safe[Rf_install](".Options")); + SEXP t = opt; + while (CDR(t) != R_NilValue) { + t = CDR(t); + } + SETCDR(t, Rf_allocList(1)); + opt = CDR(t); + SET_TAG(opt, name); + SETCAR(opt, value); + } + static SEXP get_preserve_list() { static SEXP list_singleton = R_NilValue; @@ -290,15 +302,14 @@ static struct { // compiled, resulting in unrelated instances of each static variable. // FIXME how can we create the cpp11 namespace when it doesn't already exist? - SEXP list_singleton_sym = safe[Rf_install](".cpp11_preserve_list"); + SEXP list_singleton_sym = safe[Rf_install]("cpp11_preserve_list"); - list_singleton = safe[Rf_findVarInFrame](R_GlobalEnv, list_singleton_sym); + list_singleton = safe[Rf_GetOption1](list_singleton_sym); - if (list_singleton == R_UnboundValue) { - list_singleton = PROTECT(Rf_cons(R_NilValue, R_NilValue)); + if (list_singleton == R_NilValue) { + list_singleton = Rf_cons(R_NilValue, R_NilValue); R_PreserveObject(list_singleton); - UNPROTECT(1); - safe[Rf_defineVar](list_singleton_sym, list_singleton, R_GlobalEnv); + set_option(list_singleton_sym, list_singleton); } } From 56e960c1faa2a13ee25caa242a2afcbf7e2ec59c Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Tue, 8 Sep 2020 10:53:46 -0400 Subject: [PATCH 06/11] Remove unneeded object --- R/utils.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/utils.R b/R/utils.R index 8f075b93..e84e48fa 100644 --- a/R/utils.R +++ b/R/utils.R @@ -67,5 +67,3 @@ is_interactive <- function() { } interactive() } - -`.preserve_list` <- pairlist(NA, NA) From cafd5b0f0bc59b37dee4bc9e8c24f65f92342479 Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Wed, 9 Sep 2020 14:54:45 -0400 Subject: [PATCH 07/11] Put the preserve pairlist in an environment Instead of directly, since `options()` and `getOption()` call `duplicate()` on their return, and if we try to duplicate the pairlist we run into errors. --- inst/include/cpp11/protect.hpp | 32 ++++++++++++++++++++++---------- 1 file changed, 22 insertions(+), 10 deletions(-) diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index e4601534..bb53e872 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -293,30 +293,42 @@ static struct { SETCAR(opt, value); } + static SEXP new_environment() { + SEXP new_env_sym = safe[Rf_install]("new.env"); + SEXP new_env_fun = safe[Rf_findFun](new_env_sym, R_BaseEnv); + SEXP call = PROTECT(safe[Rf_allocVector](LANGSXP, 1)); + SETCAR(call, new_env_fun); + SEXP res = safe[Rf_eval](call, R_GlobalEnv); + UNPROTECT(1); + return res; + } + static SEXP get_preserve_list() { - static SEXP list_singleton = R_NilValue; + static SEXP preserve_env = R_NilValue; - if (list_singleton == R_NilValue) { + if (preserve_env == R_NilValue) { // The .preserve_list singleton is a member of cpp11::: and is managed by the R // runtime. It cannot be constructed a header since many translation units may be // compiled, resulting in unrelated instances of each static variable. // FIXME how can we create the cpp11 namespace when it doesn't already exist? - SEXP list_singleton_sym = safe[Rf_install]("cpp11_preserve_list"); + SEXP preserve_env_sym = safe[Rf_install]("cpp11_preserve_env"); - list_singleton = safe[Rf_GetOption1](list_singleton_sym); + preserve_env = safe[Rf_GetOption1](preserve_env_sym); - if (list_singleton == R_NilValue) { - list_singleton = Rf_cons(R_NilValue, R_NilValue); - R_PreserveObject(list_singleton); - set_option(list_singleton_sym, list_singleton); + if (preserve_env == R_NilValue) { + preserve_env = new_environment(); + safe[Rf_defineVar](preserve_env_sym, Rf_cons(R_NilValue, R_NilValue), + preserve_env); + set_option(preserve_env_sym, preserve_env); } } - return list_singleton; + return preserve_env; } - SEXP list_ = get_preserve_list(); + SEXP list_ = safe[Rf_findVarInFrame](get_preserve_list(), + safe[Rf_install]("cpp11_preserve_env")); } preserved; } // namespace cpp11 From 1ce47616f74b10cb883666e9e1246dd5433fe488 Mon Sep 17 00:00:00 2001 From: Jim Hester Date: Thu, 10 Sep 2020 09:54:18 -0400 Subject: [PATCH 08/11] Add explanatory comments, to help future selves --- inst/include/cpp11/protect.hpp | 46 +++++++++++++++++++++------------- 1 file changed, 29 insertions(+), 17 deletions(-) diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index bb53e872..4f50995e 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -281,8 +281,12 @@ static struct { } private: + // We deliberately avoid using safe[] in the below code, as this code runs + // when the shared library is loaded and will not be wrapped by + // `CPP11_UNWIND`, so if an error occurs we will not catch the C++ exception + // that safe emits. static void set_option(SEXP name, SEXP value) { - SEXP opt = SYMVALUE(safe[Rf_install](".Options")); + SEXP opt = SYMVALUE(Rf_install(".Options")); SEXP t = opt; while (CDR(t) != R_NilValue) { t = CDR(t); @@ -294,32 +298,41 @@ static struct { } static SEXP new_environment() { - SEXP new_env_sym = safe[Rf_install]("new.env"); - SEXP new_env_fun = safe[Rf_findFun](new_env_sym, R_BaseEnv); - SEXP call = PROTECT(safe[Rf_allocVector](LANGSXP, 1)); + SEXP new_env_sym = Rf_install("new.env"); + SEXP new_env_fun = Rf_findFun(new_env_sym, R_BaseEnv); + SEXP call = PROTECT(Rf_allocVector(LANGSXP, 1)); SETCAR(call, new_env_fun); - SEXP res = safe[Rf_eval](call, R_GlobalEnv); + SEXP res = Rf_eval(call, R_GlobalEnv); UNPROTECT(1); return res; } - static SEXP get_preserve_list() { + // The preserve_env singleton is stored in an environment within an R global option. + // + // It is not constructed as a static variable directly since many + // translation units may be compiled, resulting in unrelated instances of each + // static variable. + // + // We cannot store it in the cpp11 namespace, as cpp11 likely will not be loaded by + // packages. + // We cannot store it in R's global environment, as that is against CRAN + // policies. + // We need to use a environment as option() and getOption duplicates their + // values, and duplicating the preserve pairlist causes the protection stack to + // overflow. + static SEXP get_preserve_env() { static SEXP preserve_env = R_NilValue; if (preserve_env == R_NilValue) { - // The .preserve_list singleton is a member of cpp11::: and is managed by the R - // runtime. It cannot be constructed a header since many translation units may be - // compiled, resulting in unrelated instances of each static variable. + SEXP preserve_env_sym = Rf_install("cpp11_preserve_env"); - // FIXME how can we create the cpp11 namespace when it doesn't already exist? - SEXP preserve_env_sym = safe[Rf_install]("cpp11_preserve_env"); - - preserve_env = safe[Rf_GetOption1](preserve_env_sym); + preserve_env = Rf_GetOption1(preserve_env_sym); if (preserve_env == R_NilValue) { preserve_env = new_environment(); - safe[Rf_defineVar](preserve_env_sym, Rf_cons(R_NilValue, R_NilValue), - preserve_env); + + SEXP preserve_list_sym = Rf_install("cpp11_preserve_list"); + Rf_defineVar(preserve_list_sym, Rf_cons(R_NilValue, R_NilValue), preserve_env); set_option(preserve_env_sym, preserve_env); } } @@ -327,8 +340,7 @@ static struct { return preserve_env; } - SEXP list_ = safe[Rf_findVarInFrame](get_preserve_list(), - safe[Rf_install]("cpp11_preserve_env")); + SEXP list_ = Rf_findVarInFrame(get_preserve_env(), Rf_install("cpp11_preserve_list")); } preserved; } // namespace cpp11 From a1f421f780998a30aee170c4cf99d8db88275a8b Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Fri, 11 Sep 2020 15:32:10 -0400 Subject: [PATCH 09/11] Update inst/include/cpp11/list.hpp --- inst/include/cpp11/list.hpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/include/cpp11/list.hpp b/inst/include/cpp11/list.hpp index 33cae85c..43c6fc23 100644 --- a/inst/include/cpp11/list.hpp +++ b/inst/include/cpp11/list.hpp @@ -5,7 +5,7 @@ #include "cpp11/R.hpp" // for SEXP, SEXPREC, SET_VECTOR_ELT #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, preserved.release +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_string.hpp" // for r_string #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp From 8164d08afa4b6a5406f215fb32a17c142ce975cc Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Fri, 11 Sep 2020 15:32:18 -0400 Subject: [PATCH 10/11] Update inst/include/cpp11/raws.hpp --- inst/include/cpp11/raws.hpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/include/cpp11/raws.hpp b/inst/include/cpp11/raws.hpp index aec4e4df..ce82a541 100644 --- a/inst/include/cpp11/raws.hpp +++ b/inst/include/cpp11/raws.hpp @@ -8,7 +8,7 @@ #include "cpp11/R.hpp" // for RAW, SEXP, SEXPREC, Rf_allocVector #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect_sexp, preserved.release +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp From 8eace2614f6d568726799e749c11c6d279d93494 Mon Sep 17 00:00:00 2001 From: Benjamin Kietzman Date: Fri, 11 Sep 2020 15:32:27 -0400 Subject: [PATCH 11/11] Update inst/include/cpp11/strings.hpp --- inst/include/cpp11/strings.hpp | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/inst/include/cpp11/strings.hpp b/inst/include/cpp11/strings.hpp index f626480a..311abe9c 100644 --- a/inst/include/cpp11/strings.hpp +++ b/inst/include/cpp11/strings.hpp @@ -7,7 +7,7 @@ #include "cpp11/as.hpp" // for as_sexp #include "cpp11/attribute_proxy.hpp" // for attribute_proxy #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for preserved.insert, unwind_protect +#include "cpp11/protect.hpp" // for preserved #include "cpp11/r_string.hpp" // for r_string #include "cpp11/r_vector.hpp" // for r_vector, r_vector<>::proxy #include "cpp11/sexp.hpp" // for sexp