Using vmaxget/vmax set for as_cpp (implement #432)

R/register.R

@@ -77,17 +77,16 @@ cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(".
     cli::cli_alert_success("generated file {.file {basename(r_path)}}")
   }
 
-
   call_entries <- get_call_entries(path, funs$name, package)
 
   cpp_function_registration <- glue::glue_data(funs, '    {{
     "_cpp11_{name}", (DL_FUNC) &_{package}_{name}, {n_args}}}, ',
     n_args = viapply(funs$args, nrow)
   )
 
-  cpp_function_registration <- glue::glue_collapse(cpp_function_registration, sep  = "\n")
+  cpp_function_registration <- glue::glue_collapse(cpp_function_registration, sep = "\n")
 
-  extra_includes <-  character()
+  extra_includes <- character()
   if (pkg_links_to_rcpp(path)) {
     extra_includes <- c(extra_includes, "#include <cpp11/R.hpp>", "#include <Rcpp.h>", "using namespace Rcpp;")
   }
@@ -215,35 +214,75 @@ generate_init_functions <- function(funs) {
 }
 
 generate_r_functions <- function(funs, package = "cpp11", use_package = FALSE) {
-  funs <- funs[c("name", "return_type", "args")]
+  funs <- funs[c("name", "return_type", "args", "file", "line", "decoration")]
 
   if (use_package) {
     package_call <- glue::glue(', PACKAGE = "{package}"')
     package_names <- glue::glue_data(funs, '"_{package}_{name}"')
   } else {
-    package_names <- glue::glue_data(funs, '`_{package}_{name}`')
+    package_names <- glue::glue_data(funs, "`_{package}_{name}`")
     package_call <- ""
   }
 
-  funs$package <- package
   funs$package_call <- package_call
   funs$list_params <- vcapply(funs$args, glue_collapse_data, "{name}")
   funs$params <- vcapply(funs$list_params, function(x) if (nzchar(x)) paste0(", ", x) else x)
   is_void <- funs$return_type == "void"
   funs$calls <- ifelse(is_void,
-    glue::glue_data(funs, 'invisible(.Call({package_names}{params}{package_call}))'),
-    glue::glue_data(funs, '.Call({package_names}{params}{package_call})')
+    glue::glue_data(funs, "invisible(.Call({package_names}{params}{package_call}))"),
+    glue::glue_data(funs, ".Call({package_names}{params}{package_call})")
   )
 
-  out <- glue::glue_data(funs, '
-    {name} <- function({list_params}) {{
-      {calls}
-    }}
-    ')
+  # Parse and associate Roxygen comments
+  funs$roxygen_comment <- mapply(function(file, line) {
+    if (file.exists(file)) {
+      comments <- extract_roxygen_comments(file)
+      matched_comment <- ""
+      for (comment in comments) {
+        # Check if the comment directly precedes the function without gaps
+        if (line == comment$line + 1) {
+          matched_comment <- comment$text
+          break
+        }
+      }
+      matched_comment
+    } else {
+      ""
+    }
+  }, funs$file, funs$line, SIMPLIFY = TRUE)
+
+  # Generate R functions with or without Roxygen comments
+  out <- mapply(function(name, list_params, calls, roxygen_comment) {
+    if (nzchar(roxygen_comment)) {
+      glue::glue("{roxygen_comment}\n{name} <- function({list_params}) {{\n\t{calls}\n}}")
+    } else {
+      glue::glue("{name} <- function({list_params}) {{\n  {calls}\n}}")
+    }
+  }, funs$name, funs$list_params, funs$calls, funs$roxygen_comment, SIMPLIFY = TRUE)
+
+  out <- glue::trim(out)
   out <- glue::glue_collapse(out, sep = "\n\n")
   unclass(out)
 }
 
+extract_roxygen_comments <- function(file) {
+  lines <- readLines(file)
+  roxygen_start <- grep("^/\\* roxygen start", lines)
+  roxygen_end <- grep("roxygen end \\*/$", lines)
+
+  if (length(roxygen_start) == 0 || length(roxygen_end) == 0) {
+    return(list())
+  }
+
+  roxygen_comments <- mapply(function(start, end) {
+    roxygen_lines <- lines[(start + 1):(end - 1)]
+    roxygen_lines <- sub("^", "#' ", roxygen_lines)
+    list(line = end, text = paste(roxygen_lines, collapse = "\n"))
+  }, roxygen_start, roxygen_end, SIMPLIFY = FALSE)
+
+  roxygen_comments
+}
+
 wrap_call <- function(name, return_type, args) {
   call <- glue::glue('{name}({list_params})', list_params = glue_collapse_data(args, "cpp11::as_cpp<cpp11::decay_t<{type}>>({name})"))
   if (return_type == "void") {

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

README.md

@@ -78,3 +78,13 @@ Please note that the cpp11 project is released with a [Contributor Code of Condu
 
 cpp11 would not exist without Rcpp.
 Thanks to the Rcpp authors, Dirk Eddelbuettel, Romain Francois, JJ Allaire, Kevin Ushey, Qiang Kou, Nathan Russell, Douglas Bates and John Chambers for their work writing and maintaining Rcpp.
+
+## Clang format
+
+To match GHA, use clang-format-12 to format C++ code. With systems that provide clang-format-14 or newer, you can use Docker:
+
+```bash
+docker run --rm -v "$PWD":/work -w /work ubuntu:22.04 bash -lc "\
+  apt-get update && apt-get install -y clang-format-12 && \
+  find . -name '*.cpp' -o -name '*.hpp' -o -name '*.h' | xargs -r clang-format-12 -i"
+```

cpp11test/.Rbuildignore

@@ -0,0 +1,3 @@
+^\.here$
+^bench$
+^LICENSE\.md$

cpp11test/DESCRIPTION

@@ -12,12 +12,14 @@ Authors@R:
 Description: Provides a test suite and benchmarking code for the 'cpp11' package.
 License: MIT + file LICENSE
 Encoding: UTF-8
-LinkingTo: Rcpp, cpp11, testthat
+LinkingTo: cpp11, Rcpp, testthat
+Imports: cpp11, Rcpp
 Suggests:
     covr,
-    testthat,
+    testthat (>= 3.0.0),
     pkgload,
     xml2
 LazyData: true
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.1.1
+RoxygenNote: 7.3.2
+Config/testthat/edition: 3

cpp11test/LICENSE

@@ -0,0 +1,2 @@
+YEAR: 2025
+COPYRIGHT HOLDER: cpp11test authors

cpp11test/LICENSE.md

@@ -0,0 +1,21 @@
+# MIT License
+
+Copyright (c) 2025 cpp11test authors
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.

cpp11test/NAMESPACE

@@ -1,6 +1,12 @@
 # Generated by roxygen2: do not edit by hand
 
+export(roxcpp2_)
+export(roxcpp3_)
+export(roxcpp4_)
+export(roxcpp5_)
+export(roxcpp7_)
 export(run_tests)
 exportPattern("_$")
 importFrom(Rcpp,sourceCpp)
+importFrom(cpp11,cpp_source)
 useDynLib(cpp11test, .registration = TRUE)

cpp11test/R/cpp11.R

@@ -88,6 +88,18 @@ cpp11_insert_ <- function(num_sxp) {
   .Call(`_cpp11test_cpp11_insert_`, num_sxp)
 }
 
+ordered_map_to_list_ <- function(x) {
+  .Call(`_cpp11test_ordered_map_to_list_`, x)
+}
+
+ordered_map_to_list_2_ <- function(x) {
+  .Call(`_cpp11test_ordered_map_to_list_2_`, x)
+}
+
+unordered_map_to_list_ <- function(x) {
+  .Call(`_cpp11test_unordered_map_to_list_`, x)
+}
+
 gibbs_cpp <- function(N, thin) {
   .Call(`_cpp11test_gibbs_cpp`, N, thin)
 }
@@ -156,6 +168,63 @@ rcpp_release_ <- function(n) {
   invisible(.Call(`_cpp11test_rcpp_release_`, n))
 }
 
+notroxcpp1_ <- function(x) {
+  .Call(`_cpp11test_notroxcpp1_`, x)
+}
+
+#' @title Roxygenise C++ function II
+#' @param x numeric value
+#' @description Dummy function to test roxygen2. It adds 2.0 to a double.
+#' @export
+#' @examples roxcpp2_(1.0)
+roxcpp2_ <- function(x) {
+	.Call(`_cpp11test_roxcpp2_`, x)
+}
+
+#' @title Roxygenise C++ function III
+#' @param x numeric value
+#' @description Dummy function to test roxygen2. It adds 3.0 to a double.
+#' @export
+#' @examples roxcpp3_(1.0)
+roxcpp3_ <- function(x) {
+	.Call(`_cpp11test_roxcpp3_`, x)
+}
+
+#' @title Roxygenise C++ function IV
+#' @param x numeric value
+#' @description Dummy function to test roxygen2. It adds 4.0 to a double.
+#' @export
+#' @examples roxcpp4_(1.0)
+roxcpp4_ <- function(x) {
+	.Call(`_cpp11test_roxcpp4_`, x)
+}
+
+#' @title Roxygenise C++ function V
+#' @param x numeric value
+#' @description Dummy function to test roxygen2. It adds 5.0 to a double.
+#' @export
+#' @examples roxcpp5_(1.0)
+roxcpp5_ <- function(x) {
+	.Call(`_cpp11test_roxcpp5_`, x)
+}
+
+notroxcpp6_ <- function(x) {
+  .Call(`_cpp11test_notroxcpp6_`, x)
+}
+
+#' @title Roxygenise C++ function VII
+#' @param x numeric value
+#' @description Dummy function to test roxygen2. It adds 7.0 to a double.
+#' @export
+#' @examples
+#' my_fun <- function(x) {
+#'   roxcpp7_(x)
+#' }
+#' @seealso \code{\link{roxcpp1_}}
+roxcpp7_ <- function(x) {
+	.Call(`_cpp11test_roxcpp7_`, x)
+}
+
 cpp11_safe_ <- function(x_sxp) {
   .Call(`_cpp11test_cpp11_safe_`, x_sxp)
 }
@@ -168,6 +237,26 @@ string_push_back_ <- function() {
   .Call(`_cpp11test_string_push_back_`)
 }
 
+grow_strings_cpp11_ <- function(n, seed) {
+  .Call(`_cpp11test_grow_strings_cpp11_`, n, seed)
+}
+
+grow_strings_rcpp_ <- function(n, seed) {
+  .Call(`_cpp11test_grow_strings_rcpp_`, n, seed)
+}
+
+grow_strings_manual_ <- function(n, seed) {
+  .Call(`_cpp11test_grow_strings_manual_`, n, seed)
+}
+
+assign_cpp11_ <- function(n, seed) {
+  .Call(`_cpp11test_assign_cpp11_`, n, seed)
+}
+
+assign_rcpp_ <- function(n, seed) {
+  .Call(`_cpp11test_assign_rcpp_`, n, seed)
+}
+
 sum_dbl_for_ <- function(x) {
   .Call(`_cpp11test_sum_dbl_for_`, x)
 }
@@ -236,6 +325,14 @@ rcpp_push_and_truncate_ <- function(size_sxp) {
   .Call(`_cpp11test_rcpp_push_and_truncate_`, size_sxp)
 }
 
+nullable_extptr_1 <- function() {
+  .Call(`_cpp11test_nullable_extptr_1`)
+}
+
+nullable_extptr_2 <- function() {
+  .Call(`_cpp11test_nullable_extptr_2`)
+}
+
 test_destruction_inner <- function() {
   invisible(.Call(`_cpp11test_test_destruction_inner`))
 }

cpp11test/R/cpp11test-package.R

@@ -1,6 +1,8 @@
 #' @keywords internal
 #' @exportPattern "_$"
+#' @importFrom cpp11 cpp_source
 #' @importFrom Rcpp sourceCpp
+NULL
 "_PACKAGE"
 
 # The following block is used by usethis to automatically manage

cpp11test/R/test.R

@@ -22,6 +22,5 @@ run_tests <- function(reporter = testthat::default_reporter()) {
   on.exit(setwd(old))
   setwd(system.file("tests", package = "cpp11test"))
 
-  library(testthat)
-  test_check("cpp11test", reporter = reporter)
+  testthat::test_check("cpp11test", reporter = reporter)
 }