diff --git a/.Rbuildignore b/.Rbuildignore index 5c2981ec..903c404e 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -28,8 +28,9 @@ script.R ^doc$ ^Meta$ ^CRAN-SUBMISSION$ -.vscode ^\.cache$ ^docs$ ^pkgdown$ ^\.claude$ +^[.]?air[.]toml$ +^\.vscode$ diff --git a/.github/workflows/rhub.yaml b/.github/workflows/rhub.yaml new file mode 100644 index 00000000..74ec7b05 --- /dev/null +++ b/.github/workflows/rhub.yaml @@ -0,0 +1,95 @@ +# R-hub's generic GitHub Actions workflow file. It's canonical location is at +# https://github.com/r-hub/actions/blob/v1/workflows/rhub.yaml +# You can update this file to a newer version using the rhub2 package: +# +# rhub::rhub_setup() +# +# It is unlikely that you need to modify this file manually. + +name: R-hub +run-name: "${{ github.event.inputs.id }}: ${{ github.event.inputs.name || format('Manually run by {0}', github.triggering_actor) }}" + +on: + workflow_dispatch: + inputs: + config: + description: 'A comma separated list of R-hub platforms to use.' + type: string + default: 'linux,windows,macos' + name: + description: 'Run name. You can leave this empty now.' + type: string + id: + description: 'Unique ID. You can leave this empty now.' + type: string + +jobs: + + setup: + runs-on: ubuntu-latest + outputs: + containers: ${{ steps.rhub-setup.outputs.containers }} + platforms: ${{ steps.rhub-setup.outputs.platforms }} + + steps: + # NO NEED TO CHECKOUT HERE + - uses: r-hub/actions/setup@v1 + with: + config: ${{ github.event.inputs.config }} + id: rhub-setup + + linux-containers: + needs: setup + if: ${{ needs.setup.outputs.containers != '[]' }} + runs-on: ubuntu-latest + name: ${{ matrix.config.label }} + strategy: + fail-fast: false + matrix: + config: ${{ fromJson(needs.setup.outputs.containers) }} + container: + image: ${{ matrix.config.container }} + + steps: + - uses: r-hub/actions/checkout@v1 + - uses: r-hub/actions/platform-info@v1 + with: + token: ${{ secrets.RHUB_TOKEN }} + job-config: ${{ matrix.config.job-config }} + - uses: r-hub/actions/setup-deps@v1 + with: + token: ${{ secrets.RHUB_TOKEN }} + job-config: ${{ matrix.config.job-config }} + - uses: r-hub/actions/run-check@v1 + with: + token: ${{ secrets.RHUB_TOKEN }} + job-config: ${{ matrix.config.job-config }} + + other-platforms: + needs: setup + if: ${{ needs.setup.outputs.platforms != '[]' }} + runs-on: ${{ matrix.config.os }} + name: ${{ matrix.config.label }} + strategy: + fail-fast: false + matrix: + config: ${{ fromJson(needs.setup.outputs.platforms) }} + + steps: + - uses: r-hub/actions/checkout@v1 + - uses: r-hub/actions/setup-r@v1 + with: + job-config: ${{ matrix.config.job-config }} + token: ${{ secrets.RHUB_TOKEN }} + - uses: r-hub/actions/platform-info@v1 + with: + token: ${{ secrets.RHUB_TOKEN }} + job-config: ${{ matrix.config.job-config }} + - uses: r-hub/actions/setup-deps@v1 + with: + job-config: ${{ matrix.config.job-config }} + token: ${{ secrets.RHUB_TOKEN }} + - uses: r-hub/actions/run-check@v1 + with: + job-config: ${{ matrix.config.job-config }} + token: ${{ secrets.RHUB_TOKEN }} diff --git a/DESCRIPTION b/DESCRIPTION index 06255ae3..b5a555d4 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: cpp11 Title: A C++11 Interface for R's C Interface -Version: 0.5.3.9000 +Version: 0.5.5.9000 Authors@R: c( person("Davis", "Vaughan", email = "davis@posit.co", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-4777-038X")), @@ -55,4 +55,4 @@ Config/Needs/cpp11/cpp_register: vctrs Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.3.2 +RoxygenNote: 7.3.3 diff --git a/NEWS.md b/NEWS.md index 90148254..f7e08809 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,17 @@ # cpp11 (development version) +# cpp11 0.5.5 + +* Fixed an issue where `cpp11::stop()` and `cpp11::warning()` calls with the same template instantiation could cause a crash on some systems (#491, #295). + +* `cpp_source()` now works with multiple `file`s (#492). + +# cpp11 0.5.4 + +* Removed non-API usage of `R_NamespaceRegistry`. + +* Fixed a bug with `CPP11_USE_FMT` where the input was not being correctly wrapped in `fmt::runtime()`. + # cpp11 0.5.3 * Removed non-API usage of `ATTRIB()` (#481). diff --git a/R/coverage.R b/R/coverage.R index 03b31424..93a41b82 100644 --- a/R/coverage.R +++ b/R/coverage.R @@ -1,13 +1,23 @@ cpp11_coverage <- function(...) { - old <- options(covr.filter_non_package = FALSE, covr.gcov_additional_paths = ".*/cpp11/") + old <- options( + covr.filter_non_package = FALSE, + covr.gcov_additional_paths = ".*/cpp11/" + ) on.exit(options(old)) cpp11_coverage <- covr::package_coverage(".", ...) cpp11test_coverage <- covr::package_coverage("cpp11test", ...) - cpp11test_coverage <- cpp11test_coverage[grepl("include/cpp11", covr::display_name(cpp11test_coverage))] - attr(cpp11test_coverage, "package")$path <- sub("cpp11/include.*", "cpp11", covr::display_name(cpp11test_coverage)[[1]]) + cpp11test_coverage <- cpp11test_coverage[grepl( + "include/cpp11", + covr::display_name(cpp11test_coverage) + )] + attr(cpp11test_coverage, "package")$path <- sub( + "cpp11/include.*", + "cpp11", + covr::display_name(cpp11test_coverage)[[1]] + ) cov <- c(cpp11_coverage, cpp11test_coverage) attributes(cov) <- attributes(cpp11_coverage) diff --git a/R/register.R b/R/register.R index 3ea10d52..68c7f585 100644 --- a/R/register.R +++ b/R/register.R @@ -36,7 +36,11 @@ #' #' # cleanup #' unlink(dir, recursive = TRUE) -cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(".cpp", ".cc")) { +cpp_register <- function( + path = ".", + quiet = !is_interactive(), + extension = c(".cpp", ".cc") +) { stop_unless_installed(get_cpp_register_needs()) extension <- match.arg(extension) @@ -61,35 +65,53 @@ cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(". cpp_functions_definitions <- generate_cpp_functions(funs, package) - init <- generate_init_functions(get_registered_functions(all_decorations, "cpp11::init", quiet)) + init <- generate_init_functions(get_registered_functions( + all_decorations, + "cpp11::init", + quiet + )) r_functions <- generate_r_functions(funs, package, use_package = FALSE) dir.create(dirname(r_path), recursive = TRUE, showWarnings = FALSE) - brio::write_lines(path = r_path, glue::glue(' + brio::write_lines( + path = r_path, + glue::glue( + ' # Generated by cpp11: do not edit by hand {r_functions} ' - )) + ) + ) if (!quiet) { 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, ' {{ + 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 ", "#include ", "using namespace Rcpp;") + extra_includes <- c( + extra_includes, + "#include ", + "#define RCPP_NO_R_HEADERS_CHECK", + "#include ", + "using namespace Rcpp;" + ) } pkg_types <- c( @@ -109,7 +131,10 @@ cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(". extra_includes <- paste0(extra_includes, collapse = "\n") - brio::write_lines(path = cpp_path, glue::glue(' + brio::write_lines( + path = cpp_path, + glue::glue( + ' // Generated by cpp11: do not edit by hand // clang-format off @@ -130,7 +155,8 @@ cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(". }} ', call_entries = glue::glue_collapse(call_entries, "\n") - )) + ) + ) if (!quiet) { cli::cli_alert_success("generated file {.file {basename(cpp_path)}}") @@ -139,15 +165,41 @@ cpp_register <- function(path = ".", quiet = !is_interactive(), extension = c(". invisible(c(r_path, cpp_path)) } -utils::globalVariables(c("name", "return_type", "line", "decoration", "context", ".", "functions", "res")) - -get_registered_functions <- function(decorations, tag, quiet = !is_interactive()) { +utils::globalVariables(c( + "name", + "return_type", + "line", + "decoration", + "context", + ".", + "functions", + "res" +)) + +get_registered_functions <- function( + decorations, + tag, + quiet = !is_interactive() +) { if (NROW(decorations) == 0) { - return(tibble::tibble(file = character(), line = integer(), decoration = character(), params = list(), context = list(), name = character(), return_type = character(), args = list())) + return(tibble::tibble( + file = character(), + line = integer(), + decoration = character(), + params = list(), + context = list(), + name = character(), + return_type = character(), + args = list() + )) } out <- decorations[decorations$decoration == tag, ] - out$functions <- lapply(out$context, decor::parse_cpp_function, is_attribute = TRUE) + out$functions <- lapply( + out$context, + decor::parse_cpp_function, + is_attribute = TRUE + ) out <- vctrs::vec_cbind(out, vctrs::vec_rbind(!!!out$functions)) out <- out[!(names(out) %in% "functions")] @@ -166,10 +218,17 @@ generate_cpp_functions <- function(funs, package = "cpp11") { funs <- funs[c("name", "return_type", "args", "file", "line", "decoration")] funs$real_params <- vcapply(funs$args, glue_collapse_data, "{type} {name}") funs$sexp_params <- vcapply(funs$args, glue_collapse_data, "SEXP {name}") - funs$calls <- mapply(wrap_call, funs$name, funs$return_type, funs$args, SIMPLIFY = TRUE) + funs$calls <- mapply( + wrap_call, + funs$name, + funs$return_type, + funs$args, + SIMPLIFY = TRUE + ) funs$package <- package - out <- glue::glue_data(funs, + out <- glue::glue_data( + funs, ' // {basename(file)} {return_type} {name}({real_params}); @@ -190,10 +249,15 @@ generate_init_functions <- function(funs) { } funs <- funs[c("name", "return_type", "args", "file", "line", "decoration")] - funs$declaration_params <- vcapply(funs$args, glue_collapse_data, "{type} {name}") + funs$declaration_params <- vcapply( + funs$args, + glue_collapse_data, + "{type} {name}" + ) funs$call_params <- vcapply(funs$args, `[[`, "name") - declarations <- glue::glue_data(funs, + declarations <- glue::glue_data( + funs, ' {return_type} {name}({declaration_params}); ' @@ -201,12 +265,13 @@ generate_init_functions <- function(funs) { declarations <- paste0("\n", glue::glue_collapse(declarations, "\n"), "\n") - calls <- glue::glue_data(funs, + calls <- glue::glue_data( + funs, ' {name}({call_params}); ' ) - calls <- paste0("\n", glue::glue_collapse(calls, "\n")); + calls <- paste0("\n", glue::glue_collapse(calls, "\n")) list( declarations = declarations, @@ -228,24 +293,39 @@ generate_r_functions <- function(funs, package = "cpp11", use_package = FALSE) { 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) + 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}))'), + 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})') ) - out <- glue::glue_data(funs, ' + out <- glue::glue_data( + funs, + ' {name} <- function({list_params}) {{ {calls} }} - ') + ' + ) out <- glue::glue_collapse(out, sep = "\n\n") unclass(out) } wrap_call <- function(name, return_type, args) { - call <- glue::glue('{name}({list_params})', list_params = glue_collapse_data(args, "cpp11::as_cpp>({name})")) + call <- glue::glue( + '{name}({list_params})', + list_params = glue_collapse_data( + args, + "cpp11::as_cpp>({name})" + ) + ) if (return_type == "void") { unclass(glue::glue(" {call};\n return R_NilValue;", .trim = FALSE)) } else { @@ -256,8 +336,10 @@ wrap_call <- function(name, return_type, args) { get_call_entries <- function(path, names, package) { con <- textConnection("res", local = TRUE, open = "w") - withr::with_collate("C", - tools::package_native_routine_registration_skeleton(path, + withr::with_collate( + "C", + tools::package_native_routine_registration_skeleton( + path, con, character_only = FALSE, include_declarations = TRUE @@ -274,7 +356,10 @@ get_call_entries <- function(path, names, package) { return("") } - redundant <- glue::glue_collapse(glue::glue('extern SEXP _{package}_{names}'), sep = '|') + redundant <- glue::glue_collapse( + glue::glue('extern SEXP _{package}_{names}'), + sep = '|' + ) if (length(redundant) > 0 && nzchar(redundant)) { redundant <- paste0("^", redundant) @@ -285,11 +370,15 @@ get_call_entries <- function(path, names, package) { call_calls <- startsWith(res, "extern SEXP") - if(any(call_calls)) { + if (any(call_calls)) { return(res[seq(start, end)]) } - mid <- grep("static const R_CallMethodDef CallEntries[] = {", res, fixed = TRUE) + mid <- grep( + "static const R_CallMethodDef CallEntries[] = {", + res, + fixed = TRUE + ) res[seq(mid, end)] } @@ -301,25 +390,33 @@ pkg_links_to_rcpp <- function(path) { } get_cpp_register_needs <- function() { - res <- read.dcf(system.file("DESCRIPTION", package = "cpp11"))[, "Config/Needs/cpp11/cpp_register"] + res <- read.dcf(system.file("DESCRIPTION", package = "cpp11"))[, + "Config/Needs/cpp11/cpp_register" + ] strsplit(res, "[[:space:]]*,[[:space:]]*")[[1]] } check_valid_attributes <- function(decorations, file = decorations$file) { - bad_decor <- startsWith(decorations$decoration, "cpp11::") & - (!decorations$decoration %in% c("cpp11::register", "cpp11::init", "cpp11::linking_to")) + (!decorations$decoration %in% + c("cpp11::register", "cpp11::init", "cpp11::linking_to")) - if(any(bad_decor)) { + if (any(bad_decor)) { lines <- decorations$line[bad_decor] names <- decorations$decoration[bad_decor] - bad_lines <- glue::glue_collapse(glue::glue("- Invalid attribute `{names}` on - line {lines} in file '{file}'."), "\n") + bad_lines <- glue::glue_collapse( + glue::glue( + "- Invalid attribute `{names}` on + line {lines} in file '{file}'." + ), + "\n" + ) - msg <- glue::glue("cpp11 attributes must be one of `cpp11::register`, `cpp11::init` or `cpp11::linking_to`: + msg <- glue::glue( + "cpp11 attributes must be one of `cpp11::register`, `cpp11::init` or `cpp11::linking_to`: {bad_lines} - ") + " + ) stop(msg, call. = FALSE) - } } diff --git a/R/source.R b/R/source.R index fc9124d5..1d4fe236 100644 --- a/R/source.R +++ b/R/source.R @@ -1,6 +1,6 @@ #' 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. #' @@ -8,7 +8,7 @@ #' 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 @@ -65,9 +65,28 @@ #' } #' #' @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)) { +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) && !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 +102,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 = "/") @@ -109,11 +129,22 @@ cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, qu #provide original path for error messages check_valid_attributes(all_decorations, file = orig_file_path) - funs <- get_registered_functions(all_decorations, "cpp11::register", quiet = quiet) + 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") - brio::write_lines(c('#include "cpp11/declarations.hpp"', "using namespace ::cpp11;", cpp_functions_definitions), cpp_path) + 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") @@ -123,47 +154,90 @@ cpp_source <- function(file, code = NULL, env = parent.frame(), clean = TRUE, qu on.exit(unlink(dir, recursive = TRUE), add = TRUE) } - r_functions <- generate_r_functions(funs, package = package, use_package = TRUE) + r_functions <- generate_r_functions( + funs, + package = package, + use_package = TRUE + ) makevars_content <- generate_makevars(includes, cxx_std) 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 # Substitute temporary file path with original file path - error_messages <- gsub(tools::file_path_sans_ext(new_file_path), tools::file_path_sans_ext(orig_file_path), error_messages, fixed = TRUE) + error_messages <- gsub( + tools::file_path_sans_ext(new_file_path), + tools::file_path_sans_ext(orig_file_path), + error_messages, + fixed = TRUE + ) cat(error_messages) 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)) @@ -178,18 +252,32 @@ generate_include_paths <- function(packages) { } generate_makevars <- function(includes, cxx_std) { - c(sprintf("CXX_STD=%s", cxx_std), sprintf("PKG_CPPFLAGS=%s", paste0(includes, collapse = " "))) + c( + sprintf("CXX_STD=%s", cxx_std), + sprintf("PKG_CPPFLAGS=%s", paste0(includes, collapse = " ")) + ) } #' @rdname cpp_source #' @export -cpp_function <- function(code, env = parent.frame(), clean = TRUE, quiet = TRUE, cxx_std = Sys.getenv("CXX_STD", "CXX11")) { - cpp_source(code = paste(c('#include "cpp11.hpp"', +cpp_function <- function( + code, + env = parent.frame(), + clean = TRUE, + quiet = TRUE, + cxx_std = Sys.getenv("CXX_STD", "CXX11") +) { + cpp_source( + code = paste( + c( + '#include "cpp11.hpp"', "using namespace ::cpp11;", "namespace writable = ::cpp11::writable;", "[[cpp11::register]]", - code), - collapse = "\n"), + code + ), + collapse = "\n" + ), env = env, clean = clean, quiet = quiet, @@ -201,16 +289,27 @@ 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_source(code = paste(c('#include "cpp11.hpp"', +cpp_eval <- function( + code, + env = parent.frame(), + clean = TRUE, + quiet = TRUE, + cxx_std = Sys.getenv("CXX_STD", "CXX11") +) { + cpp_source( + code = paste( + c( + '#include "cpp11.hpp"', "using namespace ::cpp11;", "namespace writable = ::cpp11::writable;", "[[cpp11::register]]", "SEXP f() { return as_sexp(", code, ");", - "}"), - collapse = "\n"), + "}" + ), + collapse = "\n" + ), env = env, clean = clean, quiet = quiet, diff --git a/R/utils.R b/R/utils.R index 85f4ff30..1295546e 100644 --- a/R/utils.R +++ b/R/utils.R @@ -23,7 +23,10 @@ stop_unless_installed <- function(pkgs) { ) if (is_interactive()) { - ans <- readline(paste(c(msg, "Would you like to install them? (y/N) "), collapse = "\n")) + ans <- readline(paste( + c(msg, "Would you like to install them? (y/N) "), + collapse = "\n" + )) if (tolower(ans) == "y") { utils::install.packages(pkgs[!has_pkg]) stop_unless_installed(pkgs) @@ -43,18 +46,18 @@ is_windows <- function() { # use for stop_if_not_installed(), because rlang itself could be one of the # input pkgs. is_interactive <- function() { - opt <- getOption("rlang_interactive", NULL) - if (!is.null(opt)) { - return(opt) - } - if (isTRUE(getOption("knitr.in.progress"))) { - return(FALSE) - } - if (isTRUE(getOption("rstudio.notebook.executing"))) { - return(FALSE) - } - if (identical(Sys.getenv("TESTTHAT"), "true")) { - return(FALSE) - } - interactive() + opt <- getOption("rlang_interactive", NULL) + if (!is.null(opt)) { + return(opt) + } + if (isTRUE(getOption("knitr.in.progress"))) { + return(FALSE) + } + if (isTRUE(getOption("rstudio.notebook.executing"))) { + return(FALSE) + } + if (identical(Sys.getenv("TESTTHAT"), "true")) { + return(FALSE) + } + interactive() } diff --git a/R/vendor.R b/R/vendor.R index 5fe10fe2..1d7dc7d2 100644 --- a/R/vendor.R +++ b/R/vendor.R @@ -34,10 +34,17 @@ cpp_vendor <- function(path = ".") { new <- file.path(path, "inst", "include", "cpp11") if (dir.exists(new)) { - stop("'", new, "' already exists\n * run unlink('", new, "', recursive = TRUE)", call. = FALSE) + stop( + "'", + new, + "' already exists\n * run unlink('", + new, + "', recursive = TRUE)", + call. = FALSE + ) } - dir.create(new , recursive = TRUE, showWarnings = FALSE) + dir.create(new, recursive = TRUE, showWarnings = FALSE) current <- system.file("include", "cpp11", package = "cpp11") if (!nzchar(current)) { @@ -46,12 +53,19 @@ cpp_vendor <- function(path = ".") { cpp11_version <- utils::packageVersion("cpp11") - cpp11_header <- sprintf("// cpp11 version: %s\n// vendored on: %s", cpp11_version, Sys.Date()) + cpp11_header <- sprintf( + "// cpp11 version: %s\n// vendored on: %s", + cpp11_version, + Sys.Date() + ) files <- list.files(current, full.names = TRUE) writeLines( - c(cpp11_header, readLines(system.file("include", "cpp11.hpp", package = "cpp11"))), + c( + cpp11_header, + readLines(system.file("include", "cpp11.hpp", package = "cpp11")) + ), file.path(dirname(new), "cpp11.hpp") ) diff --git a/README.md b/README.md index 68d1708b..8cc591b2 100644 --- a/README.md +++ b/README.md @@ -19,7 +19,7 @@ LinkingTo: cpp11 ``` Then decorate C++ functions you want to expose to R with `[[cpp11::register]]`. -*Note that this is a [C++11 attribute](https://en.cppreference.com/w/cpp/language/attributes.html), not a comment like is used in Rcpp.* +*Note that this is a [C++11 attribute](https://en.cppreference.com/cpp/language/attributes.html), not a comment like is used in Rcpp.* cpp11 is a header only library with no hard dependencies and does not use a shared library, so it is straightforward and reliable to use in packages without fear of compile-time and run-time mismatches. diff --git a/air.toml b/air.toml new file mode 100644 index 00000000..e69de29b diff --git a/cpp11test/DESCRIPTION b/cpp11test/DESCRIPTION index d1d05665..efde1512 100644 --- a/cpp11test/DESCRIPTION +++ b/cpp11test/DESCRIPTION @@ -1,7 +1,7 @@ Package: cpp11test Title: A test suite and benchmark code for 'cpp11' Version: 0.0.0.9000 -Authors@R: +Authors@R: c(person(given = "Jim", family = "Hester", role = c("aut", "cre"), @@ -21,3 +21,4 @@ Suggests: LazyData: true Roxygen: list(markdown = TRUE) RoxygenNote: 7.1.1 +Config/testthat/edition: 3 diff --git a/cpp11test/R/cpp11.R b/cpp11test/R/cpp11.R index 038e7b76..d23a589b 100644 --- a/cpp11test/R/cpp11.R +++ b/cpp11test/R/cpp11.R @@ -236,6 +236,14 @@ rcpp_push_and_truncate_ <- function(size_sxp) { .Call(`_cpp11test_rcpp_push_and_truncate_`, size_sxp) } +test_template_stop <- function() { + invisible(.Call(`_cpp11test_test_template_stop`)) +} + +test_template_warning <- function() { + invisible(.Call(`_cpp11test_test_template_warning`)) +} + test_destruction_inner <- function() { invisible(.Call(`_cpp11test_test_destruction_inner`)) } diff --git a/cpp11test/bench/grow.R b/cpp11test/bench/grow.R index 5fcfbb46..201be44c 100644 --- a/cpp11test/bench/grow.R +++ b/cpp11test/bench/grow.R @@ -1,9 +1,7 @@ pkgload::load_all("cpp11test") -bench::press(len = 10 ^ (0:7), - { - bench::mark( - grow_(len) - ) - } -) +bench::press(len = 10^(0:7), { + bench::mark( + grow_(len) + ) +}) diff --git a/cpp11test/bench/protect.R b/cpp11test/bench/protect.R index 989a8e1c..f79a3b0d 100644 --- a/cpp11test/bench/protect.R +++ b/cpp11test/bench/protect.R @@ -1,6 +1,7 @@ pkgload::load_all("cpp11test") -bench::press(n = 10000, +bench::press( + n = 10000, bench::mark( protect_one_(1:10, n), protect_one_cpp11_(1:10, n), @@ -9,7 +10,8 @@ bench::press(n = 10000, ) ) -bench::press(n = 10000, +bench::press( + n = 10000, bench::mark( protect_many_(n), protect_many_cpp11_(n), diff --git a/cpp11test/bench/sum.R b/cpp11test/bench/sum.R index d65e5d98..76ac3a41 100644 --- a/cpp11test/bench/sum.R +++ b/cpp11test/bench/sum.R @@ -8,13 +8,15 @@ cases <- expand.grid( ) # Add special case -cases <- do.call(rbind, +cases <- do.call( + rbind, list( list(len = 3e6, vector = "normal", method = "for2"), list(len = 3e6, vector = "normal", method = "foreach2"), list(len = 3e6, vector = "altrep", method = "foreach2"), - cases) + cases ) +) bench::press( .grid = cases, diff --git a/cpp11test/bench/truncate.R b/cpp11test/bench/truncate.R index a074e430..0b0b0ee4 100644 --- a/cpp11test/bench/truncate.R +++ b/cpp11test/bench/truncate.R @@ -1,18 +1,16 @@ pkgload::load_all("cpp11test") -bench::press(len = as.integer(10 ^ (0:6)), - { - bench::mark( - cpp11 = cpp11_push_and_truncate_(len), - rcpp = rcpp_push_and_truncate_(len), - check = FALSE, - min_iterations = 1000 - ) - } -)[c("expression", "len", "min", "mem_alloc", "n_itr", "n_gc")] +bench::press(len = as.integer(10^(0:6)), { + bench::mark( + cpp11 = cpp11_push_and_truncate_(len), + rcpp = rcpp_push_and_truncate_(len), + check = FALSE, + min_iterations = 1000 + ) +})[c("expression", "len", "min", "mem_alloc", "n_itr", "n_gc")] # Longer benchmark, lots of gc -len <- as.integer(10 ^ 7) +len <- as.integer(10^7) bench::mark( cpp11 = cpp11_push_and_truncate_(len), rcpp = rcpp_push_and_truncate_(len), diff --git a/cpp11test/src/cpp11.cpp b/cpp11test/src/cpp11.cpp index 421de637..9f813844 100644 --- a/cpp11test/src/cpp11.cpp +++ b/cpp11test/src/cpp11.cpp @@ -2,6 +2,7 @@ // clang-format off #include +#define RCPP_NO_R_HEADERS_CHECK #include using namespace Rcpp; #include "cpp11/declarations.hpp" @@ -443,6 +444,22 @@ extern "C" SEXP _cpp11test_rcpp_push_and_truncate_(SEXP size_sxp) { return cpp11::as_sexp(rcpp_push_and_truncate_(cpp11::as_cpp>(size_sxp))); END_CPP11 } +// template-1-stop.cpp +void test_template_stop(); +extern "C" SEXP _cpp11test_test_template_stop() { + BEGIN_CPP11 + test_template_stop(); + return R_NilValue; + END_CPP11 +} +// template-2-warn.cpp +void test_template_warning(); +extern "C" SEXP _cpp11test_test_template_warning() { + BEGIN_CPP11 + test_template_warning(); + return R_NilValue; + END_CPP11 +} // test-protect-nested.cpp void test_destruction_inner(); extern "C" SEXP _cpp11test_test_destruction_inner() { @@ -533,6 +550,8 @@ static const R_CallMethodDef CallEntries[] = { {"_cpp11test_sum_int_foreach_", (DL_FUNC) &_cpp11test_sum_int_foreach_, 1}, {"_cpp11test_test_destruction_inner", (DL_FUNC) &_cpp11test_test_destruction_inner, 0}, {"_cpp11test_test_destruction_outer", (DL_FUNC) &_cpp11test_test_destruction_outer, 0}, + {"_cpp11test_test_template_stop", (DL_FUNC) &_cpp11test_test_template_stop, 0}, + {"_cpp11test_test_template_warning", (DL_FUNC) &_cpp11test_test_template_warning, 0}, {"_cpp11test_upper_bound", (DL_FUNC) &_cpp11test_upper_bound, 2}, {"run_testthat_tests", (DL_FUNC) &run_testthat_tests, 1}, {NULL, NULL, 0} diff --git a/cpp11test/src/find-intervals.cpp b/cpp11test/src/find-intervals.cpp index 0e7933e2..0c9ebcaa 100644 --- a/cpp11test/src/find-intervals.cpp +++ b/cpp11test/src/find-intervals.cpp @@ -2,6 +2,7 @@ #include "cpp11.hpp" using namespace cpp11; +#define RCPP_NO_R_HEADERS_CHECK #include #include using namespace Rcpp; diff --git a/cpp11test/src/matrix.cpp b/cpp11test/src/matrix.cpp index 10348945..82583cda 100644 --- a/cpp11test/src/matrix.cpp +++ b/cpp11test/src/matrix.cpp @@ -32,6 +32,7 @@ using namespace cpp11; return mat; } +#define RCPP_NO_R_HEADERS_CHECK #include using namespace Rcpp; diff --git a/cpp11test/src/protect.cpp b/cpp11test/src/protect.cpp index bb4ef934..f1ece491 100644 --- a/cpp11test/src/protect.cpp +++ b/cpp11test/src/protect.cpp @@ -1,7 +1,8 @@ #include #include -#include "Rcpp.h" +#define RCPP_NO_R_HEADERS_CHECK +#include [[cpp11::register]] void protect_one_(SEXP x, int n) { for (R_xlen_t i = 0; i < n; ++i) { diff --git a/cpp11test/src/release.cpp b/cpp11test/src/release.cpp index 7b321e45..03d158de 100644 --- a/cpp11test/src/release.cpp +++ b/cpp11test/src/release.cpp @@ -1,7 +1,8 @@ #include #include "cpp11/sexp.hpp" -#include "Rcpp.h" +#define RCPP_NO_R_HEADERS_CHECK +#include [[cpp11::register]] void cpp11_release_(int n) { std::vector x; diff --git a/cpp11test/src/template-1-stop.cpp b/cpp11test/src/template-1-stop.cpp new file mode 100644 index 00000000..14c5d369 --- /dev/null +++ b/cpp11test/src/template-1-stop.cpp @@ -0,0 +1,3 @@ +#include "cpp11/protect.hpp" + +[[cpp11::register]] void test_template_stop() { cpp11::stop("%s", "stop"); } diff --git a/cpp11test/src/template-2-warn.cpp b/cpp11test/src/template-2-warn.cpp new file mode 100644 index 00000000..da5a2e18 --- /dev/null +++ b/cpp11test/src/template-2-warn.cpp @@ -0,0 +1,3 @@ +#include "cpp11/protect.hpp" + +[[cpp11::register]] void test_template_warning() { cpp11::warning("%s", "warning"); } diff --git a/cpp11test/src/test-as.cpp b/cpp11test/src/test-as.cpp index 798596a2..6fef6473 100644 --- a/cpp11test/src/test-as.cpp +++ b/cpp11test/src/test-as.cpp @@ -7,7 +7,8 @@ #include -#include "Rcpp.h" +#define RCPP_NO_R_HEADERS_CHECK +#include context("as_cpp-C++") { test_that("as_cpp(INTSEXP)") { diff --git a/cpp11test/tests/testthat/_snaps/template.md b/cpp11test/tests/testthat/_snaps/template.md new file mode 100644 index 00000000..0ab5c38d --- /dev/null +++ b/cpp11test/tests/testthat/_snaps/template.md @@ -0,0 +1,16 @@ +# equivalently templated `cpp11::stop()` and `cpp11::warning()` can coexist (#491) + + Code + test_template_stop() + Condition + Error: + ! stop + +--- + + Code + test_template_warning() + Condition + Warning: + warning + diff --git a/cpp11test/tests/testthat/test-doubles.R b/cpp11test/tests/testthat/test-doubles.R index a7016bd0..fa5197f7 100644 --- a/cpp11test/tests/testthat/test-doubles.R +++ b/cpp11test/tests/testthat/test-doubles.R @@ -1,5 +1,4 @@ test_that("doubles iterators work with normal vectors", { - len <- 1e5 set.seed(42) x <- rnorm(len) @@ -12,7 +11,6 @@ test_that("doubles iterators work with normal vectors", { }) test_that("doubles iterators work with altrep vectors", { - len <- 1e5 seq_double <- function(x) as.double(seq_len(x)) diff --git a/cpp11test/tests/testthat/test-matrix.R b/cpp11test/tests/testthat/test-matrix.R index a43f59b0..34df89ca 100644 --- a/cpp11test/tests/testthat/test-matrix.R +++ b/cpp11test/tests/testthat/test-matrix.R @@ -7,7 +7,7 @@ test_that("row_sums gives same result as rowSums", { expect_equal(row_sums(x), rowSums(x)) y <- cbind(x1 = 3, x2 = c(4:1, 2:5)) - y[3, ] <- NA; + y[3, ] <- NA expect_equal(row_sums(y), rowSums(y)) }) @@ -20,6 +20,6 @@ test_that("col_sums gives same result as colSums", { expect_equal(col_sums(x), colSums(x)) y <- cbind(3, c(4:1, 2:5)) - y[3, ] <- NA; + y[3, ] <- NA expect_equal(col_sums(y), colSums(y)) }) diff --git a/cpp11test/tests/testthat/test-template.R b/cpp11test/tests/testthat/test-template.R new file mode 100644 index 00000000..4b753beb --- /dev/null +++ b/cpp11test/tests/testthat/test-template.R @@ -0,0 +1,13 @@ +test_that("equivalently templated `cpp11::stop()` and `cpp11::warning()` can coexist (#491)", { + # It is important the the C++ files be named `template-1-stop` and + # `template-2-warn` because the `cpp11::stop()` call needs to be linked in + # before the `cpp11::warning()` call to reproduce the original issue, + # otherwise the templates underlying `cpp11::warning()` will get instantiated + # first and be reused in `cpp11::stop()` via ODR and that "works" fine. + expect_snapshot(error = TRUE, { + test_template_stop() + }) + expect_snapshot({ + test_template_warning() + }) +}) diff --git a/cpp11test/tests/testthat/test_formatted_errors.R b/cpp11test/tests/testthat/test_formatted_errors.R index f4cfa8e5..34ac4cef 100644 --- a/cpp11test/tests/testthat/test_formatted_errors.R +++ b/cpp11test/tests/testthat/test_formatted_errors.R @@ -1,43 +1,94 @@ test_that("cpp11::stop formatting works", { test1 <- 4 expect_error(my_stop_n1("This is a stop"), "This is a stop", fixed = TRUE) - expect_error(my_stop("Your number is {}", test1), "Your number is 4", fixed = TRUE) + expect_error( + my_stop("Your number is {}", test1), + "Your number is 4", + fixed = TRUE + ) test2 <- c(3, 5, 7) - expect_error(my_stop("You've tested this {} times", test2[1]), "You've tested this 3 times", - fixed = TRUE) + expect_error( + my_stop("You've tested this {} times", test2[1]), + "You've tested this 3 times", + fixed = TRUE + ) }) test_that("cpp11::warning formatting works", { test1 <- "warning" - expect_warning(my_warning_n1("This is a warning"), "This is a warning", fixed = TRUE) - expect_warning(my_warning("This is a {}", test1), "This is a warning", fixed = TRUE) + expect_warning( + my_warning_n1("This is a warning"), + "This is a warning", + fixed = TRUE + ) + expect_warning( + my_warning("This is a {}", test1), + "This is a warning", + fixed = TRUE + ) test2 <- c("failed", "passed") expect_warning(my_warning("You {}", test2[2]), "You passed", fixed = TRUE) }) test_that("cpp11::message formatting works", { test1 <- "message" - expect_message(my_message_n1("This is a message"), "This is a message", fixed = TRUE) - expect_message(my_message("This is a {}", test1), "This is a message", fixed = TRUE) + expect_message( + my_message_n1("This is a message"), + "This is a message", + fixed = TRUE + ) + expect_message( + my_message("This is a {}", test1), + "This is a message", + fixed = TRUE + ) test2 <- c("great", "super") - expect_message(my_message("You're {}", test2[2]), "You're super", fixed = TRUE) + expect_message( + my_message("You're {}", test2[2]), + "You're super", + fixed = TRUE + ) }) test_that("cpp11::stop works without including the fmt library", { test1 <- "error" expect_error(my_stop_n1fmt("This is a stop"), "This is a stop", fixed = TRUE) - expect_error(my_stop_n2fmt("This is an %s", test1), "This is an error", fixed = TRUE) + expect_error( + my_stop_n2fmt("This is an %s", test1), + "This is an error", + fixed = TRUE + ) }) test_that("cpp11::warning works without including the fmt library", { test1 <- "warning" - expect_warning(my_warning_n1fmt("This is a warning"), "This is a warning", fixed = TRUE) - expect_warning(my_warning_n2fmt("This is a %s", test1), "This is a warning", fixed = TRUE) + expect_warning( + my_warning_n1fmt("This is a warning"), + "This is a warning", + fixed = TRUE + ) + expect_warning( + my_warning_n2fmt("This is a %s", test1), + "This is a warning", + fixed = TRUE + ) }) test_that("cpp11::message works without including the fmt library", { test1 <- "message" - expect_message(my_message_n1fmt("This is a message"), "This is a message", fixed = TRUE) - expect_message(my_message_n2fmt("This is a %s", test1), "This is a message", fixed = TRUE) + expect_message( + my_message_n1fmt("This is a message"), + "This is a message", + fixed = TRUE + ) + expect_message( + my_message_n2fmt("This is a %s", test1), + "This is a message", + fixed = TRUE + ) test2 <- c("great", "super") - expect_message(my_message_n2fmt("You're %s", test2[2]), "You're super", fixed = TRUE) + expect_message( + my_message_n2fmt("You're %s", test2[2]), + "You're super", + fixed = TRUE + ) }) diff --git a/cran-comments.md b/cran-comments.md index d0f3a363..d77a8071 100644 --- a/cran-comments.md +++ b/cran-comments.md @@ -1 +1,3 @@ This is a release with no expected breakage of any reverse dependencies. + +Note that all URLs under https://en.cppreference.com are valid and useful, but may 403 with CRAN's URL checking system due to a new "validate that you are human" check. diff --git a/inst/include/cpp11/R.hpp b/inst/include/cpp11/R.hpp index c10c7630..f6a398d3 100644 --- a/inst/include/cpp11/R.hpp +++ b/inst/include/cpp11/R.hpp @@ -113,6 +113,29 @@ inline bool r_env_has(SEXP env, SEXP sym) { #endif } +/// Get a namespace from the namespace registry +/// +/// Returns `R_NilValue` if the namespace is not in the registry, i.e. if the package has +/// not been loaded yet. +/// +/// Unlike `R_FindNamespace()`, does not attempt to load the package, does not error when +/// the namespace can't be found, and does not go through R. +/// +/// SAFETY: Keep as a pure C function. Call like an R API function, i.e. wrap in `safe[]` +/// as required. +inline SEXP r_ns_env(const char* name) { +#if R_VERSION >= R_Version(4, 6, 0) + return R_getRegisteredNamespace(name); +#else + SEXP sym = Rf_install(name); + if (r_env_has(R_NamespaceRegistry, sym)) { + return r_env_get(R_NamespaceRegistry, sym); + } else { + return R_NilValue; + } +#endif +} + } // namespace detail template diff --git a/inst/include/cpp11/external_pointer.hpp b/inst/include/cpp11/external_pointer.hpp index a62134ec..fed13d89 100644 --- a/inst/include/cpp11/external_pointer.hpp +++ b/inst/include/cpp11/external_pointer.hpp @@ -55,8 +55,9 @@ class external_pointer { external_pointer(SEXP data) : data_(valid_type(data)) {} - external_pointer(pointer p, bool use_deleter = true, bool finalize_on_exit = true) - : data_(safe[R_MakeExternalPtr]((void*)p, R_NilValue, R_NilValue)) { + external_pointer(pointer p, bool use_deleter = true, bool finalize_on_exit = true, + SEXP prot = R_NilValue) + : data_(safe[R_MakeExternalPtr]((void*)p, R_NilValue, prot)) { if (use_deleter) { R_RegisterCFinalizerEx(data_, r_deleter, static_cast(finalize_on_exit)); } diff --git a/inst/include/cpp11/function.hpp b/inst/include/cpp11/function.hpp index cc5af071..23820ea2 100644 --- a/inst/include/cpp11/function.hpp +++ b/inst/include/cpp11/function.hpp @@ -8,9 +8,14 @@ #include "cpp11/R.hpp" // for SEXP, SEXPREC, CDR, Rf_install, SETCAR #include "cpp11/as.hpp" // for as_sexp #include "cpp11/named_arg.hpp" // for named_arg -#include "cpp11/protect.hpp" // for protect, protect::function, safe +#include "cpp11/protect.hpp" // for protect, protect::function, safe, stop #include "cpp11/sexp.hpp" // for sexp +#ifdef CPP11_USE_FMT +#define FMT_HEADER_ONLY +#include "fmt/core.h" +#endif + namespace cpp11 { class function { @@ -66,8 +71,11 @@ class package { if (strcmp(name, "base") == 0) { return R_BaseEnv; } - sexp name_sexp = safe[Rf_install](name); - return safe[detail::r_env_get](R_NamespaceRegistry, name_sexp); + SEXP env = safe[detail::r_ns_env](name); + if (env == R_NilValue) { + stop("Can't find namespace: '%s'.", name); + } + return env; } // Either base env or in namespace registry, so no protection needed @@ -106,7 +114,7 @@ inline void r_message(const char* x) { inline void message(const char* fmt_arg) { #ifdef CPP11_USE_FMT - std::string msg = fmt::format(fmt_arg); + std::string msg = fmt::format(fmt::runtime(fmt_arg)); safe[detail::r_message](msg.c_str()); #else char buff[1024]; @@ -121,7 +129,7 @@ inline void message(const char* fmt_arg) { template void message(const char* fmt_arg, Args... args) { #ifdef CPP11_USE_FMT - std::string msg = fmt::format(fmt_arg, args...); + std::string msg = fmt::format(fmt::runtime(fmt_arg), args...); safe[detail::r_message](msg.c_str()); #else char buff[1024]; diff --git a/inst/include/cpp11/protect.hpp b/inst/include/cpp11/protect.hpp index 9cb4876a..e3b8ce81 100644 --- a/inst/include/cpp11/protect.hpp +++ b/inst/include/cpp11/protect.hpp @@ -95,6 +95,52 @@ unwind_protect(Fun&& code) { namespace detail { +// Tag types to force templated `struct closure` and `apply()` infrastructure shared +// across `struct function` and `struct noreturn_function` to generate different +// attribute specific `struct closure` and `apply()` variants. +// +// Consider: +// +// ``` +// cpp11::stop("error: %s", message) +// cpp11::warning("warning: %s", message) +// ``` +// +// These both end up constructing the exact same templated `struct closure` and `apply()` +// functions. The `args` for the underlying `Rf_errorcall()` and `Rf_warningcall()` are: +// - `R_NilValue` +// - `const char* fmt` +// - `const char* message` +// +// The only difference is that `cpp11::stop()` is marked as `[[noreturn]]` because the +// underlying `Rf_errorcall()` is also marked as `[[noreturn]]` / +// `__attribute__((noreturn))`. +// +// But this causes issues! Due to C++'s ODR (One Definition Rule), only 1 variant of +// `apply()` and `struct closure` can be created per template combination. If the +// `cpp11::stop()` variant is linked in first, then some compilers use the `[[noreturn]]` +// hint on `cpp11::stop()` and `operator()` of `noreturn_function` to assert that the +// `apply()` function also cannot return, and returning is deemed unreachable. So then +// when `cpp11::warning()` tries to return from its call to `apply()`, a crash occurs. We +// see this output under ASAN: `execution reached an unreachable program point`. +// +// We've seen this issue on macOS and Linux under clang (gcc does not seem to reproduce +// this). To reproduce, you must have `cpp11::stop()` and `cpp11::warning()` calls in +// different translation units / files and the file containing `cpp11::stop()` must be +// linked first. Putting it first alphabetically seems to be enough, which is why we have +// `template-1-stop.cpp` and `template-2-warn.cpp` in our tests, along with +// `test-template.R` to test this exact issue. You also need to compile with `-O0`, +// otherwise you'll just get a hang rather than a crash. +// +// Adding the tag into the template definition forces `safe[fn]()` and +// `safe.noreturn[fn]()` calls to generate different `apply()` variants, avoiding this +// issue. +// +// https://github.com/r-lib/cpp11/issues/491 +// https://github.com/r-lib/cpp11/issues/295 +struct return_tag {}; +struct no_return_tag {}; + template struct index_sequence { using type = index_sequence; @@ -113,29 +159,30 @@ struct make_index_sequence template <> struct make_index_sequence<0> : index_sequence<> {}; -template +template decltype(std::declval()(std::declval()...)) apply( F&& f, std::tuple&& a, const index_sequence&) { return std::forward(f)(std::get(std::move(a))...); } -template +template decltype(std::declval()(std::declval()...)) apply(F&& f, std::tuple&& a) { - return apply(std::forward(f), std::move(a), make_index_sequence{}); + return apply(std::forward(f), std::move(a), + make_index_sequence{}); } // overload to silence a compiler warning that the (empty) tuple parameter is set but // unused -template +template decltype(std::declval()()) apply(F&& f, std::tuple<>&&) { return std::forward(f)(); } -template +template struct closure { decltype(std::declval()(std::declval()...)) operator()() && { - return apply(ptr_, std::move(arefs_)); + return apply(ptr_, std::move(arefs_)); } F* ptr_; std::tuple arefs_; @@ -149,17 +196,13 @@ struct protect { template decltype(std::declval()(std::declval()...)) operator()(A&&... a) const { // workaround to support gcc4.8, which can't capture a parameter pack - return unwind_protect( - detail::closure{ptr_, std::forward_as_tuple(std::forward(a)...)}); + return unwind_protect(detail::closure{ + ptr_, std::forward_as_tuple(std::forward(a)...)}); } F* ptr_; }; - /// May not be applied to a function bearing attributes, which interfere with linkage on - /// some compilers; use an appropriately attributed alternative. (For example, Rf_error - /// bears the [[noreturn]] attribute and must be protected with safe.noreturn rather - /// than safe.operator[]). template constexpr function operator[](F* raw) const { return {raw}; @@ -170,8 +213,8 @@ struct protect { template void operator() [[noreturn]] (A&&... a) const { // workaround to support gcc4.8, which can't capture a parameter pack - unwind_protect( - detail::closure{ptr_, std::forward_as_tuple(std::forward(a)...)}); + unwind_protect(detail::closure{ + ptr_, std::forward_as_tuple(std::forward(a)...)}); // Compiler hint to allow [[noreturn]] attribute; this is never executed since // the above call will not return. throw std::runtime_error("[[noreturn]]"); @@ -179,6 +222,9 @@ struct protect { F* ptr_; }; + // To be used when wrapping functions tagged with `[[noreturn]]`, such as + // `Rf_errorcall()`, to force generation of attribute specific `struct closure` and + // `apply()` variants, see `struct return_tag` documentation for more details. template constexpr noreturn_function noreturn(F* raw) const { return {raw}; @@ -191,25 +237,25 @@ inline void check_user_interrupt() { safe[R_CheckUserInterrupt](); } #ifdef CPP11_USE_FMT template void stop [[noreturn]] (const char* fmt_arg, Args&&... args) { - std::string msg = fmt::format(fmt_arg, std::forward(args)...); + std::string msg = fmt::format(fmt::runtime(fmt_arg), std::forward(args)...); safe.noreturn(Rf_errorcall)(R_NilValue, "%s", msg.c_str()); } template void stop [[noreturn]] (const std::string& fmt_arg, Args&&... args) { - std::string msg = fmt::format(fmt_arg, std::forward(args)...); + std::string msg = fmt::format(fmt::runtime(fmt_arg), std::forward(args)...); safe.noreturn(Rf_errorcall)(R_NilValue, "%s", msg.c_str()); } template void warning(const char* fmt_arg, Args&&... args) { - std::string msg = fmt::format(fmt_arg, std::forward(args)...); + std::string msg = fmt::format(fmt::runtime(fmt_arg), std::forward(args)...); safe[Rf_warningcall](R_NilValue, "%s", msg.c_str()); } template void warning(const std::string& fmt_arg, Args&&... args) { - std::string msg = fmt::format(fmt_arg, std::forward(args)...); + std::string msg = fmt::format(fmt::runtime(fmt_arg), std::forward(args)...); safe[Rf_warningcall](R_NilValue, "%s", msg.c_str()); } #else diff --git a/man/cpp_source.Rd b/man/cpp_source.Rd index 87164ef5..031d8670 100644 --- a/man/cpp_source.Rd +++ b/man/cpp_source.Rd @@ -33,7 +33,7 @@ cpp_eval( ) } \arguments{ -\item{file}{A file containing C++ code to compile} +\item{file}{One or more files containing C++ code to compile} \item{code}{If non-null, the C++ code to compile} @@ -56,7 +56,7 @@ For \code{\link[=cpp_source]{cpp_source()}} and \verb{[cpp_function()]} the resu expression. } \description{ -\code{\link[=cpp_source]{cpp_source()}} compiles and loads a single C++ file for use in R. +\code{\link[=cpp_source]{cpp_source()}} compiles and loads one or more C++ files for use in R. \code{\link[=cpp_function]{cpp_function()}} compiles and loads a single function for use in R. \code{\link[=cpp_eval]{cpp_eval()}} evaluates a single C++ expression and returns the result. } diff --git a/tests/testthat/_snaps/source.md b/tests/testthat/_snaps/source.md index ad9152aa..3435da17 100644 --- a/tests/testthat/_snaps/source.md +++ b/tests/testthat/_snaps/source.md @@ -7,3 +7,11 @@ ! Can't find `file` at this path: {NON_EXISTENT_FILEPATH} +# `cpp11::package` throws expected error on unknown packages + + Code + test() + Condition + Error: + ! Can't find namespace: 'definitely_not_a_package'. + diff --git a/tests/testthat/fixtures/test-two-files/one.cpp b/tests/testthat/fixtures/test-two-files/one.cpp new file mode 100644 index 00000000..eef422a6 --- /dev/null +++ b/tests/testthat/fixtures/test-two-files/one.cpp @@ -0,0 +1 @@ +[[cpp11::register]] int foo() { return 1; } diff --git a/tests/testthat/fixtures/test-two-files/two.cpp b/tests/testthat/fixtures/test-two-files/two.cpp new file mode 100644 index 00000000..2f00613b --- /dev/null +++ b/tests/testthat/fixtures/test-two-files/two.cpp @@ -0,0 +1 @@ +[[cpp11::register]] double bar() { return 1.0; } diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R index eded02b5..c411cfa3 100644 --- a/tests/testthat/helper.R +++ b/tests/testthat/helper.R @@ -4,7 +4,10 @@ local_package <- function() { withr::defer(unlink(dir, recursive = TRUE), parent.frame()) writeLines("Package: testPkg", file.path(dir, "DESCRIPTION")) - writeLines("useDynLib(testPkg, .registration = TRUE)", file.path(dir, "NAMESPACE")) + writeLines( + "useDynLib(testPkg, .registration = TRUE)", + file.path(dir, "NAMESPACE") + ) desc::desc(dir) } diff --git a/tests/testthat/test-knitr.R b/tests/testthat/test-knitr.R index 4fd032b4..92ce6b7a 100644 --- a/tests/testthat/test-knitr.R +++ b/tests/testthat/test-knitr.R @@ -2,7 +2,10 @@ describe("eng_cpp11", { it("works when code is not evaluated", { skip_on_os("solaris") opts <- knitr::opts_chunk$get() - opts <- utils::modifyList(opts, list(eval = FALSE, engine = "cpp11", code = "1 + 1")) + opts <- utils::modifyList( + opts, + list(eval = FALSE, engine = "cpp11", code = "1 + 1") + ) expect_equal( eng_cpp11(opts), @@ -14,7 +17,10 @@ describe("eng_cpp11", { skip_on_os("solaris") opts <- knitr::opts_chunk$get() code <- "[[cpp11::register]] int foo() { return 0; }" - opts <- utils::modifyList(opts, list(eval = TRUE, engine = "cpp11", code = code, quiet = TRUE)) + opts <- utils::modifyList( + opts, + list(eval = TRUE, engine = "cpp11", code = code, quiet = TRUE) + ) expect_equal( eng_cpp11(opts), diff --git a/tests/testthat/test-register.R b/tests/testthat/test-register.R index 99c8ff5d..7f65bb8a 100644 --- a/tests/testthat/test-register.R +++ b/tests/testthat/test-register.R @@ -26,7 +26,10 @@ describe("get_call_entries", { it("returns an empty string if there are no R files", { pkg <- local_package() path <- pkg_path(pkg) - expect_equal(get_call_entries(path, get_funs(path)$name, get_package_name(path)), "") + expect_equal( + get_call_entries(path, get_funs(path)$name, get_package_name(path)), + "" + ) }) it("returns an empty string if there are no .Call calls", { @@ -34,7 +37,10 @@ describe("get_call_entries", { path <- pkg_path(pkg) dir.create(file.path(path, "R")) writeLines("foo <- function() 1", file.path(path, "R", "foo.R")) - expect_equal(get_call_entries(path, get_funs(path)$name, get_package_name(path)), "") + expect_equal( + get_call_entries(path, get_funs(path)$name, get_package_name(path)), + "" + ) }) it("Errors for invalid packages", { @@ -46,7 +52,10 @@ describe("get_call_entries", { writeLines("Package: testPkg", file.path(pkg, "DESCRIPTION")) dir.create(file.path(pkg, "R")) writeLines('foo <- function() .Call("bar")', file.path(pkg, "R", "foo.R")) - expect_error(get_call_entries(pkg, get_funs(path)$name, get_package_name(pkg)), "has no 'NAMESPACE' file") + expect_error( + get_call_entries(pkg, get_funs(path)$name, get_package_name(pkg)), + "has no 'NAMESPACE' file" + ) }) it("returns an empty string for packages with .Call entries and NAMESPACE files", { @@ -59,7 +68,11 @@ describe("get_call_entries", { dir.create(file.path(path, "R")) writeLines('foo <- function() .Call("bar")', file.path(path, "R", "foo.R")) - call_entries <- get_call_entries(path, get_funs(path)$name, get_package_name(path)) + call_entries <- get_call_entries( + path, + get_funs(path)$name, + get_package_name(path) + ) expect_snapshot(call_entries) }) @@ -78,25 +91,41 @@ describe("get_call_entries", { describe("wrap_call", { it("works with void functions and no arguments", { expect_equal( - wrap_call("foo", "void", tibble::tibble(type = character(), name = character())), + wrap_call( + "foo", + "void", + tibble::tibble(type = character(), name = character()) + ), " foo();\n return R_NilValue;" ) }) it("works with non-void functions and no arguments", { expect_equal( - wrap_call("foo", "bool", tibble::tibble(type = character(), name = character())), + wrap_call( + "foo", + "bool", + tibble::tibble(type = character(), name = character()) + ), " return cpp11::as_sexp(foo());" ) }) it("works with void functions and some arguments", { expect_equal( - wrap_call("foo", "void", tibble::tibble(type = c("double", "int"), name = c("x", "y"))), + wrap_call( + "foo", + "void", + tibble::tibble(type = c("double", "int"), name = c("x", "y")) + ), " foo(cpp11::as_cpp>(x), cpp11::as_cpp>(y));\n return R_NilValue;" ) }) it("works with non-void functions and some arguments", { expect_equal( - wrap_call("foo", "bool", tibble::tibble(type = c("double", "int"), name = c("x", "y"))), + wrap_call( + "foo", + "bool", + tibble::tibble(type = c("double", "int"), name = c("x", "y")) + ), " return cpp11::as_sexp(foo(cpp11::as_cpp>(x), cpp11::as_cpp>(y)));" ) }) @@ -107,7 +136,19 @@ describe("get_registered_functions", { f <- tempfile() decorations <- decor::cpp_decorations(files = f, is_attribute = TRUE) res <- get_registered_functions(decorations, "cpp11::register") - expect_equal(names(res), c("file", "line", "decoration", "params", "context", "name", "return_type", "args")) + expect_equal( + names(res), + c( + "file", + "line", + "decoration", + "params", + "context", + "name", + "return_type", + "args" + ) + ) expect_equal(NROW(res), 0) }) @@ -116,14 +157,41 @@ describe("get_registered_functions", { file.create(f) decorations <- decor::cpp_decorations(files = f, is_attribute = TRUE) res <- get_registered_functions(decorations, "cpp11::register") - expect_equal(names(res), c("file", "line", "decoration", "params", "context", "name", "return_type", "args")) + expect_equal( + names(res), + c( + "file", + "line", + "decoration", + "params", + "context", + "name", + "return_type", + "args" + ) + ) expect_equal(NROW(res), 0) }) it("works with a single registration", { - decorations <- decor::cpp_decorations(files = test_path("single.cpp"), is_attribute = TRUE) + decorations <- decor::cpp_decorations( + files = test_path("single.cpp"), + is_attribute = TRUE + ) res <- get_registered_functions(decorations, "cpp11::register") - expect_equal(names(res), c("file", "line", "decoration", "params", "context", "name", "return_type", "args")) + expect_equal( + names(res), + c( + "file", + "line", + "decoration", + "params", + "context", + "name", + "return_type", + "args" + ) + ) expect_equal(NROW(res), 1L) expect_equal(res$name, "foo") expect_equal(res$return_type, "int") @@ -132,9 +200,24 @@ describe("get_registered_functions", { }) it("works with multiple registrations", { - decorations <- decor::cpp_decorations(files = test_path("multiple.cpp"), is_attribute = TRUE) + decorations <- decor::cpp_decorations( + files = test_path("multiple.cpp"), + is_attribute = TRUE + ) res <- get_registered_functions(decorations, "cpp11::register") - expect_equal(names(res), c("file", "line", "decoration", "params", "context", "name", "return_type", "args")) + expect_equal( + names(res), + c( + "file", + "line", + "decoration", + "params", + "context", + "name", + "return_type", + "args" + ) + ) expect_equal(NROW(res), 3L) expect_equal(res$name, c("foo", "bar", "baz")) expect_equal(res$return_type, c("int", "double", "bool")) @@ -185,8 +268,9 @@ describe("generate_cpp_functions", { args = list(tibble::tibble(type = character(), name = character())) ) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp void foo(); extern \"C\" SEXP _cpp11_foo() { BEGIN_CPP11 @@ -209,8 +293,9 @@ extern \"C\" SEXP _cpp11_foo() { args = list(tibble::tibble(type = character(), name = character())) ) - expect_equal(generate_cpp_functions(funs, package = "mypkg"), -"// foo.cpp + expect_equal( + generate_cpp_functions(funs, package = "mypkg"), + "// foo.cpp void foo(); extern \"C\" SEXP _mypkg_foo() { BEGIN_CPP11 @@ -221,7 +306,6 @@ extern \"C\" SEXP _mypkg_foo() { ) }) - it("returns the wrapped function for a single function with no arguments", { funs <- tibble::tibble( file = "foo.cpp", @@ -234,8 +318,9 @@ extern \"C\" SEXP _mypkg_foo() { args = list(tibble::tibble(type = character(), name = character())) ) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp int foo(); extern \"C\" SEXP _cpp11_foo() { BEGIN_CPP11 @@ -257,8 +342,9 @@ extern \"C\" SEXP _cpp11_foo() { args = list(tibble::tibble(type = "int", name = "bar")) ) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp void foo(int bar); extern \"C\" SEXP _cpp11_foo(SEXP bar) { BEGIN_CPP11 @@ -281,8 +367,9 @@ extern \"C\" SEXP _cpp11_foo(SEXP bar) { args = list(tibble::tibble(type = "int", name = "bar")) ) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp int foo(int bar); extern \"C\" SEXP _cpp11_foo(SEXP bar) { BEGIN_CPP11 @@ -307,8 +394,9 @@ extern \"C\" SEXP _cpp11_foo(SEXP bar) { ) ) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp int foo(int bar); extern \"C\" SEXP _cpp11_foo(SEXP bar) { BEGIN_CPP11 @@ -356,10 +444,12 @@ describe("generate_r_functions", { args = list(tibble::tibble(type = character(), name = character())) ) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function() { + expect_equal( + generate_r_functions(funs, package = "cpp11"), + "foo <- function() { invisible(.Call(`_cpp11_foo`)) -}") +}" + ) }) it("returns the wrapped function for a single void function with no arguments and use_package = TRUE", { @@ -374,10 +464,12 @@ describe("generate_r_functions", { args = list(tibble::tibble(type = character(), name = character())) ) - expect_equal(generate_r_functions(funs, package = "cpp11", use_package = TRUE), -"foo <- function() { + expect_equal( + generate_r_functions(funs, package = "cpp11", use_package = TRUE), + "foo <- function() { invisible(.Call(\"_cpp11_foo\", PACKAGE = \"cpp11\")) -}") +}" + ) }) it("returns the wrapped function for a single void function with no arguments and different package name", { @@ -392,10 +484,12 @@ describe("generate_r_functions", { args = list(tibble::tibble(type = character(), name = character())) ) - expect_equal(generate_r_functions(funs, package = "mypkg"), -"foo <- function() { + expect_equal( + generate_r_functions(funs, package = "mypkg"), + "foo <- function() { invisible(.Call(`_mypkg_foo`)) -}") +}" + ) }) it("returns the wrapped function for a single function with no arguments", { @@ -410,10 +504,12 @@ describe("generate_r_functions", { args = list(tibble::tibble(type = character(), name = character())) ) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function() { + expect_equal( + generate_r_functions(funs, package = "cpp11"), + "foo <- function() { .Call(`_cpp11_foo`) -}") +}" + ) }) it("returns the wrapped function for a single function with no arguments and use_package = TRUE", { @@ -428,10 +524,12 @@ describe("generate_r_functions", { args = list(tibble::tibble(type = character(), name = character())) ) - expect_equal(generate_r_functions(funs, package = "cpp11", use_package = TRUE), -"foo <- function() { + expect_equal( + generate_r_functions(funs, package = "cpp11", use_package = TRUE), + "foo <- function() { .Call(\"_cpp11_foo\", PACKAGE = \"cpp11\") -}") +}" + ) }) it("returns the wrapped function for a single void function with arguments", { @@ -446,10 +544,12 @@ describe("generate_r_functions", { args = list(tibble::tibble(type = "int", name = "bar")) ) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function(bar) { + expect_equal( + generate_r_functions(funs, package = "cpp11"), + "foo <- function(bar) { invisible(.Call(`_cpp11_foo`, bar)) -}") +}" + ) }) it("returns the wrapped function for a single function with arguments", { @@ -464,10 +564,12 @@ describe("generate_r_functions", { args = list(tibble::tibble(type = "int", name = "bar")) ) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function(bar) { + expect_equal( + generate_r_functions(funs, package = "cpp11"), + "foo <- function(bar) { .Call(`_cpp11_foo`, bar) -}") +}" + ) }) it("returns the wrapped functions for multiple functions with arguments", { @@ -485,14 +587,16 @@ describe("generate_r_functions", { ) ) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function(bar) { + expect_equal( + generate_r_functions(funs, package = "cpp11"), + "foo <- function(bar) { .Call(`_cpp11_foo`, bar) } bar <- function(baz) { .Call(`_cpp11_bar`, baz) -}") +}" + ) }) }) @@ -503,10 +607,8 @@ describe("cpp_register", { dir.create(f) expect_equal(cpp_register(f), character()) - }) it("works with a package that registers a single c++ function", { - # tools::package_native_routine_registration_skeleton is not available before R 3.4 skip_if(getRversion() < "3.4") @@ -590,7 +692,10 @@ describe("cpp_register", { file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) dir.create(file.path(p, "inst", "include"), recursive = TRUE) - writeLines("#include ", file.path(p, "inst", "include", "testPkg_types.h")) + writeLines( + "#include ", + file.path(p, "inst", "include", "testPkg_types.h") + ) cpp_register(p) expect_true( @@ -611,7 +716,10 @@ describe("cpp_register", { file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) dir.create(file.path(p, "inst", "include"), recursive = TRUE) - writeLines("#include ", file.path(p, "inst", "include", "testPkg_types.hpp")) + writeLines( + "#include ", + file.path(p, "inst", "include", "testPkg_types.hpp") + ) cpp_register(p) expect_true( @@ -658,7 +766,10 @@ describe("generate_init_functions", { args = list(tibble::tibble(type = character(), name = character())) ) - expect_equal(generate_init_functions(funs), list(declarations = "", calls = "")) + expect_equal( + generate_init_functions(funs), + list(declarations = "", calls = "") + ) }) it("returns the declaration and call for a single init function", { @@ -673,7 +784,13 @@ describe("generate_init_functions", { args = list(tibble::tibble(type = "DllInfo*", name = "dll")) ) - expect_equal(generate_init_functions(funs), list(declarations = "\nvoid foo(DllInfo* dll);\n", calls = "\n foo(dll);")) + expect_equal( + generate_init_functions(funs), + list( + declarations = "\nvoid foo(DllInfo* dll);\n", + calls = "\n foo(dll);" + ) + ) }) it("returns the declaration and call for a multiple init functions", { @@ -685,10 +802,19 @@ describe("generate_init_functions", { context = list(NA_character_, NA_character_), name = c("foo", "bar"), return_type = c("void", "void"), - args = list(tibble::tibble(type = "DllInfo*", name = "dll"), tibble::tibble(type = "DllInfo*", name = "dll")) + args = list( + tibble::tibble(type = "DllInfo*", name = "dll"), + tibble::tibble(type = "DllInfo*", name = "dll") + ) ) - expect_equal(generate_init_functions(funs), list(declarations = "\nvoid foo(DllInfo* dll);\nvoid bar(DllInfo* dll);\n", calls = "\n foo(dll);\n bar(dll);")) + expect_equal( + generate_init_functions(funs), + list( + declarations = "\nvoid foo(DllInfo* dll);\nvoid bar(DllInfo* dll);\n", + calls = "\n foo(dll);\n bar(dll);" + ) + ) }) }) @@ -710,7 +836,10 @@ test_that("check_valid_attributes does not return an error if all registers are pkg <- local_package() p <- pkg_path(pkg) dir.create(file.path(p, "src")) - file.copy(test_path("linking_to_registers.cpp"), file.path(p, "src", "linking_to_registers.cpp")) + file.copy( + test_path("linking_to_registers.cpp"), + file.path(p, "src", "linking_to_registers.cpp") + ) expect_error_free(cpp_register(p)) }) @@ -720,21 +849,30 @@ test_that("check_valid_attributes returns an error if one or more registers is i pkg <- local_package() p <- pkg_path(pkg) dir.create(file.path(p, "src")) - file.copy(test_path("single_incorrect.cpp"), file.path(p, "src", "single_incorrect.cpp")) + file.copy( + test_path("single_incorrect.cpp"), + file.path(p, "src", "single_incorrect.cpp") + ) expect_error(cpp_register(p)) pkg <- local_package() p <- pkg_path(pkg) dir.create(file.path(p, "src")) - file.copy(test_path("multiple_incorrect.cpp"), file.path(p, "src", "multiple_incorrect.cpp")) + file.copy( + test_path("multiple_incorrect.cpp"), + file.path(p, "src", "multiple_incorrect.cpp") + ) expect_error(cpp_register(p)) pkg <- local_package() p <- pkg_path(pkg) dir.create(file.path(p, "src")) - file.copy(test_path("linking_to_incorrect_registers.cpp"), file.path(p, "src", "linking_to_incorrect_registers.cpp")) + file.copy( + test_path("linking_to_incorrect_registers.cpp"), + file.path(p, "src", "linking_to_incorrect_registers.cpp") + ) expect_error(cpp_register(p)) }) diff --git a/tests/testthat/test-source.R b/tests/testthat/test-source.R index 2945d51d..142c3821 100644 --- a/tests/testthat/test-source.R +++ b/tests/testthat/test-source.R @@ -14,7 +14,9 @@ test_that("cpp_source works with the `code` parameter", { } return total; } - ', clean = TRUE) + ', + clean = TRUE + ) on.exit(dyn.unload(dll_info[["path"]])) expect_equal(num_odd(as.integer(c(1:10, 15, 23))), 7) @@ -28,7 +30,9 @@ test_that("cpp_source works with the `file` parameter", { bool always_true() { return true; } - ", tf) + ", + tf + ) on.exit(unlink(tf)) dll_info <- cpp_source(tf, clean = TRUE, quiet = TRUE) @@ -45,7 +49,9 @@ test_that("cpp_source works with files called `cpp11.cpp`", { bool always_true() { return true; } - ", tf) + ", + tf + ) on.exit(unlink(tf)) dll_info <- cpp_source(tf, clean = TRUE, quiet = TRUE) @@ -54,15 +60,33 @@ test_that("cpp_source works with files called `cpp11.cpp`", { expect_true(always_true()) }) -test_that("cpp_source returns original file name on error", { +test_that("cpp_source works with multiple `file`s", { + skip_on_os("solaris") - expect_output(try(cpp_source(test_path("single_error.cpp"), clean = TRUE), silent = TRUE), - normalizePath(test_path("single_error.cpp"), winslash = "/"), fixed = TRUE) + dll_info <- cpp_source(test_path( + "fixtures", + "test-two-files", + c("one.cpp", "two.cpp") + )) + on.exit(dyn.unload(dll_info[["path"]]), add = TRUE) - #error generated for incorrect attributes is separate from compilation errors - expect_error(cpp_source(test_path("single_incorrect.cpp"), clean = TRUE), - normalizePath(test_path("single_incorrect.cpp"), winslash = "/"), fixed = 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), + normalizePath(test_path("single_error.cpp"), winslash = "/"), + fixed = TRUE + ) + #error generated for incorrect attributes is separate from compilation errors + expect_error( + cpp_source(test_path("single_incorrect.cpp"), clean = TRUE), + normalizePath(test_path("single_incorrect.cpp"), winslash = "/"), + fixed = TRUE + ) }) test_that("cpp_source lets you set the C++ standard", { @@ -77,7 +101,9 @@ test_that("cpp_source lets you set the C++ standard", { auto str = "hello_world"s; return str; } - ', tf) + ', + tf + ) on.exit(unlink(tf)) dll_info <- cpp_source(tf, clean = TRUE, quiet = TRUE, cxx_std = "CXX14") @@ -97,25 +123,41 @@ test_that("generate_cpp_name works", { "foo_2.cpp" ) -expect_equal( - generate_cpp_name("foo.cpp", loaded_dlls = c("foo", "foo_2")), - "foo_3.cpp" + expect_equal( + generate_cpp_name("foo.cpp", loaded_dlls = c("foo", "foo_2")), + "foo_3.cpp" ) }) test_that("generate_include_paths handles paths with spaces", { if (is_windows()) { - mockery::stub(generate_include_paths, "system.file", "C:\\a path with spaces\\cpp11") - expect_equal(generate_include_paths("cpp11"), "-I\"C:\\a path with spaces\\cpp11\"") + mockery::stub( + generate_include_paths, + "system.file", + "C:\\a path with spaces\\cpp11" + ) + expect_equal( + generate_include_paths("cpp11"), + "-I\"C:\\a path with spaces\\cpp11\"" + ) } else { - mockery::stub(generate_include_paths, "system.file", "/a path with spaces/cpp11") - expect_equal(generate_include_paths("cpp11"), "-I'/a path with spaces/cpp11'") + mockery::stub( + generate_include_paths, + "system.file", + "/a path with spaces/cpp11" + ) + expect_equal( + generate_include_paths("cpp11"), + "-I'/a path with spaces/cpp11'" + ) } }) test_that("check_valid_attributes does not return an error if all registers are correct", { expect_error_free( - cpp11::cpp_source(clean = TRUE, code = '#include + cpp11::cpp_source( + clean = TRUE, + code = '#include using namespace cpp11::literals; [[cpp11::register]] cpp11::list fn() { @@ -128,9 +170,12 @@ test_that("check_valid_attributes does not return an error if all registers are cpp11::writable::list x; x.push_back({"foo"_nm = 1}); return x; - }')) + }' + ) + ) expect_error_free( - cpp11::cpp_source(clean = TRUE, + cpp11::cpp_source( + clean = TRUE, code = '#include #include @@ -145,13 +190,15 @@ test_that("check_valid_attributes does not return an error if all registers are pb.tick(); } } - ') + ' + ) ) }) test_that("check_valid_attributes returns an error if one or more registers is incorrect", { expect_error( - cpp11::cpp_source(code = '#include + cpp11::cpp_source( + code = '#include using namespace cpp11::literals; [[cpp11::reg]] cpp11::list fn() { @@ -164,20 +211,26 @@ test_that("check_valid_attributes returns an error if one or more registers is i cpp11::writable::list x; x.push_back({"foo"_nm = 1}); return x; - }')) + }' + ) + ) expect_error( - cpp11::cpp_source(code = '#include + cpp11::cpp_source( + code = '#include using namespace cpp11::literals; [[cpp11::reg]] cpp11::list fn() { cpp11::writable::list x; x.push_back({"foo"_nm = 1}); return x; - }')) + }' + ) + ) expect_error( - cpp11::cpp_source(code = '#include + cpp11::cpp_source( + code = '#include using namespace cpp11::literals; [[cpp11::reg]] cpp11::list fn() { @@ -190,9 +243,9 @@ test_that("check_valid_attributes returns an error if one or more registers is i cpp11::writable::list x; x.push_back({"foo"_nm = 1}); return x; - }')) - - + }' + ) + ) expect_error( cpp11::cpp_source( @@ -208,7 +261,9 @@ test_that("check_valid_attributes returns an error if one or more registers is i pb.tick(); } } -')) +' + ) + ) }) test_that("cpp_source(d) functions work after sourcing file more than once", { @@ -227,3 +282,24 @@ test_that("cpp_source fails informatively for nonexistent file", { transform = ~ sub("^.+[.]cpp$", "{NON_EXISTENT_FILEPATH}", .x) ) }) + +test_that("`cpp11::package` throws expected error on unknown packages", { + skip_on_os("solaris") + dll_info <- cpp_source( + code = ' + #include "cpp11/function.hpp" + + [[cpp11::register]] + SEXP test() { + auto pkg = cpp11::package("definitely_not_a_package"); + return R_NilValue; + } + ', + clean = TRUE + ) + on.exit(dyn.unload(dll_info[["path"]])) + + expect_snapshot(error = TRUE, { + test() + }) +}) diff --git a/tests/testthat/test-vendor.R b/tests/testthat/test-vendor.R index 361c9ad9..c70def90 100644 --- a/tests/testthat/test-vendor.R +++ b/tests/testthat/test-vendor.R @@ -26,6 +26,12 @@ describe("cpp_vendor", { expect_true(dir.exists(file.path(p, "inst", "include", "cpp11"))) expect_true(file.exists(file.path(p, "inst", "include", "cpp11.hpp"))) - expect_true(file.exists(file.path(p, "inst", "include", "cpp11", "declarations.hpp"))) + expect_true(file.exists(file.path( + p, + "inst", + "include", + "cpp11", + "declarations.hpp" + ))) }) }) diff --git a/vignettes/FAQ.Rmd b/vignettes/FAQ.Rmd index 0c594b1f..c84abe92 100644 --- a/vignettes/FAQ.Rmd +++ b/vignettes/FAQ.Rmd @@ -153,7 +153,7 @@ is_named(c(x = "foo")) #### 7. How do I return a `cpp11::writable::logicals` object with only a `FALSE` value? -You need to use [list initialization](https://en.cppreference.com/w/cpp/language/list_initialization.html) with `{}` to create the object. +You need to use [list initialization](https://en.cppreference.com/cpp/language/list_initialization.html) with `{}` to create the object. ```{cpp11} #include diff --git a/vignettes/cpp11.Rmd b/vignettes/cpp11.Rmd index ad8db4a4..a3b7a27a 100644 --- a/vignettes/cpp11.Rmd +++ b/vignettes/cpp11.Rmd @@ -45,7 +45,7 @@ Typical bottlenecks that C++ can address include: The aim of this vignette is to discuss only those aspects of C++ and cpp11 that are absolutely necessary to help you eliminate bottlenecks in your code. We won't spend much time on advanced features like object-oriented programming or templates because the focus is on writing small, self-contained functions, not big programs. A working knowledge of C++ is helpful, but not essential. -Many good tutorials and references are freely available, including and . +Many good tutorials and references are freely available, including and . For more advanced topics, the *Effective C++* series by Scott Meyers is a popular choice. ### Outline @@ -87,10 +87,12 @@ To get it: `cpp_function()` allows you to write C++ functions in R: ```{r add} -cpp_function('int add(int x, int y, int z) { +cpp_function( + 'int add(int x, int y, int z) { int sum = x + y + z; return sum; -}') +}' +) # add works like a regular R function add add(1, 2, 3) @@ -127,9 +129,11 @@ int one() { We can compile and use this from R with `cpp_function()` ```{r one-cpp} -cpp_function('int one() { +cpp_function( + 'int one() { return 1; -}') +}' +) ``` This small function illustrates a number of important differences between R and C++: @@ -161,7 +165,8 @@ sign_r <- function(x) { -1 } } -cpp_function('int sign_cpp(int x) { +cpp_function( + 'int sign_cpp(int x) { if (x > 0) { return 1; } else if (x == 0) { @@ -169,7 +174,8 @@ cpp_function('int sign_cpp(int x) { } else { return -1; } -}') +}' +) ``` In the C++ version: @@ -201,14 +207,16 @@ In C++, loops have very little overhead, so it's fine to use them. In Section [stl](#stl), you'll see alternatives to `for` loops that more clearly express your intent; they're not faster, but they can make your code easier to understand. ```{r sum-cpp} -cpp_function('double sum_cpp(doubles x) { +cpp_function( + 'double sum_cpp(doubles x) { int n = x.size(); double total = 0; for(int i = 0; i < n; ++i) { total += x[i]; } return total; -}') +}' +) ``` The C++ version is similar, but: @@ -250,7 +258,7 @@ Next we'll create a function that computes the Euclidean distance between a valu ```{r pdist-r} pdist_r <- function(x, ys) { - sqrt((x - ys) ^ 2) + sqrt((x - ys)^2) } ``` @@ -258,14 +266,16 @@ In R, it's not obvious that we want `x` to be a scalar from the function definit That's not a problem in the C++ version because we have to be explicit about types: ```{r pdist-cpp} -cpp_function('doubles pdist_cpp(double x, doubles ys) { +cpp_function( + 'doubles pdist_cpp(double x, doubles ys) { int n = ys.size(); writable::doubles out(n); for(int i = 0; i < n; ++i) { out[i] = sqrt(pow(ys[i] - x, 2.0)); } return out; -}') +}' +) ``` This function introduces a few new concepts: @@ -510,7 +520,7 @@ f("x"_nm = "y", "value"_nm = 1); All R objects have attributes, which can be queried and modified with `.attr()`. cpp11 also provides `.names()` as an alias for the `names` attribute. The following code snippet illustrates these methods. -Note the use of `{}` [initializer list](https://en.cppreference.com/w/cpp/utility/initializer_list.html) syntax. +Note the use of `{}` [initializer list](https://en.cppreference.com/cpp/utility/initializer_list.html) syntax. This allows you to create an R vector from C++ scalar values: ```{r attribs, engine = "cpp11"} @@ -736,7 +746,7 @@ local({ ### Algorithms The `` header provides a large number of algorithms that work with iterators. -A good reference is available at . +A good reference is available at . For example, we could write a basic cpp11 version of `findInterval()` that takes two arguments, a vector of values and a vector of breaks, and locates the bin that each x falls into. This shows off a few more advanced iterator features. Read the code below and see if you can figure out how it works. @@ -790,7 +800,7 @@ The most important of these data structures are the `vector`, the `unordered_set We'll focus on these three in this section, but using the others is similar: they just have different performance trade-offs. For example, the `deque` (pronounced "deck") has a very similar interface to vectors but a different underlying implementation that has different performance trade-offs. You may want to try it for your problem. -A good reference for STL data structures is --- I recommend you keep it open while working with the STL. +A good reference for STL data structures is --- I recommend you keep it open while working with the STL. cpp11 knows how to convert from many STL data structures to their R equivalents, so you can return them from your functions without explicitly converting to R data structures. @@ -843,7 +853,7 @@ list rle_cpp(doubles x) { (An alternative implementation would be to replace `i` with the iterator `lengths.rbegin()` which always points to the last element of the vector. You might want to try implementing that.) -Other methods of a vector are described at . +Other methods of a vector are described at . ### Sets @@ -854,7 +864,7 @@ Unordered sets can somtimes be much faster (because they use a hash table intern Often even if you need an ordered set, you could consider using an unordered set and then sorting the output. Benchmarking with your expected dataset is the best way to determine which is fastest for your data. Like vectors, sets are templated, so you need to request the appropriate type of set for your purpose: `unordered_set`, `unordered_set`, etc. -More details are available at and . +More details are available at and . The following function uses an unordered set to implement an equivalent to `duplicated()` for integer vectors. Note the use of `seen.insert(x[i]).second`. diff --git a/vignettes/internals.Rmd b/vignettes/internals.Rmd index 9005bbcb..e9566bb4 100644 --- a/vignettes/internals.Rmd +++ b/vignettes/internals.Rmd @@ -108,7 +108,7 @@ The various methods for both functions are defined in [cpp11/as.hpp](https://git This is definitely the most complex part of the cpp11 code, with extensive use of [template metaprogramming](https://en.wikipedia.org/wiki/Template_metaprogramming). In particular the [substitution failure is not an error (SFINAE)](https://en.wikipedia.org/wiki/Substitution_failure_is_not_an_error) technique is used to control overloading of the functions. -If we could use C++20 a lot of this code would be made simpler with [Concepts](https://en.cppreference.com/w/cpp/language/constraints.html), but alas. +If we could use C++20 a lot of this code would be made simpler with [Concepts](https://en.cppreference.com/cpp/language/constraints.html), but alas. The most common C++ types are included in the test suite and should work without issues, as more exotic types are used in real projects additional issues may arise. diff --git a/vignettes/motivations.Rmd b/vignettes/motivations.Rmd index 9c47c7cd..51e7ec85 100644 --- a/vignettes/motivations.Rmd +++ b/vignettes/motivations.Rmd @@ -172,7 +172,7 @@ Exceptions provide a clean, safe way for objects to obtain and cleanup resources ### C safety The C language does not have support for exceptions, so error handling is done a variety of ways. -These include error codes like [errno](https://en.cppreference.com/w/c/error/errno), conditional statements, and in the R codebase the [longjmp](https://cplusplus.com/reference/csetjmp/longjmp/) function. +These include error codes like [errno](https://en.cppreference.com/c/error/errno), conditional statements, and in the R codebase the [longjmp](https://cplusplus.com/reference/csetjmp/longjmp/) function. `longjmp`, which stands for 'long jump' is a function that allows you to transfer the control flow of a program to another location elsewhere in the program. R uses long jumps extensively in its error handling routines. @@ -339,12 +339,12 @@ Concretely cpp11 always uses `Rf_translateCharUTF8()` when obtaining `const char C++11 provides a host of new features to the C++ language. cpp11 uses a number of these including -- [move semantics](https://en.cppreference.com/w/cpp/language/move_constructor.html) -- [type traits](https://en.cppreference.com/w/cpp/header/type_traits.html) -- [initializer_list](https://en.cppreference.com/w/cpp/utility/initializer_list.html) -- [variadic templates / parameter packs](https://en.cppreference.com/w/cpp/language/parameter_pack.html) -- [user defined literals](https://en.cppreference.com/w/cpp/language/user_literal.html) -- [user defined attributes](https://en.cppreference.com/w/cpp/language/attributes.html) +- [move semantics](https://en.cppreference.com/cpp/language/move_constructor.html) +- [type traits](https://en.cppreference.com/cpp/header/type_traits.html) +- [initializer_list](https://en.cppreference.com/cpp/utility/initializer_list.html) +- [variadic templates / parameter packs](https://en.cppreference.com/cpp/language/parameter_pack.html) +- [user defined literals](https://en.cppreference.com/cpp/language/user_literal.html) +- [user defined attributes](https://en.cppreference.com/cpp/language/attributes.html) ## Simpler implementation {#simpler-implementation}