1#' Run all tests in a directory
2#'
3#' This function is the low-level workhorse that powers [test_local()] and
4#' [test_package()]. Generally, you should not call this function directly.
5#' In particular, you are responsible for ensuring that the functions to test
6#' are available in the test `env` (e.g. via `load_package`).
7#'
8#' @section Special files:
9#' There are two types of `.R` file that have special behaviour:
10#'
11#' * Test files start with `test` and are executed in alphabetical order.
12#'
13#' * Setup files start with `setup` and are executed before tests. If
14#'   clean up is needed after all tests have been run, you can use
15#'   `withr::defer(clean_up(), teardown_env())`. See `vignette("test-fixtures")`
16#'   for more details.
17#'
18#' There are two other types of special file that we no longer recommend using:
19#'
20#' * Helper files start with `helper` and are executed before tests are
21#'   run. They're also loaded by `devtools::load_all()`, so there's no
22#'   real point to them and you should just put your helper code in `R/`.
23#'
24#' * Teardown files start with `teardown` and are executed after the tests
25#'   are run. Now we recommend interleave setup and cleanup code in `setup-`
26#'   files, making it easier to check that you automatically clean up every
27#'   mess that you make.
28#'
29#' All other files are ignored by testthat.
30#'
31#' @section Environments:
32#' Each test is run in a clean environment to keep tests as isolated as
33#' possible. For package tests, that environment that inherits from the
34#' package's namespace environment, so that tests can access internal functions
35#' and objects.
36#'
37#' @param path Path to directory containing tests.
38#' @param package If these tests belong to a package, the name of the package.
39#' @param filter If not `NULL`, only tests with file names matching this
40#'   regular expression will be executed. Matching is performed on the file
41#'   name after it's stripped of `"test-"` and `".R"`.
42#' @param env Environment in which to execute the tests. Expert use only.
43#' @param ... Additional arguments passed to [grepl()] to control filtering.
44#' @param load_helpers Source helper files before running the tests?
45#'   See [source_test_helpers()] for more details.
46#' @param stop_on_failure If `TRUE`, throw an error if any tests fail.
47#' @param stop_on_warning If `TRUE`, throw an error if any tests generate
48#'   warnings.
49#' @param load_package Strategy to use for load package code:
50#'   * "none", the default, doesn't load the package.
51#'   * "installed", uses [library()] to load an installed package.
52#'   * "source", uses [pkgload::load_all()] to a source package.
53#' @param wrap DEPRECATED
54#' @keywords internal
55#' @return A list (invisibly) containing data about the test results.
56#' @inheritParams with_reporter
57#' @inheritParams source_file
58#' @export
59test_dir <- function(path,
60                     filter = NULL,
61                     reporter = NULL,
62                     env = NULL,
63                     ...,
64                     load_helpers = TRUE,
65                     stop_on_failure = TRUE,
66                     stop_on_warning = FALSE,
67                     wrap = lifecycle::deprecated(),
68                     package = NULL,
69                     load_package = c("none", "installed", "source")
70                     ) {
71
72  load_package <- arg_match(load_package)
73
74  start_first <- find_test_start_first(path, load_package, package)
75  test_paths <- find_test_scripts(
76    path,
77    filter = filter,
78    ...,
79    full.names = FALSE,
80    start_first = start_first
81  )
82  if (length(test_paths) == 0) {
83    abort("No test files found")
84  }
85
86  if (!is_missing(wrap)) {
87    lifecycle::deprecate_warn("3.0.0", "test_dir(wrap = )")
88  }
89
90  want_parallel <- find_parallel(path, load_package, package)
91
92  if (is.null(reporter)) {
93    if (want_parallel) {
94      reporter <- default_parallel_reporter()
95    } else {
96      reporter <- default_reporter()
97    }
98  }
99  reporter <- find_reporter(reporter)
100  parallel <- want_parallel && reporter$capabilities$parallel_support
101
102  test_files(
103    test_dir = path,
104    test_paths = test_paths,
105    test_package = package,
106    reporter = reporter,
107    load_helpers = load_helpers,
108    env = env,
109    stop_on_failure = stop_on_failure,
110    stop_on_warning = stop_on_warning,
111    wrap = wrap,
112    load_package = load_package,
113    parallel = parallel
114  )
115}
116
117#' Run all tests in a single file
118#'
119#' Helper, setup, and teardown files located in the same directory as the
120#' test will also be run.
121#'
122#' @inherit test_dir return params
123#' @inheritSection test_dir Special files
124#' @inheritSection test_dir Environments
125#' @param path Path to file.
126#' @param ... Additional parameters passed on to `test_dir()`
127#' @export
128#' @examples
129#' path <- testthat_example("success")
130#' test_file(path)
131#' test_file(path, reporter = "minimal")
132test_file <- function(path, reporter = default_compact_reporter(), package = NULL, ...) {
133  if (!file.exists(path)) {
134    stop("`path` does not exist", call. = FALSE)
135  }
136
137  test_files(
138    test_dir = dirname(path),
139    test_package = package,
140    test_paths = basename(path),
141    reporter = reporter,
142    ...
143  )
144}
145
146test_files <- function(test_dir,
147                       test_package,
148                       test_paths,
149                       load_helpers = TRUE,
150                       reporter = default_reporter(),
151                       env = NULL,
152                       stop_on_failure = FALSE,
153                       stop_on_warning = FALSE,
154                       wrap = TRUE,
155                       load_package = c("none", "installed", "source"),
156                       parallel = FALSE) {
157
158  if (is_missing(wrap)) {
159    wrap <- TRUE
160  }
161  if (!isTRUE(wrap)) {
162    lifecycle::deprecate_warn("3.0.0", "test_dir(wrap = )")
163  }
164
165  if (parallel) {
166    test_files <- test_files_parallel
167  } else {
168    test_files <- test_files_serial
169  }
170
171  test_files(
172    test_dir = test_dir,
173    test_package = test_package,
174    test_paths = test_paths,
175    load_helpers = load_helpers,
176    reporter = reporter,
177    env = env,
178    stop_on_failure = stop_on_failure,
179    stop_on_warning = stop_on_warning,
180    wrap = wrap,
181    load_package = load_package
182  )
183}
184
185test_files_serial <- function(test_dir,
186                       test_package,
187                       test_paths,
188                       load_helpers = TRUE,
189                       reporter = default_reporter(),
190                       env = NULL,
191                       stop_on_failure = FALSE,
192                       stop_on_warning = FALSE,
193                       wrap = TRUE,
194                       load_package = c("none", "installed", "source")) {
195
196  env <- test_files_setup_env(test_package, test_dir, load_package, env)
197  test_files_setup_state(test_dir, test_package, load_helpers, env)
198  reporters <- test_files_reporter(reporter)
199
200  with_reporter(reporters$multi,
201    lapply(test_paths, test_one_file, env = env, wrap = wrap)
202  )
203
204  test_files_check(reporters$list$get_results(),
205    stop_on_failure = stop_on_failure,
206    stop_on_warning = stop_on_warning
207  )
208}
209
210test_files_setup_env <- function(test_package,
211                                 test_dir,
212                                 load_package = c("none", "installed", "source"),
213                                 env = NULL) {
214  library(testthat)
215
216  load_package <- arg_match(load_package)
217  switch(load_package,
218    none = {},
219    installed = library(test_package, character.only = TRUE),
220    source = pkgload::load_all(test_dir, helpers = FALSE, quiet = TRUE)
221  )
222
223  env %||% test_env(test_package)
224}
225
226test_files_setup_state <- function(test_dir, test_package, load_helpers, env, .env = parent.frame()) {
227
228  # Define testing environment
229  local_test_directory(test_dir, test_package, .env = .env)
230  withr::local_options(
231    topLevelEnvironment = env_parent(env),
232    .local_envir = .env
233  )
234
235  # Load helpers, setup, and teardown (on exit)
236  local_teardown_env(.env)
237  if (load_helpers) {
238    source_test_helpers(".", env)
239  }
240  source_test_setup(".", env)
241  withr::defer(withr::deferred_run(teardown_env()), .env) # new school
242  withr::defer(source_test_teardown(".", env), .env)      # old school
243}
244
245test_files_reporter <- function(reporter, .env = parent.frame()) {
246  lister <- ListReporter$new()
247  reporters <- list(
248    find_reporter(reporter),
249    lister, # track data
250    local_snapshotter("_snaps", .env = .env) # for snapshots
251  )
252  list(
253    multi = MultiReporter$new(reporters = compact(reporters)),
254    list = lister
255  )
256}
257
258test_files_check <- function(results, stop_on_failure = TRUE, stop_on_warning = FALSE) {
259  if (stop_on_failure && !all_passed(results)) {
260    stop("Test failures", call. = FALSE)
261  }
262  if (stop_on_warning && any_warnings(results)) {
263    stop("Tests generated warnings", call. = FALSE)
264  }
265
266  invisible(results)
267}
268
269test_one_file <- function(path, env = test_env(), wrap = TRUE) {
270  reporter <- get_reporter()
271  on.exit(teardown_run(), add = TRUE)
272
273  reporter$start_file(path)
274  source_file(path, child_env(env), wrap = wrap)
275  reporter$end_context_if_started()
276  reporter$end_file()
277}
278
279# Helpers -----------------------------------------------------------------
280
281#' Run code after all test files
282#'
283#' This environment has no purpose other than as a handle for [withr::defer()]:
284#' use it when you want to run code after all tests have been run.
285#' Typically, you'll use `withr::defer(cleanup(), teardown_env())`
286#' immediately after you've made a mess in a `setup-*.R` file.
287#'
288#' @export
289teardown_env <- function() {
290  testthat_env$teardown_env
291}
292
293local_teardown_env <- function(env = parent.frame()) {
294  old <- testthat_env$teardown_env
295  testthat_env$teardown_env <- child_env(emptyenv())
296  withr::defer(testthat_env$teardown_env <- old, env)
297
298  invisible()
299}
300
301#' Find test files
302#'
303#' @param path path to tests
304#' @param invert If `TRUE` return files which **don't** match.
305#' @param ... Additional arguments passed to [grepl()] to control filtering.
306#' @param start_first A character vector of file patterns (globs, see
307#'   [utils::glob2rx()]). The patterns are for the file names (base names),
308#'   not for the whole paths. testthat starts the files matching the
309#'   first pattern first,  then the ones matching the second, etc. and then
310#'   the rest of the files, alphabetically. Parallel tests tend to finish
311#'   quicker if you start the slowest files first. `NULL` means alphabetical
312#'   order.
313#' @inheritParams test_dir
314#' @return A character vector of paths
315#' @keywords internal
316#' @export
317find_test_scripts <- function(path, filter = NULL, invert = FALSE, ..., full.names = TRUE, start_first = NULL) {
318  files <- dir(path, "^test.*\\.[rR]$", full.names = full.names)
319  files <- filter_test_scripts(files, filter, invert, ...)
320  order_test_scripts(files, start_first)
321}
322
323filter_test_scripts <- function(files, filter = NULL, invert = FALSE, ...) {
324  if (is.null(filter)) {
325    return(files)
326  }
327
328  which_files <- grepl(filter, context_name(files), ...)
329  if (isTRUE(invert)) {
330    which_files <- !which_files
331  }
332  files[which_files]
333}
334
335find_test_start_first <- function(path, load_package, package) {
336  # Make sure we get the local package package if not "installed"
337  if (load_package != "installed") package <- NULL
338  desc <- find_description(path, package)
339  if (is.null(desc)) {
340    return(NULL)
341  }
342
343  conf <- desc$get_field("Config/testthat/start-first", NULL)
344  if (is.null(conf)) {
345    return(NULL)
346  }
347
348  trimws(strsplit(conf, ",")[[1]])
349}
350
351order_test_scripts <- function(paths, start_first) {
352  if (is.null(start_first)) return(paths)
353  filemap <- data.frame(
354    stringsAsFactors = FALSE,
355    base = sub("\\.[rR]$", "", sub("^test[-_\\.]?", "", basename(paths))),
356    orig = paths
357  )
358  rxs <- utils::glob2rx(start_first)
359  mch <- lapply(rxs, function(rx) filemap$orig[grep(rx, filemap$base)])
360  unique(c(unlist(mch), paths))
361}
362