Skip to content
Permalink
master
Go to file
 
 
Cannot retrieve contributors at this time
136 lines (112 sloc) 3.81 KB
#' Execute testthat tests in a package
#'
#' @description
#' * `test()` runs all tests in a package. It's a shortcut for
#' [testthat::test_dir()]
#' * `test_file()` runs `test()` on the active file.
#' * `test_coverage()` computes test coverage for your package. It's a
#' shortcut for [covr::package_coverage()] plus [covr::report()].
#' * `test_coverage_file()` computes test coverage for the active file. It's a
#' shortcut for [covr::file_coverage()] plus [covr::report()].
#'
#' @template devtools
#' @param ... additional arguments passed to wrapped functions.
#' @param file One or more source or test files. If a source file the
#' corresponding test file will be run. The default is to use the active file
#' in RStudio (if available).
#' @inheritParams testthat::test_dir
#' @inheritParams pkgload::load_all
#' @inheritParams run_examples
#' @export
test <- function(pkg = ".", filter = NULL, stop_on_failure = FALSE, export_all = TRUE, ...) {
save_all()
pkg <- as.package(pkg)
if (!uses_testthat(pkg) && interactive()) {
cli::cli_alert_danger("No testing infrastructure found. Create it?")
if (utils::menu(c("Yes", "No")) == 1) {
usethis_use_testthat(pkg)
}
return(invisible())
}
load_all(pkg$path)
cli::cli_alert_info("Testing {.pkg {pkg$package}}")
testthat::test_local(
pkg$path,
filter = filter,
stop_on_failure = stop_on_failure,
...
)
}
#' @export
#' @rdname test
test_file <- function(file = find_active_file(), ...) {
save_all()
test_files <- find_test_file(file)
pkg <- as.package(dirname(test_files)[[1]])
load_all(pkg$path, quiet = TRUE)
testthat::test_file(test_files, ...)
}
#' @param show_report Show the test coverage report.
#' @export
#' @rdname test
# we now depend on DT in devtools so DT is installed when users call test_coverage
test_coverage <- function(pkg = ".", show_report = interactive(), ...) {
# This is just here to avoid a R CMD check NOTE about unused dependencies
DT::datatable
save_all()
pkg <- as.package(pkg)
cli::cli_alert_info("Computing test coverage for {.pkg {pkg$package}}")
check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn))
withr::local_envvar(r_env_vars())
testthat::local_test_directory(pkg$path, pkg$package)
coverage <- covr::package_coverage(pkg$path, ...)
if (isTRUE(show_report)) {
covr::report(coverage)
}
invisible(coverage)
}
#' @rdname test
#' @export
test_coverage_file <- function(file = find_active_file(), filter = TRUE, show_report = interactive(), export_all = TRUE, ...) {
save_all()
test_files <- find_test_file(file)
pkg <- as.package(dirname(file)[[1]])
check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn))
withr::local_envvar(r_env_vars())
testthat::local_test_directory(pkg$path, pkg$package)
reporter <- testthat::local_snapshotter(cleanup = TRUE)
reporter$start_file(file, "test")
env <- load_all(pkg$path, quiet = TRUE, export_all = export_all)$env
testthat::with_reporter(reporter, {
coverage <- covr::environment_coverage(env, test_files, ...)
})
if (isTRUE(filter)) {
coverage_name <- name_source(covr::display_name(coverage))
local_name <- name_test(file)
coverage <- coverage[coverage_name %in% local_name]
}
# Use relative paths
attr(coverage, "relative") <- TRUE
attr(coverage, "package") <- pkg
if (isTRUE(show_report)) {
covered <- unique(covr::display_name(coverage))
if (length(covered) == 1) {
covr::file_report(coverage)
} else {
covr::report(coverage)
}
}
invisible(coverage)
}
#' Does a package use testthat?
#'
#' @export
#' @keywords internal
uses_testthat <- function(pkg = ".") {
pkg <- as.package(pkg)
paths <- c(
file.path(pkg$path, "inst", "tests"),
file.path(pkg$path, "tests", "testthat")
)
any(dir.exists(paths))
}