#' 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 = "en",
.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
)
if (isTRUE(capabilities("NLS")) && Sys.getenv("LANG") != "C") {
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
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.