1#' Execute testthat tests in a package
2#'
3#' @description
4#' * `test()` runs all tests in a package. It's a shortcut for
5#'   [testthat::test_dir()]
6#' * `test_active_file()` runs `test()` on the active file.
7#' * `test_coverage()` computes test coverage for your package. It's a
8#'   shortcut for [covr::package_coverage()] plus [covr::report()].
9#' * `test_coverage_active_file()` computes test coverage for the active file. It's a
10#'   shortcut for [covr::file_coverage()] plus [covr::report()].
11#'
12#' @template devtools
13#' @param ... additional arguments passed to wrapped functions.
14#' @param file One or more source or test files. If a source file the
15#'   corresponding test file will be run. The default is to use the active file
16#'   in RStudio (if available).
17#' @inheritParams testthat::test_dir
18#' @inheritParams pkgload::load_all
19#' @inheritParams run_examples
20#' @export
21test <- function(pkg = ".", filter = NULL, stop_on_failure = FALSE, export_all = TRUE, ...) {
22  save_all()
23  pkg <- as.package(pkg)
24
25  if (!uses_testthat(pkg) && interactive()) {
26    cli::cli_alert_danger("No testing infrastructure found. Create it?")
27    if (utils::menu(c("Yes", "No")) == 1) {
28      usethis_use_testthat(pkg)
29    }
30    return(invisible())
31  }
32
33  load_all(pkg$path)
34
35  cli::cli_alert_info("Testing {.pkg {pkg$package}}")
36  withr::local_envvar(r_env_vars())
37  testthat::test_local(
38    pkg$path,
39    filter = filter,
40    stop_on_failure = stop_on_failure,
41    ...
42  )
43}
44
45#' @rdname devtools-deprecated
46#' @export
47test_file <- function(file = find_active_file(), ...) {
48  lifecycle::deprecate_soft("2.4.0", "test_file()", "test_active_file()")
49  test_active_file(file, ...)
50}
51
52#' @export
53#' @rdname test
54test_active_file <- function(file = find_active_file(), ...) {
55  save_all()
56  test_files <- find_test_file(file)
57  pkg <- as.package(path_dir(test_files)[[1]])
58
59  withr::local_envvar(r_env_vars())
60  load_all(pkg$path, quiet = TRUE)
61  testthat::test_file(test_files, ...)
62}
63
64#' @param show_report Show the test coverage report.
65#' @export
66#' @rdname test
67test_coverage <- function(pkg = ".", show_report = interactive(), ...) {
68  rlang::check_installed(c("covr", "DT"))
69
70  save_all()
71  pkg <- as.package(pkg)
72  cli::cli_alert_info("Computing test coverage for {.pkg {pkg$package}}")
73
74  check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn))
75
76  withr::local_envvar(r_env_vars())
77  testthat::local_test_directory(pkg$path, pkg$package)
78  coverage <- covr::package_coverage(pkg$path, ...)
79
80  if (isTRUE(show_report)) {
81    covr::report(coverage)
82  }
83
84  invisible(coverage)
85}
86
87#' @rdname devtools-deprecated
88#' @export
89test_coverage_file <- function(file = find_active_file(), ...) {
90  lifecycle::deprecate_soft("2.4.0", "test_coverage()", "test_coverage_active_file()")
91  test_coverage_active_file(file, ...)
92}
93
94#' @rdname test
95#' @export
96test_coverage_active_file <- function(file = find_active_file(), filter = TRUE, show_report = interactive(), export_all = TRUE, ...) {
97  rlang::check_installed(c("covr", "DT"))
98
99  save_all()
100  test_files <- find_test_file(file)
101  pkg <- as.package(path_dir(file)[[1]])
102
103  check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn))
104
105  withr::local_envvar(r_env_vars())
106  testthat::local_test_directory(pkg$path, pkg$package)
107  reporter <- testthat::local_snapshotter(cleanup = TRUE)
108  reporter$start_file(file, "test")
109
110  env <- load_all(pkg$path, quiet = TRUE, export_all = export_all)$env
111  testthat::with_reporter(reporter, {
112    coverage <- covr::environment_coverage(env, test_files, ...)
113  })
114
115  if (isTRUE(filter)) {
116    coverage_name <- name_source(covr::display_name(coverage))
117    local_name <- name_test(file)
118    coverage <- coverage[coverage_name %in% local_name]
119  }
120
121  # Use relative paths
122  attr(coverage, "relative") <- TRUE
123  attr(coverage, "package") <- pkg
124
125  if (isTRUE(show_report)) {
126    covered <- unique(covr::display_name(coverage))
127
128    if (length(covered) == 1) {
129      covr::file_report(coverage)
130    } else {
131      covr::report(coverage)
132    }
133  }
134
135  invisible(coverage)
136}
137
138
139#' Does a package use testthat?
140#'
141#' @export
142#' @keywords internal
143uses_testthat <- function(pkg = ".") {
144  pkg <- as.package(pkg)
145
146  paths <- c(
147    path(pkg$path, "inst", "tests"),
148    path(pkg$path, "tests", "testthat")
149  )
150
151  any(dir_exists(paths))
152}
153