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
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
|
#' Locally set options for maximal test reproducibility
#'
#' @description
#' `local_test_context()` is run automatically by `test_that()` but you may
#' want to run it yourself if you want to replicate test results interactively.
#' If run inside a function, the effects are automatically reversed when the
#' function exits; if running in the global environment, use
#' [withr::deferred_run()] to undo.
#'
#' `local_reproducible_output()` is run automatically by `test_that()` in the
#' 3rd edition. You might want to call it to override the the default settings
#' inside a test, if you want to test Unicode, coloured output, or a
#' non-standard width.
#'
#' @details
#' `local_test_context()` sets `TESTTHAT = "true"`, which ensures that
#' [is_testing()] returns `TRUE` and allows code to tell if it is run by
#' testthat.
#'
#' In the third edition, `local_test_context()` also calls
#' `local_reproducible_output()` which temporary sets the following options:
#'
#' * `cli.dynamic = FALSE` so that tests assume that they are not run in
#' a dynamic console (i.e. one where you can move the cursor around).
#' * `cli.unicode` (default: `FALSE`) so that the cli package never generates
#' unicode output (normally cli uses unicode on Linux/Mac but not Windows).
#' Windows can't easily save unicode output to disk, so it must be set to
#' false for consistency.
#' * `cli.condition_width = Inf` so that new lines introduced while
#' width-wrapping condition messages don't interfere with message matching.
#' * `crayon.enabled` (default: `FALSE`) suppresses ANSI colours generated by
#' the cli and crayon packages (normally colours are used if cli detects
#' that you're in a terminal that supports colour).
#' * `cli.num_colors` (default: `1L`) Same as the crayon option.
#' * `lifecycle_verbosity = "warning"` so that every lifecycle problem always
#' generates a warning (otherwise deprecated functions don't generate a
#' warning every time).
#' * `max.print = 99999` so the same number of values are printed.
#' * `OutDec = "."` so numbers always uses `.` as the decimal point
#' (European users sometimes set `OutDec = ","`).
#' * `rlang_interactive = FALSE` so that [rlang::is_interactive()] returns
#' `FALSE`, and code that uses it pretends you're in a non-interactive
#' environment.
#' * `useFancyQuotes = FALSE` so base R functions always use regular (straight)
#' quotes (otherwise the default is locale dependent, see [sQuote()] for
#' details).
#' * `width` (default: 80) to control the width of printed output (usually this
#' varies with the size of your console).
#'
#' And modifies the following env vars:
#'
#' * Unsets `RSTUDIO`, which ensures that RStudio is never detected as running.
#' * Sets `LANGUAGE = "en"`, which ensures that no message translation occurs.
#'
#' Finally, it sets the collation locale to "C", which ensures that character
#' sorting the same regardless of system locale.
#'
#' @export
#' @param .env Environment to use for scoping; expert use only.
#' @examples
#' local({
#' local_test_context()
#' cat(cli::col_blue("Text will not be colored"))
#' cat(cli::symbol$ellipsis)
#' cat("\n")
#' })
local_test_context <- function(.env = parent.frame()) {
withr::local_envvar("_R_CHECK_BROWSER_NONINTERACTIVE_" = "true", TESTTHAT = "true", .local_envir = .env)
if (edition_get() >= 3) {
local_reproducible_output(.env = .env)
}
}
#' @export
#' @param width Value of the `"width"` option.
#' @param crayon Determines whether or not crayon (now cli) colour
#' should be applied.
#' @param unicode Value of the `"cli.unicode"` option.
#' The test is skipped if `` l10n_info()$`UTF-8` `` is `FALSE`.
#' @param rstudio Should we pretend that we're inside of RStudio?
#' @param hyperlinks Should we use ANSI hyperlinks.
#' @param lang Optionally, supply a BCP47 language code to set the language
#' used for translating error messages. This is a lower case two letter
#' [ISO 639 country code](https://en.wikipedia.org/wiki/List_of_ISO_639-1_codes),
#' optionally followed by "_" or "-" and an upper case two letter
#' [ISO 3166 region code](https://en.wikipedia.org/wiki/ISO_3166-2).
#' @rdname local_test_context
#' @examples
#' test_that("test ellipsis", {
#' local_reproducible_output(unicode = FALSE)
#' expect_equal(cli::symbol$ellipsis, "...")
#'
#' local_reproducible_output(unicode = TRUE)
#' expect_equal(cli::symbol$ellipsis, "\u2026")
#' })
local_reproducible_output <- function(width = 80,
crayon = FALSE,
unicode = FALSE,
rstudio = FALSE,
hyperlinks = FALSE,
lang = "C",
.env = parent.frame()) {
if (unicode) {
# If you force unicode display, you _must_ skip the test on non-utf8
# locales; otherwise it's guaranteed to fail
skip_if(!l10n_info()$`UTF-8`, "non utf8 locale")
}
local_width(width = width, .env = .env)
withr::local_options(
crayon.enabled = crayon,
cli.hyperlink = hyperlinks,
cli.hyperlink_run = hyperlinks,
cli.hyperlink_help = hyperlinks,
cli.hyperlink_vignette = hyperlinks,
cli.dynamic = FALSE,
cli.unicode = unicode,
cli.condition_width = Inf,
cli.num_colors = if (crayon) 8L else 1L,
useFancyQuotes = FALSE,
lifecycle_verbosity = "warning",
OutDec = ".",
rlang_interactive = FALSE,
max.print = 99999,
.local_envir = .env,
)
withr::local_envvar(
RSTUDIO = if (rstudio) 1 else NA,
RSTUDIO_SESSION_PID = if (rstudio) Sys.getpid() else NA,
RSTUDIO_CHILD_PROCESS_PANE = if (rstudio) "build" else NA,
RSTUDIO_CLI_HYPERLINKS = if (rstudio) 1 else NA,
.local_envir = .env
)
withr::local_language(lang, .local_envir = .env)
withr::local_collate("C", .local_envir = .env)
}
local_reporter_output <- function(.env = parent.frame()) {
reporter <- get_reporter()
if (!is.null(reporter)) {
reporter$local_user_output(.env)
}
}
waldo_compare <- function(x, y, ..., x_arg = "x", y_arg = "y") {
# Need to very carefully isolate this change to this function - can not set
# in expectation functions because part of expectation handling bubbles
# up through calling handlers, which are run before on.exit()
local_reporter_output()
waldo::compare(x, y,..., x_arg = x_arg, y_arg = y_arg)
}
local_width <- function(width = 80, .env = parent.frame()) {
withr::local_options(width = width, cli.width = width, .local_envir = .env)
withr::local_envvar(RSTUDIO_CONSOLE_WIDTH = width, .local_envir = .env)
}
#' Locally set test directory options
#'
#' For expert use only.
#'
#' @param path Path to directory of files
#' @param package Optional package name, if known.
#' @export
#' @keywords internal
local_test_directory <- function(path, package = NULL, .env = parent.frame()) {
# Set edition before changing working directory in case path is relative
local_edition(find_edition(path, package), .env = .env)
withr::local_dir(
path,
.local_envir = .env
)
withr::local_envvar(
R_TESTS = "",
TESTTHAT = "true",
TESTTHAT_PKG = package,
.local_envir = .env
)
}
local_interactive_reporter <- function(.env = parent.frame()) {
# Definitely not on CRAN
withr::local_envvar(NOT_CRAN = "true", .local_envir = .env)
withr::local_options(testthat_interactive = TRUE, .local_envir = .env)
# Use edition from working directory
local_edition(find_edition("."), .env = .env)
# Use StopReporter
reporter <- StopReporter$new()
old <- set_reporter(reporter)
withr::defer(reporter$stop_if_needed(), envir = .env)
withr::defer(set_reporter(old), envir = .env)
reporter
}
|
