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