1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
|
file_teardown_env <- new.env(parent = emptyenv())
file_teardown_env$queue <- list()
#' Run code before/after tests
#'
#' @description
#' `r lifecycle::badge("superseded")`
#'
#' We no longer recommend using `setup()` and `teardown()`; instead
#' we think it's better practice to use a **test fixture** as described in
#' `vignette("test-fixtures")`.
#'
#' Code in a `setup()` block is run immediately in a clean environment.
#' Code in a `teardown()` block is run upon completion of a test file,
#' even if it exits with an error. Multiple calls to `teardown()` will be
#' executed in the order they were created.
#'
#' @param code Code to evaluate
#' @param env Environment in which code will be evaluated. For expert
#' use only.
#' @export
#' @keywords internal
#' @examples
#' \dontrun{
#' # Old approach
#' tmp <- tempfile()
#' setup(writeLines("some test data", tmp))
#' teardown(unlink(tmp))
#' }
#'
#' # Now recommended:
#' local_test_data <- function(env = parent.frame()) {
#' tmp <- tempfile()
#' writeLines("some test data", tmp)
#' withr::defer(unlink(tmp), env)
#'
#' tmp
#' }
#' # Then call local_test_data() in your tests
teardown <- function(code, env = parent.frame()) {
edition_deprecate(3, "teardown()",
"Please use test fixtures instead see vignette('test-fixtures') for details"
)
fun <- new_function(list(), enexpr(code), env = env)
file_teardown_env$queue <- append(file_teardown_env$queue, fun)
invisible()
}
#' @export
#' @rdname teardown
setup <- function(code, env = parent.frame()) {
edition_deprecate(3, "setup()",
"Please use test fixtures instead see vignette('test-fixtures') for details"
)
out <- eval_tidy(enquo(code), env = env)
invisible(out)
}
teardown_reset <- function() {
file_teardown_env$queue <- list()
}
teardown_run <- function(path = ".") {
if (length(file_teardown_env$queue) == 0)
return()
old_dir <- setwd(path)
on.exit(setwd(old_dir), add = TRUE)
lapply(file_teardown_env$queue, function(f) try(f()))
teardown_reset()
gc()
}
|
