Issue452

R/source.R

@@ -18,6 +18,13 @@
 #'   uses 'CXX11' if unset.
 #' @param dir The directory to store the generated source files. `tempfile()` is
 #'   used by default. The directory will be removed if `clean` is `TRUE`.
+#' @param local Passed to [dyn.load()]. If `TRUE` (the default) the shared
+#'   library is loaded with local symbols; if `FALSE` symbols are made global
+#'   (equivalent to `dyn.load(..., local = FALSE)`), which can be required when
+#'   other shared objects need to see RTTI/vtable symbols from this library.
+#' @note See the unit test that demonstrates this usage at
+#' \code{tests/testthat/test-source-local.R} (shows how `local = FALSE` exports
+#' the necessary symbols so separate shared objects can link against them).
 #' @return For [cpp_source()] and `[cpp_function()]` the results of
 #'   [dyn.load()] (invisibly). For `[cpp_eval()]` the results of the evaluated
 #'   expression.
@@ -65,7 +72,7 @@
 #' }
 #'
 #' @export
-cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11"), dir = tempfile()) {
+cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11"), dir = tempfile(), local = TRUE) {
   stop_unless_installed(c("brio", "callr", "cli", "decor", "desc", "glue", "tibble", "vctrs"))
   if (!missing(file) && !file.exists(file)) {
     stop("Can't find `file` at this path:\n", file, "\n", call. = FALSE)
@@ -145,7 +152,7 @@ cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, qu
   brio::write_lines(r_functions, r_path)
   source(r_path, local = env)
 
-  dyn.load(shared_lib, local = TRUE, now = TRUE)
+  dyn.load(shared_lib, local = local, now = TRUE)
 }
 
 the <- new.env(parent = emptyenv())
@@ -183,7 +190,7 @@ generate_makevars <- function(includes, cxx_std) {
 
 #' @rdname cpp_source
 #' @export
-cpp_function <- function(code, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11")) {
+cpp_function <- function(code, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11"), local = TRUE) {
   cpp_source(code = paste(c('#include "cpp11.hpp"',
         "using namespace ::cpp11;",
         "namespace writable = ::cpp11::writable;",
@@ -193,15 +200,16 @@ cpp_function <- function(code, env = parent.frame(), clean = TRUE, quiet = TRUE,
     env = env,
     clean = clean,
     quiet = quiet,
-    cxx_std = cxx_std
+    cxx_std = cxx_std,
+    local = local
   )
 }
 
 utils::globalVariables("f")
 
 #' @rdname cpp_source
 #' @export
-cpp_eval <- function(code, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11")) {
+cpp_eval <- function(code, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11"), local = TRUE) {
   cpp_source(code = paste(c('#include "cpp11.hpp"',
         "using namespace ::cpp11;",
         "namespace writable = ::cpp11::writable;",
@@ -214,7 +222,8 @@ cpp_eval <- function(code, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx
     env = env,
     clean = clean,
     quiet = quiet,
-    cxx_std = cxx_std
+    cxx_std = cxx_std,
+    local = local
   )
   f()
 }

inst/include/cpp11/as.hpp

@@ -287,18 +287,14 @@ template <typename Container, typename AsCstring>
 SEXP as_sexp_strings(const Container& from, AsCstring&& c_str) {
   R_xlen_t size = from.size();
 
-  SEXP data;
-  try {
-    data = PROTECT(safe[Rf_allocVector](STRSXP, size));
+  SEXP data = PROTECT(safe[Rf_allocVector](STRSXP, size));
 
+  unwind_protect([&] {
     auto it = from.begin();
     for (R_xlen_t i = 0; i < size; ++i, ++it) {
-      SET_STRING_ELT(data, i, safe[Rf_mkCharCE](c_str(*it), CE_UTF8));
+      SET_STRING_ELT(data, i, Rf_mkCharCE(c_str(*it), CE_UTF8));
     }
-  } catch (const unwind_exception& e) {
-    UNPROTECT(1);
-    throw e;
-  }
+  });
 
   UNPROTECT(1);
   return data;

inst/include/cpp11/integers.hpp

@@ -102,3 +102,26 @@ inline integers as_integers(SEXP x) {
 }
 
 }  // namespace cpp11
+
+// Note: Proxy Behavior in writable::integers
+//
+// When using writable::integers, operator[] returns a proxy object that allows
+// both reading and writing. For cases where you need the actual int value
+// (e.g., when using with C-style variadic functions like Rprintf), use one of
+// these three approaches:
+//
+// 1. Direct value access: vec.value(i)        [Recommended]
+// 2. Explicit cast: (int)vec[i]
+// 3. Auto with explicit type: int val = vec[i];
+//
+// Example demonstrating the issue and solutions:
+//   writable::integers vec;
+//   vec.push_back(42);
+//
+//   // This may print garbage due to proxy object:
+//   // Rprintf("Value: %d\n", vec[0]);  // DON'T DO THIS
+//
+//   // These all work correctly:
+//   Rprintf("Value: %d\n", vec.value(0));  // Recommended
+//   Rprintf("Value: %d\n", (int)vec[0]);   // Also works
+//   int val = vec[0]; Rprintf("Value: %d\n", val);  // Also works

inst/include/cpp11/r_vector.hpp

@@ -256,6 +256,15 @@ class r_vector : public cpp11::r_vector<T> {
 
   iterator find(const r_string& name) const;
 
+  /// Get the value at position without returning a proxy
+  /// This is useful when you need the actual value (e.g., for C-style printf functions)
+  /// that don't trigger implicit conversions from proxy types
+#ifdef LONG_VECTOR_SUPPORT
+  T value(const int pos) const;
+#endif
+  T value(const R_xlen_t pos) const;
+  T value(const size_type pos) const;
+
   attribute_proxy<r_vector<T>> attr(const char* name) const;
   attribute_proxy<r_vector<T>> attr(const std::string& name) const;
   attribute_proxy<r_vector<T>> attr(SEXP name) const;
@@ -1156,6 +1165,24 @@ inline typename r_vector<T>::iterator r_vector<T>::find(const r_string& name) co
   return end();
 }
 
+#ifdef LONG_VECTOR_SUPPORT
+template <typename T>
+inline T r_vector<T>::value(const int pos) const {
+  return value(static_cast<R_xlen_t>(pos));
+}
+#endif
+
+template <typename T>
+inline T r_vector<T>::value(const R_xlen_t pos) const {
+  // Use the parent read-only class's operator[] which returns T directly
+  return cpp11::r_vector<T>::operator[](pos);
+}
+
+template <typename T>
+inline T r_vector<T>::value(const size_type pos) const {
+  return value(static_cast<R_xlen_t>(pos));
+}
+
 template <typename T>
 inline attribute_proxy<r_vector<T>> r_vector<T>::attr(const char* name) const {
   return attribute_proxy<r_vector<T>>(*this, name);