Global symbol visibility

Author: pachadotdev

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()
 }

cpp11test/src/test-integers.cpp

@@ -138,23 +138,6 @@ context("integers-C++") {
     expect_true(x[1] == 3);
     expect_true(x[2] == 4);
   }
-  test_that("integers.value()") {
-    cpp11::writable::integers x;
-    x.push_back(1);
-    x.push_back(2);
-    x.push_back(3);
-
-    // Test that value() returns the same as operator[] but as T directly
-    expect_true(x.value(0) == 1);
-    expect_true(x.value(1) == 2);
-    expect_true(x.value(2) == 3);
-
-    // Test that value() works with C-style formatting (this was the original issue in
-    // #453)
-    expect_true(x.value(0) == x[0]);
-    expect_true(x.value(1) == x[1]);
-    expect_true(x.value(2) == x[2]);
-  }
 
   test_that("writable::integers(SEXP)") {
     SEXP x = PROTECT(Rf_allocVector(INTSXP, 5));
@@ -295,56 +278,4 @@ context("integers-C++") {
     int y = NA_INTEGER;
     expect_true(cpp11::is_na(y));
   }
-
-  test_that("proxy issue demonstration") {
-    // This test demonstrates the proxy issue and shows that all solutions work
-    cpp11::writable::integers x;
-    for (int i = 0; i < 3; i++) {
-      x.push_back(i * 10);
-    }
-
-    // Test that value() method works correctly
-    expect_true(x.value(0) == 0);
-    expect_true(x.value(1) == 10);
-    expect_true(x.value(2) == 20);
-
-    // Test that explicit cast works
-    expect_true((int)x[0] == 0);
-    expect_true((int)x[1] == 10);
-    expect_true((int)x[2] == 20);
-
-    // Test that auto assignment works (triggers implicit conversion)
-    int val0 = x[0];
-    int val1 = x[1];
-    int val2 = x[2];
-    expect_true(val0 == 0);
-    expect_true(val1 == 10);
-    expect_true(val2 == 20);
-
-    // Test that value() and operator[] return equivalent results
-    expect_true(x.value(0) == (int)x[0]);
-    expect_true(x.value(1) == (int)x[1]);
-    expect_true(x.value(2) == (int)x[2]);
-  }
-}
-
-// [[cpp11::register]]
-// Demo function to show the three ways to handle the proxy issue
-// To use this function:
-// 1. Run cpp11::cpp_register() to regenerate R bindings
-// 2. Rebuild and reinstall the package
-// 3. Call test_proxy_issue_demo() from R
-void test_proxy_issue_demo() {
-  cpp11::writable::integers x;
-  for (int i = 0; i < 5; i++) {
-    x.push_back(i);
-
-    // These all work correctly:
-    Rprintf("Method 1 - cast: x[%d] = %d\n", i, (int)x[i]);
-    Rprintf("Method 2 - value(): x[%d] = %d\n", i, x.value(i));
-
-    // This also works (auto triggers implicit conversion):
-    int val = x[i];
-    Rprintf("Method 3 - auto: x[%d] = %d\n", i, val);
-  }
 }

man/cpp_source.Rd

@@ -0,0 +1,80 @@
+test_that("cpp_source local controls RTTI/vtable symbol visibility", {
+  skip_on_os("windows")
+
+  mk_dirs <- function() {
+    d1 <- tempfile("cpp_source_local1")
+    d2 <- tempfile("cpp_source_local2")
+    dir.create(d1); dir.create(d2)
+    list(provider = d1, consumer = d2)
+  }
+
+  unload_dirs <- function(dirs) {
+    dlls <- getLoadedDLLs()
+    for (nm in names(dlls)) {
+      p <- dlls[[nm]]$path
+      if (!is.null(p)) {
+        for (d in dirs) {
+          if (grepl(d, p, fixed = TRUE)) {
+            tryCatch(dyn.unload(p), error = function(e) NULL)
+          }
+        }
+      }
+    }
+  }
+
+  provider_so_path <- function(dir) {
+    src <- file.path(dir, "src")
+    files <- list.files(src, pattern = paste0("\\\\", .Platform$dynlib.ext, "$"), ignore.case = TRUE)
+    if (length(files) == 0) return(character())
+    file.path(src, files[[1]])
+  }
+
+  dirs <- mk_dirs()
+  on.exit({
+    unload_dirs(unlist(dirs))
+    unlink(unlist(dirs), recursive = TRUE, force = TRUE)
+  }, add = TRUE)
+
+  # Provider: abstract Base + Impl factory (polymorphic triggers RTTI/vtable)
+  provider_code <- '
+    #include <cpp11/R.hpp>
+    struct Base { virtual ~Base(){}; virtual int foo() = 0; };
+    struct Impl : Base { int foo() override { return 77; } };
+
+    extern "C" Base* make_impl() { return new Impl(); }
+    extern "C" void destroy_impl(Base* p) { delete p; }
+  '
+
+  # Consumer uses typeid(Base) (forces reference to typeinfo symbol) and
+  # calls the factory produced by the provider.
+  consumer_code <- '\n#include <cpp11/R.hpp>\n#include <typeinfo>\n#include <string>\nstruct Base { virtual ~Base(){}; virtual int foo() = 0; };\nextern "C" Base* make_impl();\nextern "C" SEXP call_typeinfo_and_run() {\n  const std::type_info& t = typeid(Base);\n  std::string n = t.name();\n  Base* b = make_impl();\n  int v = b->foo();\n  delete b;\n  SEXP out = PROTECT(Rf_allocVector(INTSXP, 2));\n  INTEGER(out)[0] = (int)n.size();\n  INTEGER(out)[1] = v;\n  UNPROTECT(1);\n  return out;\n}\n'
+
+  # 1) provider loaded with local = TRUE -> consumer should fail to load
+  expect_silent(cpp_source(code = provider_code, dir = dirs$provider, clean = FALSE, local = TRUE))
+  expect_error(
+    cpp_source(code = consumer_code, dir = dirs$consumer, clean = FALSE),
+    regexp = "undefined symbol|symbol .* not found|undefined reference",
+    ignore.case = TRUE
+  )
+
+  # Clean up partial loads
+  unload_dirs(unlist(dirs))
+
+  # 2) provider loaded with local = FALSE -> consumer loads and runs
+  expect_silent(cpp_source(code = provider_code, dir = dirs$provider, clean = FALSE, local = FALSE))
+  expect_silent(cpp_source(code = consumer_code, dir = dirs$consumer, clean = FALSE))
+
+  res <- .Call("call_typeinfo_and_run")
+  expect_true(is.integer(res) && length(res) == 2)
+  expect_equal(as.integer(res)[2], 77L)
+  expect_true(as.integer(res)[1] > 0)
+
+  # Explicit check that the manual dyn.load(...) workaround is unnecessary.
+  # Emulate the snippet to locate the provider shared object and show that it
+  # exists; we already demonstrated the consumer works without running this
+  # manual snippet because cpp_source(local = FALSE) provided global symbols.
+  so_path <- provider_so_path(dirs$provider)
+  expect_true(file.exists(so_path))
+  # Loading it manually with local = FALSE would succeed, but wasn't required.
+  expect_silent(dyn.load(so_path, local = FALSE, now = TRUE))
+})