From c90eea47e7275bf9d862accfac398369a6d4752f Mon Sep 17 00:00:00 2001 From: Mauricio 'Pacha' Vargas Sepulveda Date: Wed, 23 Oct 2024 14:30:59 -0400 Subject: [PATCH] testthat 3e --- DESCRIPTION | 5 +- NEWS.md | 6 + R/source.R | 11 +- R/vendor.R | 11 +- man/cpp_vendor.Rd | 10 +- tests/testthat.R | 8 + tests/testthat/_snaps/register.md | 8 +- tests/testthat/test-knitr.R | 38 +- tests/testthat/test-register.R | 1222 +++++++++++++++-------------- tests/testthat/test-source.R | 11 +- tests/testthat/test-utils.R | 48 +- tests/testthat/test-vendor.R | 48 +- 12 files changed, 731 insertions(+), 695 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index 0278147c..463626e1 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,6 +1,6 @@ Package: cpp11 Title: A C++11 Interface for R's C Interface -Version: 0.5.0.9000 +Version: 0.5.1 Authors@R: c( person("Davis", "Vaughan", email = "davis@posit.co", role = c("aut", "cre"), comment = c(ORCID = "0000-0003-4777-038X")), @@ -31,7 +31,6 @@ Suggests: glue, knitr, lobstr, - mockery, progress, rmarkdown, scales, @@ -55,4 +54,4 @@ Config/Needs/cpp11/cpp_register: vctrs Encoding: UTF-8 Roxygen: list(markdown = TRUE) -RoxygenNote: 7.2.3 +RoxygenNote: 7.3.1 diff --git a/NEWS.md b/NEWS.md index be8a47cc..f7b9739e 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # cpp11 (development version) +# cpp11 0.5.1 + +* Uses testthat 3e style tests (#402). +* Removes the mockery dependence. +* The vendoring function accepts a custom path (i.e., to use the GitHub version of the package) + # cpp11 0.5.0 ## R non-API related changes diff --git a/R/source.R b/R/source.R index fc9124d5..a59d8611 100644 --- a/R/source.R +++ b/R/source.R @@ -163,12 +163,15 @@ generate_cpp_name <- function(name, loaded_dlls = c("cpp11", names(getLoadedDLLs sprintf("%s.%s", new_name, ext) } - - -generate_include_paths <- function(packages) { +generate_include_paths <- function(packages, custom_path = NULL) { out <- character(length(packages)) for (i in seq_along(packages)) { - path <- system.file(package = packages[[i]], "include") + if (!is.null(custom_path)) { + path <- custom_path + } else { + path <- system.file(package = packages[[i]], "include") + } + if (is_windows()) { path <- utils::shortPathName(path) } diff --git a/R/vendor.R b/R/vendor.R index 5fe10fe2..ed08935a 100644 --- a/R/vendor.R +++ b/R/vendor.R @@ -16,6 +16,10 @@ #' code until you run `cpp_vendor()` again. #' #' @inheritParams cpp_register +#' @param headers The path to the cpp11 headers to vendor. By default this is +#' the path where R installed the cpp11 package. You can change this to +#' use a different version of cpp11, such as as the development version +#' from GitHub. #' @return The file path to the vendored code (invisibly). #' @export #' @examples @@ -30,7 +34,7 @@ #' #' # cleanup #' unlink(dir, recursive = TRUE) -cpp_vendor <- function(path = ".") { +cpp_vendor <- function(path = ".", headers = system.file("include", "cpp11", package = "cpp11")) { new <- file.path(path, "inst", "include", "cpp11") if (dir.exists(new)) { @@ -39,8 +43,7 @@ cpp_vendor <- function(path = ".") { dir.create(new , recursive = TRUE, showWarnings = FALSE) - current <- system.file("include", "cpp11", package = "cpp11") - if (!nzchar(current)) { + if (!nzchar(headers)) { stop("cpp11 is not installed", call. = FALSE) } @@ -48,7 +51,7 @@ cpp_vendor <- function(path = ".") { cpp11_header <- sprintf("// cpp11 version: %s\n// vendored on: %s", cpp11_version, Sys.Date()) - files <- list.files(current, full.names = TRUE) + files <- list.files(headers, full.names = TRUE) writeLines( c(cpp11_header, readLines(system.file("include", "cpp11.hpp", package = "cpp11"))), diff --git a/man/cpp_vendor.Rd b/man/cpp_vendor.Rd index 857e49cf..b3faf37d 100644 --- a/man/cpp_vendor.Rd +++ b/man/cpp_vendor.Rd @@ -4,10 +4,18 @@ \alias{cpp_vendor} \title{Vendor the cpp11 dependency} \usage{ -cpp_vendor(path = ".") +cpp_vendor( + path = ".", + headers = system.file("include", "cpp11", package = "cpp11") +) } \arguments{ \item{path}{The path to the package root directory} + +\item{headers}{The path to the cpp11 headers to vendor. By default this is +the path where R installed the cpp11 package. You can change this to +use a different version of cpp11, such as as the development version +from GitHub.} } \value{ The file path to the vendored code (invisibly). diff --git a/tests/testthat.R b/tests/testthat.R index 01dea5d5..cefcc953 100644 --- a/tests/testthat.R +++ b/tests/testthat.R @@ -1,3 +1,11 @@ +# This file is part of the standard setup for testthat. +# It is recommended that you do not modify it. +# +# Where should you do additional test configuration? +# Learn more about the roles of various files in: +# * https://r-pkgs.org/testing-design.html#sec-tests-files-overview +# * https://testthat.r-lib.org/articles/special-files.html + library(testthat) library(cpp11) diff --git a/tests/testthat/_snaps/register.md b/tests/testthat/_snaps/register.md index 37afbf49..15669247 100644 --- a/tests/testthat/_snaps/register.md +++ b/tests/testthat/_snaps/register.md @@ -1,4 +1,4 @@ -# get_call_entries: returns an empty string for packages with .Call entries and NAMESPACE files +# get_call_entries returns an empty string for packages with .Call entries and NAMESPACE files Code call_entries @@ -11,7 +11,7 @@ [6] " {NULL, NULL, 0}" [7] "};" -# get_call_entries: works with multiple register functions. +# get_call_entries works with multiple register functions Code cat(read_file(cpp_bindings)) @@ -60,7 +60,7 @@ R_forceSymbols(dll, TRUE); } -# cpp_register: works with a package that registers a single c++ function +# cpp_register works with a package that registers a single C++ function Code cat(read_file(r_bindings)) @@ -104,7 +104,7 @@ R_forceSymbols(dll, TRUE); } -# cpp_register: can be run with messages +# cpp_register can be run with messages Code cpp_register(p, quiet = FALSE) diff --git a/tests/testthat/test-knitr.R b/tests/testthat/test-knitr.R index 4fd032b4..e4a83376 100644 --- a/tests/testthat/test-knitr.R +++ b/tests/testthat/test-knitr.R @@ -1,24 +1,22 @@ -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")) +test_that("eng_cpp11 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")) - expect_equal( - eng_cpp11(opts), - "1 + 1" - ) - }) + expect_equal( + eng_cpp11(opts), + "1 + 1" + ) +}) - it("works when code is evaluated", { - 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)) +test_that("eng_cpp11 works when code is evaluated", { + 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)) - expect_equal( - eng_cpp11(opts), - code - ) - }) + expect_equal( + eng_cpp11(opts), + code + ) }) diff --git a/tests/testthat/test-register.R b/tests/testthat/test-register.R index 99c8ff5d..8df9cc61 100644 --- a/tests/testthat/test-register.R +++ b/tests/testthat/test-register.R @@ -1,192 +1,188 @@ -describe("pkg_links_to_rcpp", { - it("works with single package in LinkingTo", { - pkg <- local_package() - - expect_false(pkg_links_to_rcpp(pkg_path(pkg))) - - pkg$set("LinkingTo", "Rcpp") - pkg$write() - - expect_true(pkg_links_to_rcpp(pkg_path(pkg))) - }) - - it("works with multiple packages in LinkingTo", { - pkg <- local_package() - - expect_false(pkg_links_to_rcpp(pkg_path(pkg))) - - pkg$set("LinkingTo", paste("Rcpp", "cpp11", sep = ",")) - pkg$write() - - expect_true(pkg_links_to_rcpp(pkg_path(pkg))) - }) -}) - -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)), "") - }) - - it("returns an empty string if there are no .Call calls", { - pkg <- local_package() - 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)), "") - }) - - it("Errors for invalid packages", { - # local_package adds a NAMESPACE file - pkg <- tempfile() - dir.create(pkg) - on.exit(unlink(pkg, recursive = TRUE)) - - 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") - }) - - it("returns an empty string for packages with .Call entries and NAMESPACE files", { - # tools::package_native_routine_registration_skeleton is not available before R 3.4 - # R added `(void)` to the signature after R 4.3.0 - skip_if(getRversion() < "4.3.0") - - pkg <- local_package() - path <- pkg_path(pkg) - 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)) - - expect_snapshot(call_entries) - }) - it("works with multiple register functions.", { - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - file.copy(test_path("multiple.cpp"), file.path(p, "src", "multiple.cpp")) - - cpp_register(p) - cpp_bindings <- file.path(p, "src", "cpp11.cpp") - expect_snapshot(cat(read_file(cpp_bindings))) - }) -}) - -describe("wrap_call", { - it("works with void functions and no arguments", { - expect_equal( - 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())), - " 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"))), - " 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"))), - " return cpp11::as_sexp(foo(cpp11::as_cpp>(x), cpp11::as_cpp>(y)));" - ) - }) -}) - -describe("get_registered_functions", { - it("returns an empty tibble given a non-existent file", { - 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(NROW(res), 0) - }) - - it("returns an empty tibble given a empty file", { - f <- tempfile() - 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(NROW(res), 0) - }) - - it("works with a single registration", { - 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(NROW(res), 1L) - expect_equal(res$name, "foo") - expect_equal(res$return_type, "int") - expect_equal(names(res$args[[1]]), c("type", "name", "default")) - expect_equal(NROW(res$args[[1]]), 0) - }) - - it("works with multiple registrations", { - 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(NROW(res), 3L) - expect_equal(res$name, c("foo", "bar", "baz")) - expect_equal(res$return_type, c("int", "double", "bool")) - expect_equal(names(res$args[[1]]), c("type", "name", "default")) - expect_equal(NROW(res$args[[1]]), 0) - - expect_equal(names(res$args[[2]]), c("type", "name", "default")) - expect_equal(NROW(res$args[[2]]), 1) - expect_equal(res$args[[2]]$type, "bool") - expect_equal(res$args[[2]]$name, "run") - expect_equal(res$args[[2]]$default, NA_character_) - - expect_equal(names(res$args[[3]]), c("type", "name", "default")) - expect_equal(NROW(res$args[[3]]), 2) - expect_equal(res$args[[3]]$type, c("bool", "int")) - expect_equal(res$args[[3]]$name, c("run", "value")) - expect_equal(res$args[[3]]$default, c(NA_character_, "0")) - }) -}) - -describe("generate_cpp_functions", { - it("returns the empty string if there are no functions", { - skip_if_not_installed("glue", "1.6.2.9000") - - funs <- tibble::tibble( - file = character(), - line = integer(), - decoration = character(), - params = list(), - context = list(), - name = character(), - return_type = character(), - args = list(tibble::tibble(type = character(), name = character())) - ) +test_that("pkg_links_to_rcpp works with single package in LinkingTo", { + pkg <- local_package() - expect_equal(generate_cpp_functions(funs), "") - }) - - it("returns the wrapped function for a single void function with no arguments", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "void", - args = list(tibble::tibble(type = character(), name = character())) - ) + expect_false(pkg_links_to_rcpp(pkg_path(pkg))) + + pkg$set("LinkingTo", "Rcpp") + pkg$write() + + expect_true(pkg_links_to_rcpp(pkg_path(pkg))) +}) + +test_that("pkg_links_to_rcpp works with multiple packages in LinkingTo", { + pkg <- local_package() + + expect_false(pkg_links_to_rcpp(pkg_path(pkg))) + + pkg$set("LinkingTo", paste("Rcpp", "cpp11", sep = ",")) + pkg$write() + + expect_true(pkg_links_to_rcpp(pkg_path(pkg))) +}) + +test_that("get_call_entries 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)), "") +}) + +test_that("get_call_entries returns an empty string if there are no .Call calls", { + pkg <- local_package() + 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)), "") +}) + +test_that("get_call_entries errors for invalid packages", { + # local_package adds a NAMESPACE file + pkg <- tempfile() + dir.create(pkg) + on.exit(unlink(pkg, recursive = TRUE)) + + 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(pkg)$name, get_package_name(pkg)), "has no 'NAMESPACE' file") +}) + +test_that("get_call_entries returns an empty string for packages with .Call entries and NAMESPACE files", { + # tools::package_native_routine_registration_skeleton is not available before R 3.4 + # R added `(void)` to the signature after R 4.3.0 + skip_if(getRversion() < "4.3.0") + + pkg <- local_package() + path <- pkg_path(pkg) + 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)) + + expect_snapshot(call_entries) +}) + +test_that("get_call_entries works with multiple register functions", { + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + file.copy(test_path("multiple.cpp"), file.path(p, "src", "multiple.cpp")) + + cpp_register(p) + cpp_bindings <- file.path(p, "src", "cpp11.cpp") + expect_snapshot(cat(read_file(cpp_bindings))) +}) + +test_that("wrap_call works with void functions and no arguments", { + expect_equal( + wrap_call("foo", "void", tibble::tibble(type = character(), name = character())), + " foo();\n return R_NilValue;" + ) +}) + +test_that("wrap_call works with non-void functions and no arguments", { + expect_equal( + wrap_call("foo", "bool", tibble::tibble(type = character(), name = character())), + " return cpp11::as_sexp(foo());" + ) +}) + +test_that("wrap_call works with void functions and some arguments", { + expect_equal( + 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;" + ) +}) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp +test_that("wrap_call works with non-void functions and some arguments", { + expect_equal( + 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)));" + ) +}) + +test_that("get_registered_functions returns an empty tibble given a non-existent file", { + 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(NROW(res), 0) +}) + +test_that("get_registered_functions returns an empty tibble given an empty file", { + f <- tempfile() + 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(NROW(res), 0) +}) + +test_that("get_registered_functions works with a single registration", { + 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(NROW(res), 1L) + expect_equal(res$name, "foo") + expect_equal(res$return_type, "int") + expect_equal(names(res$args[[1]]), c("type", "name", "default")) + expect_equal(NROW(res$args[[1]]), 0) +}) + +test_that("get_registered_functions works with multiple registrations", { + 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(NROW(res), 3L) + expect_equal(res$name, c("foo", "bar", "baz")) + expect_equal(res$return_type, c("int", "double", "bool")) + expect_equal(names(res$args[[1]]), c("type", "name", "default")) + expect_equal(NROW(res$args[[1]]), 0) + + expect_equal(names(res$args[[2]]), c("type", "name", "default")) + expect_equal(NROW(res$args[[2]]), 1) + expect_equal(res$args[[2]]$type, "bool") + expect_equal(res$args[[2]]$name, "run") + expect_equal(res$args[[2]]$default, NA_character_) + + expect_equal(names(res$args[[3]]), c("type", "name", "default")) + expect_equal(NROW(res$args[[3]]), 2) + expect_equal(res$args[[3]]$type, c("bool", "int")) + expect_equal(res$args[[3]]$name, c("run", "value")) + expect_equal(res$args[[3]]$default, c(NA_character_, "0")) +}) + +test_that("generate_cpp_functions returns the empty string if there are no functions", { + skip_if_not_installed("glue", "1.6.2.9000") + + funs <- tibble::tibble( + file = character(), + line = integer(), + decoration = character(), + params = list(), + context = list(), + name = character(), + return_type = character(), + args = list(tibble::tibble(type = character(), name = character())) + ) + + expect_equal(generate_cpp_functions(funs), "") +}) + +test_that("generate_cpp_functions returns the wrapped function for a single void function with no arguments", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "void", + args = list(tibble::tibble(type = character(), name = character())) + ) + + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp void foo(); extern \"C\" SEXP _cpp11_foo() { BEGIN_CPP11 @@ -194,23 +190,24 @@ extern \"C\" SEXP _cpp11_foo() { return R_NilValue; END_CPP11 }" - ) - }) - - it("returns the wrapped function for a single void function with no arguments and different package name", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "void", - args = list(tibble::tibble(type = character(), name = character())) - ) + ) +}) - expect_equal(generate_cpp_functions(funs, package = "mypkg"), -"// foo.cpp +test_that("generate_cpp_functions returns the wrapped function for a single void function with no arguments and different package name", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "void", + args = list(tibble::tibble(type = character(), name = character())) + ) + + expect_equal( + generate_cpp_functions(funs, package = "mypkg"), + "// foo.cpp void foo(); extern \"C\" SEXP _mypkg_foo() { BEGIN_CPP11 @@ -218,47 +215,48 @@ extern \"C\" SEXP _mypkg_foo() { return R_NilValue; END_CPP11 }" - ) - }) - - - it("returns the wrapped function for a single function with no arguments", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "int", - args = list(tibble::tibble(type = character(), name = character())) - ) + ) +}) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp +test_that("generate_cpp_functions returns the wrapped function for a single function with no arguments", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "int", + args = list(tibble::tibble(type = character(), name = character())) + ) + + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp int foo(); extern \"C\" SEXP _cpp11_foo() { BEGIN_CPP11 return cpp11::as_sexp(foo()); END_CPP11 }" - ) - }) - - it("returns the wrapped function for a single void function with arguments", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "void", - args = list(tibble::tibble(type = "int", name = "bar")) - ) + ) +}) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp +test_that("generate_cpp_functions returns the wrapped function for a single void function with arguments", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "void", + args = list(tibble::tibble(type = "int", name = "bar")) + ) + + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp void foo(int bar); extern \"C\" SEXP _cpp11_foo(SEXP bar) { BEGIN_CPP11 @@ -266,49 +264,51 @@ extern \"C\" SEXP _cpp11_foo(SEXP bar) { return R_NilValue; END_CPP11 }" - ) - }) - - it("returns the wrapped function for a single function with arguments", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "int", - args = list(tibble::tibble(type = "int", name = "bar")) - ) + ) +}) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp +test_that("generate_cpp_functions returns the wrapped function for a single function with arguments", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "int", + args = list(tibble::tibble(type = "int", name = "bar")) + ) + + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp int foo(int bar); extern \"C\" SEXP _cpp11_foo(SEXP bar) { BEGIN_CPP11 return cpp11::as_sexp(foo(cpp11::as_cpp>(bar))); END_CPP11 }" - ) - }) - - it("returns the wrapped functions for multiple functions with arguments", { - funs <- tibble::tibble( - file = c("foo.cpp", "bar.cpp"), - line = c(1L, 3L), - decoration = c("cpp11", "cpp11"), - params = list(NA, NA), - context = list(NA_character_, NA_character_), - name = c("foo", "bar"), - return_type = c("int", "bool"), - args = list( - tibble::tibble(type = "int", name = "bar"), - tibble::tibble(type = "double", name = "baz") - ) - ) + ) +}) - expect_equal(generate_cpp_functions(funs), -"// foo.cpp +test_that("generate_cpp_functions returns the wrapped functions for multiple functions with arguments", { + funs <- tibble::tibble( + file = c("foo.cpp", "bar.cpp"), + line = c(1L, 3L), + decoration = c("cpp11", "cpp11"), + params = list(NA, NA), + context = list(NA_character_, NA_character_), + name = c("foo", "bar"), + return_type = c("int", "bool"), + args = list( + tibble::tibble(type = "int", name = "bar"), + tibble::tibble(type = "double", name = "baz") + ) + ) + + expect_equal( + generate_cpp_functions(funs), + "// foo.cpp int foo(int bar); extern \"C\" SEXP _cpp11_foo(SEXP bar) { BEGIN_CPP11 @@ -322,374 +322,382 @@ extern \"C\" SEXP _cpp11_bar(SEXP baz) { return cpp11::as_sexp(bar(cpp11::as_cpp>(baz))); END_CPP11 }" - ) - }) -}) - -describe("generate_r_functions", { - it("returns the empty string if there are no functions", { - skip_if_not_installed("glue", "1.6.2.9000") - - funs <- tibble::tibble( - file = character(), - line = integer(), - decoration = character(), - params = list(), - context = list(), - name = character(), - return_type = character(), - args = list() - ) + ) +}) - expect_equal(generate_r_functions(funs), "") - }) - - it("returns the wrapped function for a single void function with no arguments", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "void", - args = list(tibble::tibble(type = character(), name = character())) - ) +test_that("generate_r_functions returns the empty string if there are no functions", { + skip_if_not_installed("glue", "1.6.2.9000") + + funs <- tibble::tibble( + file = character(), + line = integer(), + decoration = character(), + params = list(), + context = list(), + name = character(), + return_type = character(), + args = list() + ) + + expect_equal(generate_r_functions(funs), "") +}) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function() { +test_that("generate_r_functions returns the wrapped function for a single void function with no arguments", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "void", + args = list(tibble::tibble(type = character(), name = character())) + ) + + 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", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "void", - args = list(tibble::tibble(type = character(), name = character())) - ) +}" + ) +}) - expect_equal(generate_r_functions(funs, package = "cpp11", use_package = TRUE), -"foo <- function() { +test_that("generate_r_functions returns the wrapped function for a single void function with no arguments and use_package = TRUE", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "void", + args = list(tibble::tibble(type = character(), name = character())) + ) + + 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", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "void", - args = list(tibble::tibble(type = character(), name = character())) - ) +}" + ) +}) - expect_equal(generate_r_functions(funs, package = "mypkg"), -"foo <- function() { +test_that("generate_r_functions returns the wrapped function for a single void function with no arguments and different package name", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "void", + args = list(tibble::tibble(type = character(), name = character())) + ) + + 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", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "int", - args = list(tibble::tibble(type = character(), name = character())) - ) +}" + ) +}) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function() { +test_that("generate_r_functions returns the wrapped function for a single function with no arguments", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "int", + args = list(tibble::tibble(type = character(), name = character())) + ) + + 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", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "int", - args = list(tibble::tibble(type = character(), name = character())) - ) +}" + ) +}) - expect_equal(generate_r_functions(funs, package = "cpp11", use_package = TRUE), -"foo <- function() { +test_that("generate_r_functions returns the wrapped function for a single function with no arguments and use_package = TRUE", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "int", + args = list(tibble::tibble(type = character(), name = character())) + ) + + 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", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "void", - args = list(tibble::tibble(type = "int", name = "bar")) - ) +}" + ) +}) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function(bar) { +test_that("generate_r_functions returns the wrapped function for a single void function with arguments", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "void", + args = list(tibble::tibble(type = "int", name = "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", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "int", - args = list(tibble::tibble(type = "int", name = "bar")) - ) +}" + ) +}) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function(bar) { +test_that("generate_r_functions returns the wrapped function for a single function with arguments", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "int", + args = list(tibble::tibble(type = "int", name = "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", { - funs <- tibble::tibble( - file = c("foo.cpp", "bar.cpp"), - line = c(1L, 3L), - decoration = c("cpp11", "cpp11"), - params = list(NA, NA), - context = list(NA_character_, NA_character_), - name = c("foo", "bar"), - return_type = c("int", "bool"), - args = list( - tibble::tibble(type = "int", name = "bar"), - tibble::tibble(type = "double", name = "baz") - ) - ) +}" + ) +}) - expect_equal(generate_r_functions(funs, package = "cpp11"), -"foo <- function(bar) { +test_that("generate_r_functions returns the wrapped functions for multiple functions with arguments", { + funs <- tibble::tibble( + file = c("foo.cpp", "bar.cpp"), + line = c(1L, 3L), + decoration = c("cpp11", "cpp11"), + params = list(NA, NA), + context = list(NA_character_, NA_character_), + name = c("foo", "bar"), + return_type = c("int", "bool"), + args = list( + tibble::tibble(type = "int", name = "bar"), + tibble::tibble(type = "double", name = "baz") + ) + ) + + expect_equal( + generate_r_functions(funs, package = "cpp11"), + "foo <- function(bar) { .Call(`_cpp11_foo`, bar) } bar <- function(baz) { .Call(`_cpp11_bar`, baz) -}") - }) -}) - -describe("cpp_register", { - it("returns an invisible empty character if there are no decorations", { - f <- tempfile() - expect_equal(cpp_register(f), character()) - - 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") - - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) - cpp_register(p) - - r_bindings <- file.path(p, "R", "cpp11.R") - expect_true(file.exists(r_bindings)) - expect_snapshot(cat(read_file(r_bindings))) - - cpp_bindings <- file.path(p, "src", "cpp11.cpp") - expect_true(file.exists(cpp_bindings)) - expect_snapshot(cat(read_file(cpp_bindings))) - }) - - it("can be run without messages", { - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) - expect_silent(cpp_register(p, quiet = TRUE)) - }) - - it("can be run with messages", { - local_reproducible_output() - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) - - expect_snapshot( - cpp_register(p, quiet = FALSE) - ) - }) - - it("includes pkg_types.h if included in src", { - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) - writeLines("#include ", file.path(p, "src", "testPkg_types.h")) - cpp_register(p) - - expect_true( - any( - grepl( - pattern = '#include "testPkg_types.h"', - x = readLines(file.path(p, "src", "cpp11.cpp")), - fixed = TRUE - ) +}" + ) +}) + +test_that("cpp_register returns an invisible empty character if there are no decorations", { + f <- tempfile() + expect_equal(cpp_register(f), character()) + + dir.create(f) + expect_equal(cpp_register(f), character()) +}) + +test_that("cpp_register 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") + + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) + cpp_register(p) + + r_bindings <- file.path(p, "R", "cpp11.R") + expect_true(file.exists(r_bindings)) + expect_snapshot(cat(read_file(r_bindings))) + + cpp_bindings <- file.path(p, "src", "cpp11.cpp") + expect_true(file.exists(cpp_bindings)) + expect_snapshot(cat(read_file(cpp_bindings))) +}) + +test_that("cpp_register can be run without messages", { + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) + expect_silent(cpp_register(p, quiet = TRUE)) +}) + +test_that("cpp_register can be run with messages", { + local_reproducible_output() + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) + + expect_snapshot( + cpp_register(p, quiet = FALSE) + ) +}) + +test_that("cpp_register includes pkg_types.h if included in src", { + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) + writeLines("#include ", file.path(p, "src", "testPkg_types.h")) + cpp_register(p) + + expect_true( + any( + grepl( + pattern = '#include "testPkg_types.h"', + x = readLines(file.path(p, "src", "cpp11.cpp")), + fixed = TRUE ) ) - }) - - it("includes pkg_types.hpp if included in src", { - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) - writeLines("#include ", file.path(p, "src", "testPkg_types.hpp")) - cpp_register(p) - - expect_true( - any( - grepl( - pattern = '#include "testPkg_types.hpp"', - x = readLines(file.path(p, "src", "cpp11.cpp")), - fixed = TRUE - ) + ) +}) + +test_that("cpp_register includes pkg_types.hpp if included in src", { + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + file.copy(test_path("single.cpp"), file.path(p, "src", "single.cpp")) + writeLines("#include ", file.path(p, "src", "testPkg_types.hpp")) + cpp_register(p) + + expect_true( + any( + grepl( + pattern = '#include "testPkg_types.hpp"', + x = readLines(file.path(p, "src", "cpp11.cpp")), + fixed = TRUE ) ) - }) - - it("includes pkg_types.h if included in inst/include", { - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - 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")) - cpp_register(p) - - expect_true( - any( - grepl( - pattern = '#include "testPkg_types.h"', - x = readLines(file.path(p, "src", "cpp11.cpp")), - fixed = TRUE - ) + ) +}) + +test_that("cpp_register includes pkg_types.h if included in inst/include", { + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + 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")) + cpp_register(p) + + expect_true( + any( + grepl( + pattern = '#include "testPkg_types.h"', + x = readLines(file.path(p, "src", "cpp11.cpp")), + fixed = TRUE ) ) - }) - - it("includes pkg_types.hpp if included in inst/include", { - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - 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")) - cpp_register(p) - - expect_true( - any( - grepl( - pattern = '#include "testPkg_types.hpp"', - x = readLines(file.path(p, "src", "cpp11.cpp")), - fixed = TRUE - ) + ) +}) + +test_that("cpp_register includes pkg_types.hpp if included in inst/include", { + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + 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")) + cpp_register(p) + + expect_true( + any( + grepl( + pattern = '#include "testPkg_types.hpp"', + x = readLines(file.path(p, "src", "cpp11.cpp")), + fixed = TRUE ) ) - }) - - it("does not error if no files have registered functions", { - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - writeLines("int foo(int x) { return x; }", file.path(p, "src", "foo.cpp")) - - expect_error_free(cpp_register(p)) - }) - - it("accepts .cc as an alternative value for extension=", { - pkg <- local_package() - p <- pkg_path(pkg) - dir.create(file.path(p, "src")) - file.copy(test_path("single.cpp"), file.path(p, "src", "single.cc")) - cpp_register(p, extension = ".cc") - - expect_match(list.files(file.path(p, "src")), "\\.cc$") - }) -}) - -describe("generate_init_functions", { - it("returns an empty list if there no functions", { - funs <- tibble::tibble( - file = character(), - line = integer(), - decoration = character(), - params = list(), - context = list(), - name = character(), - return_type = character(), - args = list(tibble::tibble(type = character(), name = character())) - ) + ) +}) - expect_equal(generate_init_functions(funs), list(declarations = "", calls = "")) - }) - - it("returns the declaration and call for a single init function", { - funs <- tibble::tibble( - file = "foo.cpp", - line = 1L, - decoration = "cpp11", - params = list(NA), - context = list(NA_character_), - name = "foo", - return_type = "void", - args = list(tibble::tibble(type = "DllInfo*", name = "dll")) - ) +test_that("cpp_register does not error if no files have registered functions", { + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + writeLines("int foo(int x) { return x; }", file.path(p, "src", "foo.cpp")) - 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", { - funs <- tibble::tibble( - file = c("foo.cpp", "bar.cpp"), - line = c(1L, 3L), - decoration = c("cpp11", "cpp11"), - params = list(NA, NA), - 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")) - ) + expect_error_free(cpp_register(p)) +}) + +test_that("cpp_register accepts .cc as an alternative value for extension=", { + pkg <- local_package() + p <- pkg_path(pkg) + dir.create(file.path(p, "src")) + file.copy(test_path("single.cpp"), file.path(p, "src", "single.cc")) + cpp_register(p, extension = ".cc") + + expect_match(list.files(file.path(p, "src")), "\\.cc$") +}) + +test_that("generate_init_functions returns an empty list if there are no functions", { + funs <- tibble::tibble( + file = character(), + line = integer(), + decoration = character(), + params = list(), + context = list(), + name = character(), + return_type = character(), + args = list(tibble::tibble(type = character(), name = character())) + ) + + expect_equal(generate_init_functions(funs), list(declarations = "", calls = "")) +}) + +test_that("generate_init_functions returns the declaration and call for a single init function", { + funs <- tibble::tibble( + file = "foo.cpp", + line = 1L, + decoration = "cpp11", + params = list(NA), + context = list(NA_character_), + name = "foo", + return_type = "void", + 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);\nvoid bar(DllInfo* dll);\n", calls = "\n foo(dll);\n bar(dll);")) - }) +test_that("generate_init_functions returns the declaration and call for multiple init functions", { + funs <- tibble::tibble( + file = c("foo.cpp", "bar.cpp"), + line = c(1L, 3L), + decoration = c("cpp11", "cpp11"), + params = list(NA, NA), + 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")) + ) + + expect_equal(generate_init_functions(funs), list(declarations = "\nvoid foo(DllInfo* dll);\nvoid bar(DllInfo* dll);\n", calls = "\n foo(dll);\n bar(dll);")) }) test_that("check_valid_attributes does not return an error if all registers are correct", { diff --git a/tests/testthat/test-source.R b/tests/testthat/test-source.R index 2945d51d..fbcd211f 100644 --- a/tests/testthat/test-source.R +++ b/tests/testthat/test-source.R @@ -104,15 +104,18 @@ expect_equal( }) test_that("generate_include_paths handles paths with spaces", { + # Windows test 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\"") + result <- generate_include_paths("cpp11", custom_path = "C:\\a path with spaces\\cpp11") + expect_equal(result, "-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'") + # Unix test + result <- generate_include_paths("cpp11", custom_path = "/a path with spaces/cpp11") + expect_equal(result, "-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 diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index 92932c20..9aa5cfd5 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -1,31 +1,33 @@ -describe("glue_collapse_data", { - it("works with empty inputs", { - expect_equal( - glue_collapse_data(mtcars, ""), - "" - ) +test_that("glue_collapse_data works with empty inputs", { + expect_equal( + glue_collapse_data(mtcars, ""), + "" + ) - expect_equal( - glue_collapse_data(mtcars[FALSE, ], "{hp}"), - "" - ) - }) + expect_equal( + glue_collapse_data(mtcars[FALSE, ], "{hp}"), + "" + ) +}) - it("works with non-empty inputs", { - expect_equal( - glue_collapse_data(mtcars[1, ], "{hp}"), - "110" - ) +test_that("glue_collapse_data works with non-empty inputs", { + expect_equal( + glue_collapse_data(mtcars[1, ], "{hp}"), + "110" + ) - expect_equal( - glue_collapse_data(mtcars[1:2, ], "{hp}"), - "110, 110" - ) - }) + expect_equal( + glue_collapse_data(mtcars[1:2, ], "{hp}"), + "110, 110" + ) }) -describe("stop_unless_installed", { - mockery::stub(stop_unless_installed, "requireNamespace", FALSE) +test_that("stop_unless_installed errors when package is not installed", { + original_requireNamespace <- requireNamespace + + # Temporarily override requireNamespace to simulate the package not being installed + requireNamespace <- function(...) FALSE + on.exit(requireNamespace <- original_requireNamespace, add = TRUE) expect_error( stop_unless_installed("foo"), diff --git a/tests/testthat/test-vendor.R b/tests/testthat/test-vendor.R index 361c9ad9..d7dd3b60 100644 --- a/tests/testthat/test-vendor.R +++ b/tests/testthat/test-vendor.R @@ -1,31 +1,29 @@ -describe("cpp_vendor", { - it("errors if cpp11 is not installed", { - pkg <- local_package() - mockery::stub(cpp_vendor, "system.file", "") - expect_error( - cpp_vendor(pkg_path(pkg)), - "cpp11 is not installed" - ) - }) +test_that("cpp_vendor errors if cpp11 is not installed", { + pkg <- local_package() - it("errors if cpp11 is already vendored", { - pkg <- local_package() - cpp_vendor(pkg_path(pkg)) + expect_error( + cpp_vendor(pkg_path(pkg), headers = ""), + "cpp11 is not installed" + ) +}) + +test_that("cpp_vendor errors if cpp11 is already vendored", { + pkg <- local_package() + cpp_vendor(pkg_path(pkg)) - expect_error( - cpp_vendor(pkg_path(pkg)), - "already exists" - ) - }) + expect_error( + cpp_vendor(pkg_path(pkg)), + "already exists" + ) +}) - it("vendors cpp11", { - pkg <- local_package() - p <- pkg_path(pkg) +test_that("cpp_vendor vendors cpp11", { + pkg <- local_package() + p <- pkg_path(pkg) - cpp_vendor(pkg_path(pkg)) + cpp_vendor(pkg_path(pkg)) - 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(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"))) })