1#' Locally set options for maximal test reproducibility
2#'
3#' @description
4#' `local_test_context()` is run automatically by `test_that()` but you may
5#' want to run it yourself if you want to replicate test results interactively.
6#' If run inside a function, the effects are automatically reversed when the
7#' function exits; if running in the global environment, use
8#' [withr::deferred_run()] to undo.
9#'
10#' `local_reproducible_output()` is run automatically by `test_that()` in the
11#' 3rd edition. You might want to call it to override the the default settings
12#' inside a test, if you want to test Unicode, coloured output, or a
13#' non-standard width.
14#'
15#' @details
16#' `local_test_context()` sets `TESTTHAT = "true"`, which ensures that
17#' [is_testing()] returns `TRUE` and allows code to tell if it is run by
18#' testthat.
19#'
20#' In the third edition, `local_test_context()` also calls
21#' `local_reproducible_output()` which temporary sets the following options:
22#'
23#' * `cli.dynamic = FALSE` so that tests assume that they are not run in
24#'   a dynamic console (i.e. one where you can move the cursor around).
25#' * `cli.unicode` (default: `FALSE`) so that the cli package never generates
26#'   unicode output (normally cli uses unicode on Linux/Mac but not Windows).
27#'   Windows can't easily save unicode output to disk, so it must be set to
28#'   false for consistency.
29#' * `cli.condition_width = Inf` so that new lines introduced while
30#'   width-wrapping condition messages don't interfere with message matching.
31#' * `crayon.enabled` (default: `FALSE`) suppresses ANSI colours generated by
32#'   the crayon package (normally colours are used if crayon detects that you're
33#'   in a terminal that supports colour).
34#' * `lifecycle_verbosity = "warning"` so that every lifecycle problem always
35#'   generates a warning (otherwise deprecated functions don't generate a
36#'   warning every time).
37#' * `max.print = 99999` so the same number of values are printed.
38#' * `OutDec = "."` so numbers always uses `.` as the decimal point
39#'   (European users sometimes set `OutDec = ","`).
40#' * `rlang_interactive = FALSE` so that [rlang::is_interactive()] returns
41#'   `FALSE`, and code that uses it pretends you're in a non-interactive
42#'   environment.
43#' * `useFancyQuotes = FALSE` so base R functions always use regular (straight)
44#'   quotes (otherwise the default is locale dependent, see [sQuote()] for
45#'   details).
46#' * `width` (default: 80) to control the width of printed output (usually this
47#'   varies with the size of your console).
48#'
49#' And modifies the following env vars:
50#'
51#' * Unsets `RSTUDIO`, which ensures that RStudio is never detected as running.
52#' * Sets `LANGUAGE = "en"`, which ensures that no message translation occurs.
53#'
54#' Finally, it sets the collation locale to "C", which ensures that character
55#' sorting the same regardless of system locale.
56#'
57#' @export
58#' @param .env Environment to use for scoping; expert use only.
59#' @examples
60#' local({
61#'   local_test_context()
62#'   cat(crayon::blue("Text will not be colored"))
63#'   cat(cli::symbol$ellipsis)
64#'   cat("\n")
65#' })
66local_test_context <- function(.env = parent.frame()) {
67  withr::local_envvar(TESTTHAT = "true", .local_envir = .env)
68  if (edition_get() >= 3) {
69    local_reproducible_output(.env = .env)
70  }
71}
72
73#' @export
74#' @param width Value of the `"width"` option.
75#' @param crayon Value of the `"crayon.enabled"` option.
76#' @param unicode Value of the `"cli.unicode"` option.
77#'   The test is skipped if `` l10n_info()$`UTF-8` `` is `FALSE`.
78#' @rdname local_test_context
79#' @examples
80#' test_that("test ellipsis", {
81#'   local_reproducible_output(unicode = FALSE)
82#'   expect_equal(cli::symbol$ellipsis, "...")
83#'
84#'   local_reproducible_output(unicode = TRUE)
85#'   expect_equal(cli::symbol$ellipsis, "\u2026")
86#' })
87local_reproducible_output <- function(width = 80,
88                                      crayon = FALSE,
89                                      unicode = FALSE,
90                                      .env = parent.frame()) {
91
92  if (unicode) {
93    # If you force unicode display, you _must_ skip the test on non-utf8
94    # locales; otherwise it's guaranteed to fail
95    skip_if(!l10n_info()$`UTF-8`, "non utf8 locale")
96  }
97
98  local_width(width = width, .env = .env)
99  withr::local_options(
100    crayon.enabled = crayon,
101    cli.dynamic = FALSE,
102    cli.unicode = unicode,
103    cli.condition_width = Inf,
104    useFancyQuotes = FALSE,
105    lifecycle_verbosity = "warning",
106    OutDec = ".",
107    rlang_interactive = FALSE,
108    max.print = 99999,
109    .local_envir = .env,
110  )
111  withr::local_envvar(
112    RSTUDIO = NA,
113    LANGUAGE = "en",
114    .local_envir = .env
115  )
116  withr::local_collate("C", .local_envir = .env)
117}
118
119waldo_compare <- function(x, y, ..., x_arg = "x", y_arg = "y") {
120
121  reporter <- get_reporter()
122  if (!is.null(reporter)) {
123    # Need to very carefully isolate this change to this function - can not set
124    # in expectation functions because part of expectation handling bubbles
125    # up through calling handlers, which are run before on.exit()
126    reporter$local_user_output()
127  }
128
129  waldo::compare(x, y,..., x_arg = x_arg, y_arg = y_arg)
130}
131
132local_width <- function(width = 80, .env = parent.frame()) {
133  withr::local_options(width = width, cli.width = width, .local_envir = .env)
134  withr::local_envvar(RSTUDIO_CONSOLE_WIDTH = width, .local_envir = .env)
135}
136
137
138#' Locally set test directory options
139#'
140#' For expert use only.
141#'
142#' @param path Path to directory of files
143#' @param package Optional package name, if known.
144#' @export
145#' @keywords internal
146local_test_directory <- function(path, package = NULL, .env = parent.frame()) {
147  # Set edition before changing working directory in case path is relative
148  local_edition(find_edition(path, package), .env = .env)
149
150  rlang_dep <- find_dep_version("rlang", path, package)
151
152  withr::local_options(
153    "testthat:::rlang_dep" = rlang_dep,
154    .local_envir = .env
155  )
156  withr::local_dir(
157    path,
158    .local_envir = .env
159  )
160  withr::local_envvar(
161    R_TESTS = "",
162    TESTTHAT = "true",
163    TESTTHAT_PKG = package,
164    .local_envir = .env
165  )
166}
167
168local_interactive_reporter <- function(.env = parent.frame()) {
169  # Definitely not on CRAN
170  withr::local_envvar(NOT_CRAN = "true", .local_envir = .env)
171  withr::local_options(testthat_interactive = TRUE, .local_envir = .env)
172
173  # Use edition from working directory
174  local_edition(find_edition("."), .env = .env)
175
176  # Use StopReporter
177  reporter <- StopReporter$new()
178  old <- set_reporter(reporter)
179  withr::defer(reporter$stop_if_needed(), envir = .env)
180  withr::defer(set_reporter(old), envir = .env)
181
182  reporter
183}
184