Teach cpp_source() how to source multiple files (#492)

* Teach `cpp_source()` how to source multiple files

* NEWS bullet

* Link to PR

Author: DavisVaughan

NEWS.md

@@ -1,5 +1,7 @@
 # cpp11 (development version)
 
+* `cpp_source()` now works with multiple `file`s (#492).
+
 # cpp11 0.5.4
 
 * Removed non-API usage of `R_NamespaceRegistry`.

R/source.R

@@ -1,14 +1,14 @@
 #' Compile C++ code
 #'
-#' [cpp_source()] compiles and loads a single C++ file for use in R.
+#' [cpp_source()] compiles and loads one or more C++ files for use in R.
 #' [cpp_function()] compiles and loads a single function for use in R.
 #' [cpp_eval()] evaluates a single C++ expression and returns the result.
 #'
 #' Within C++ code you can use `[[cpp11::linking_to("pkgxyz")]]` to link to
 #' external packages. This is equivalent to putting those packages in the
 #' `LinkingTo` field in a package DESCRIPTION.
 #'
-#' @param file A file containing C++ code to compile
+#' @param file One or more files containing C++ code to compile
 #' @param code If non-null, the C++ code to compile
 #' @param env The R environment where the R wrapping functions should be defined.
 #' @param clean If `TRUE`, cleanup the files after sourcing
@@ -67,7 +67,9 @@
 #' @export
 cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11"), dir = tempfile()) {
   stop_unless_installed(c("brio", "callr", "cli", "decor", "desc", "glue", "tibble", "vctrs"))
-  if (!missing(file) && !file.exists(file)) {
+
+  if (!missing(file) && !all(file.exists(file))) {
+    file <- file[!file.exists(file)][[1L]]
     stop("Can't find `file` at this path:\n", file, "\n", call. = FALSE)
   }
 
@@ -83,12 +85,13 @@ cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, qu
     }
     brio::write_lines(code, file)
   }
+
   if (!any(tools::file_ext(file) %in% c("cpp", "cc"))) {
     stop("`file` must have a `.cpp` or `.cc` extension")
   }
 
-  name <- generate_cpp_name(file)
-  package <- tools::file_path_sans_ext(name)
+  package <- generate_package_name()
+  name <- vcapply(file, generate_cpp_name)
 
   orig_dir <- normalizePath(dirname(file), winslash = "/")
   new_dir <- normalizePath(file.path(dir, "src"), winslash = "/")
@@ -112,7 +115,7 @@ cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, qu
   funs <- get_registered_functions(all_decorations, "cpp11::register", quiet = quiet)
   cpp_functions_definitions <- generate_cpp_functions(funs, package = package)
 
-  cpp_path <- file.path(dirname(new_file_path), "cpp11.cpp")
+  cpp_path <- file.path(new_dir, "cpp11.cpp")
   brio::write_lines(c('#include "cpp11/declarations.hpp"', "using namespace ::cpp11;", cpp_functions_definitions), cpp_path)
 
   linking_to <- union(get_linking_to(all_decorations), "cpp11")
@@ -130,7 +133,14 @@ cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, qu
   brio::write_lines(makevars_content, file.path(new_dir, "Makevars"))
 
   source_files <- normalizePath(c(new_file_path, cpp_path), winslash = "/")
-  res <- callr::rcmd("SHLIB", source_files, user_profile = TRUE, show = !quiet, wd = new_dir)
+
+  shared_lib_name <- paste0(package, .Platform$dynlib.ext)
+
+  shlib_args <- c(
+    source_files,
+    paste0("--output=", shared_lib_name)
+  )
+  res <- callr::rcmd("SHLIB", shlib_args, user_profile = TRUE, show = !quiet, wd = new_dir)
   if (res$status != 0) {
     error_messages <- res$stderr
 
@@ -140,30 +150,51 @@ cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, qu
     stop("Compilation failed.", call. = FALSE)
   }
 
-  shared_lib <- file.path(dir, "src", paste0(tools::file_path_sans_ext(new_file_name), .Platform$dynlib.ext))
   r_path <- file.path(dir, "R", "cpp11.R")
   brio::write_lines(r_functions, r_path)
   source(r_path, local = env)
 
-  dyn.load(shared_lib, local = TRUE, now = TRUE)
+  shared_lib_path <- file.path(dir, "src", shared_lib_name)
+
+  dyn.load(shared_lib_path, local = TRUE, now = TRUE)
 }
 
 the <- new.env(parent = emptyenv())
 the$count <- 0L
 
-generate_cpp_name <- function(name, loaded_dlls = c("cpp11", names(getLoadedDLLs()))) {
+generate_cpp_name <- function(
+  name,
+  loaded_dlls = c("cpp11", names(getLoadedDLLs()))
+) {
   ext <- tools::file_ext(name)
   root <- tools::file_path_sans_ext(basename(name))
-  count <- 2
-  new_name <- root
-  while(new_name %in% loaded_dlls) {
-    new_name <- sprintf("%s_%i", root, count)
-    count <- count + 1
-  }
-  sprintf("%s.%s", new_name, ext)
+  root <- make_unique(root, loaded_dlls)
+  sprintf("%s.%s", root, ext)
 }
 
+generate_package_name <- function(
+  loaded_dlls = c("cpp11", names(getLoadedDLLs()))
+) {
+  name <- paste0(
+    "package_",
+    paste0(sample(letters, 10, replace = TRUE), collapse = "")
+  )
+  name <- make_unique(name, loaded_dlls)
+  name
+}
+
+# Adds `_2`, `_3`, etc to `x` until it is unique
+make_unique <- function(x, conflicts) {
+  new <- x
 
+  count <- 2L
+  while (new %in% conflicts) {
+    new <- paste0(x, "_", count)
+    count <- count + 1L
+  }
+
+  new
+}
 
 generate_include_paths <- function(packages) {
   out <- character(length(packages))

man/cpp_source.Rd

@@ -0,0 +1 @@
+[[cpp11::register]] int foo() { return 1; }

tests/testthat/fixtures/test-two-files/one.cpp

@@ -0,0 +1 @@
+[[cpp11::register]] double bar() { return 1.0; }

tests/testthat/fixtures/test-two-files/two.cpp

@@ -54,6 +54,20 @@ test_that("cpp_source works with files called `cpp11.cpp`", {
   expect_true(always_true())
 })
 
+test_that("cpp_source works with multiple `file`s", {
+  skip_on_os("solaris")
+
+  dll_info <- cpp_source(test_path(
+    "fixtures",
+    "test-two-files",
+    c("one.cpp", "two.cpp")
+  ))
+  on.exit(dyn.unload(dll_info[["path"]]), add = TRUE)
+
+  expect_identical(foo(), 1L)
+  expect_identical(bar(), 1)
+})
+
 test_that("cpp_source returns original file name on error", {
 
   expect_output(try(cpp_source(test_path("single_error.cpp"), clean = TRUE), silent = TRUE),