From 5139f3f59608505d7b17efd509631bc212da509f Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 28 Jun 2024 15:45:09 -0500 Subject: [PATCH 1/6] Implement local_reproducible_output() Part of #129 --- NAMESPACE | 1 + R/reproducible-output.R | 100 ++++++++++++++++++++++ man/local_reproducible_output.Rd | 36 ++++++++ tests/testthat/test-reproducible-output.R | 48 +++++++++++ 4 files changed, 185 insertions(+) create mode 100644 R/reproducible-output.R create mode 100644 man/local_reproducible_output.Rd create mode 100644 tests/testthat/test-reproducible-output.R diff --git a/NAMESPACE b/NAMESPACE index 474db89..92609ac 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -20,6 +20,7 @@ export(is.message) export(is.recordedplot) export(is.source) export(is.warning) +export(local_reproducible_output) export(new_output_handler) export(parse_all) export(remove_hooks) diff --git a/R/reproducible-output.R b/R/reproducible-output.R new file mode 100644 index 0000000..017668a --- /dev/null +++ b/R/reproducible-output.R @@ -0,0 +1,100 @@ +#' Control common output options +#' +#' @description +#' Often when using `evaluate()` you are running R code with a specific output +#' context in mind. But there are many options and env vars that packages +#' will take from the current environment, meaning that output depends on +#' the current state in undesirable ways. +#' +#' This function allows you to describe the characteristics of the desired +#' output and takes care of setting the options and environment variables +#' for you. +#' +#' @export +#' @param width Value of the `"width"` option. +#' @param color Determines whether or not cli/crayon colour should be used. +#' @param unicode Should we use unicode characaters where possible? +#' @param hyperlinks Should we use ANSI hyperlinks? +#' @param rstudio Should we pretend that we're running inside of RStudio? +local_reproducible_output <- function(width = 80, + color = FALSE, + unicode = FALSE, + hyperlinks = FALSE, + rstudio = FALSE, + frame = parent.frame()) { + + local_options( + # crayon + crayon.enabled = color, + + # cli + cli.width = width, + cli.num_colors = if (color) 8L else 1L, + cli.hyperlink = hyperlinks, + cli.hyperlink_run = hyperlinks, + cli.hyperlink_help = hyperlinks, + cli.hyperlink_vignette = hyperlinks, + cli.unicode = unicode, + cli.dynamic = FALSE, + + # base R + width = width, + useFancyQuotes = FALSE, + rlang_interactive = FALSE, + + .frame = frame + ) + + local_envvar( + NO_COLOR = if (color) NA else 1, + + # Simulate RStudio + 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, + RSTUDIO_CONSOLE_WIDTH = width, + .frame = frame + ) + + local_collate("C", frame = frame) + + invisible() +} + +local_options <- function(..., .frame = parent.frame()) { + old <- options(...) + defer(options(old), .frame) + + invisible() +} + +local_envvar <- function(..., .frame = parent.frame()) { + old <- set_envvar(list(...)) + defer(set_envvar(old), .frame) + + invisible() +} + +local_collate <- function(locale, frame = parent.frame()) { + old <- Sys.getlocale("LC_COLLATE") + defer(Sys.setlocale("LC_COLLATE", old), frame) + Sys.setlocale("LC_COLLATE", locale) + + invisible() +} + +# adapted from withr:::set_envvar +set_envvar <- function(envs) { + if (length(envs) == 0) { + return() + } + + old <- Sys.getenv(names(envs), names = TRUE, unset = NA) + set <- !is.na(envs) + + if (any(set)) do.call("Sys.setenv", as.list(envs[set])) + if (any(!set)) Sys.unsetenv(names(envs)[!set]) + + invisible(old) +} diff --git a/man/local_reproducible_output.Rd b/man/local_reproducible_output.Rd new file mode 100644 index 0000000..20cd738 --- /dev/null +++ b/man/local_reproducible_output.Rd @@ -0,0 +1,36 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/reproducible-output.R +\name{local_reproducible_output} +\alias{local_reproducible_output} +\title{Control common output options} +\usage{ +local_reproducible_output( + width = 80, + color = FALSE, + unicode = FALSE, + hyperlinks = FALSE, + rstudio = FALSE, + frame = parent.frame() +) +} +\arguments{ +\item{width}{Value of the \code{"width"} option.} + +\item{color}{Determines whether or not cli/crayon colour should be used.} + +\item{unicode}{Should we use unicode characaters where possible?} + +\item{hyperlinks}{Should we use ANSI hyperlinks?} + +\item{rstudio}{Should we pretend that we're running inside of RStudio?} +} +\description{ +Often when using \code{evaluate()} you are running R code with a specific output +context in mind. But there are many options and env vars that packages +will take from the current environment, meaning that output depends on +the current state in undesirable ways. + +This function allows you to describe the characteristics of the desired +output and takes care of setting the options and environment variables +for you. +} diff --git a/tests/testthat/test-reproducible-output.R b/tests/testthat/test-reproducible-output.R new file mode 100644 index 0000000..f7f20ff --- /dev/null +++ b/tests/testthat/test-reproducible-output.R @@ -0,0 +1,48 @@ +test_that("local_reproducible_output() respects local context", { + + local_reproducible_output(width = 105) + expect_equal(getOption("width"), 105) + + local({ + local_reproducible_output(width = 110) + expect_equal(getOption("width"), 110) + }) + + expect_equal(getOption("width"), 105) +}) + +test_that("local_envvar respects local context", { + local_envvar(test = "a") + expect_equal(Sys.getenv("test"), "a") + + local({ + local_envvar(test = "b") + expect_equal(Sys.getenv("test"), "b") + }) + + expect_equal(Sys.getenv("test"), "a") + local({ + local_envvar(test = NA) + expect_equal(Sys.getenv("test"), "") + }) + + expect_equal(Sys.getenv("test"), "a") +}) + +test_that("local_collate respects local context", { + if (Sys.info()[["sysname"]] == "Windows") { + locale <- l10n_info()$codeset + } else { + locale <- "en_US" + } + + local_collate("C") + expect_equal(Sys.getlocale("LC_COLLATE"), "C") + + local({ + local_collate(locale) + expect_equal(Sys.getlocale("LC_COLLATE"), locale) + }) + + expect_equal(Sys.getlocale("LC_COLLATE"), "C") +}) From a9017fb5fe42d63da9d3615c9bc0d60e28cb6876 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 28 Jun 2024 15:47:56 -0500 Subject: [PATCH 2/6] Fix docs; add cli.condition_width --- R/reproducible-output.R | 5 ++++- man/local_reproducible_output.Rd | 3 +++ man/parse_all.Rd | 4 +++- 3 files changed, 10 insertions(+), 2 deletions(-) diff --git a/R/reproducible-output.R b/R/reproducible-output.R index 017668a..00c0665 100644 --- a/R/reproducible-output.R +++ b/R/reproducible-output.R @@ -16,6 +16,8 @@ #' @param unicode Should we use unicode characaters where possible? #' @param hyperlinks Should we use ANSI hyperlinks? #' @param rstudio Should we pretend that we're running inside of RStudio? +#' @param frame Scope of the changes; when this calling frame terminates the +#' changes will be undone. For expert use only. local_reproducible_output <- function(width = 80, color = FALSE, unicode = FALSE, @@ -29,7 +31,8 @@ local_reproducible_output <- function(width = 80, # cli cli.width = width, - cli.num_colors = if (color) 8L else 1L, + cli.condition_width = width, + cli.num_colors = if (color) 8L else 1L, cli.hyperlink = hyperlinks, cli.hyperlink_run = hyperlinks, cli.hyperlink_help = hyperlinks, diff --git a/man/local_reproducible_output.Rd b/man/local_reproducible_output.Rd index 20cd738..3b5dfa5 100644 --- a/man/local_reproducible_output.Rd +++ b/man/local_reproducible_output.Rd @@ -23,6 +23,9 @@ local_reproducible_output( \item{hyperlinks}{Should we use ANSI hyperlinks?} \item{rstudio}{Should we pretend that we're running inside of RStudio?} + +\item{frame}{Scope of the changes; when this calling frame terminates the +changes will be undone. For expert use only.} } \description{ Often when using \code{evaluate()} you are running R code with a specific output diff --git a/man/parse_all.Rd b/man/parse_all.Rd index 26eee69..44c3dc4 100644 --- a/man/parse_all.Rd +++ b/man/parse_all.Rd @@ -17,7 +17,9 @@ If a connection, will be opened and closed only if it was closed initially.} \value{ A data frame with columns \code{src}, a character vector of source code, and \code{expr}, a list-column of parsed expressions. There will be one row for each -top-level expression in \code{x}. A top-level expression is a complete expression +top-level expression in \code{x}. + +A top-level expression is a complete expression which would trigger execution if typed at the console. The \code{expression} object in \code{expr} can be of any length: it will be 0 if the top-level expression contains only whitespace and/or comments; 1 if the top-level From 78edf5432536877ea80ea65bf6d26f70a0d7643f Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 1 Jul 2024 09:32:25 -0500 Subject: [PATCH 3/6] unicode should affect fancy quotes --- R/reproducible-output.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/reproducible-output.R b/R/reproducible-output.R index 00c0665..9b4e9ac 100644 --- a/R/reproducible-output.R +++ b/R/reproducible-output.R @@ -42,7 +42,9 @@ local_reproducible_output <- function(width = 80, # base R width = width, - useFancyQuotes = FALSE, + useFancyQuotes = unicode, + + # rlang rlang_interactive = FALSE, .frame = frame From 25a9d6e6814264c142e20c15aa02da4b2a25b79c Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 1 Jul 2024 09:34:48 -0500 Subject: [PATCH 4/6] Port withr fix --- R/reproducible-output.R | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/R/reproducible-output.R b/R/reproducible-output.R index 9b4e9ac..d6757af 100644 --- a/R/reproducible-output.R +++ b/R/reproducible-output.R @@ -86,6 +86,13 @@ local_collate <- function(locale, frame = parent.frame()) { defer(Sys.setlocale("LC_COLLATE", old), frame) Sys.setlocale("LC_COLLATE", locale) + # From https://github.com/r-lib/withr/blob/v3.0.0/R/locale.R#L51-L55: + # R supports setting LC_COLLATE to C via envvar. When that is the + # case, it takes precedence over the currently set locale. We need + # to set both the envvar and the locale for collate to fully take + # effect. + local_envvar(LC_COLLATE = locale, .frame = frame) + invisible() } From e40da2051c6cdb82db84c31c3b9512915f3cfe38 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 1 Jul 2024 09:43:44 -0500 Subject: [PATCH 5/6] Add news bullet --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 469655f..22dc510 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # evaluate (development version) +* New `local_reproducible_output()` helper that sets various options and env vars to help ensure consistency of output across environments. * The `source` output handler is now passed the entire top-level expression, not just the first component. * `evaluate()` will now terminate on the first error in a top-level expression. This matches R's own behaviour more closely. * `is.value()` has been removed since it tests for an object that evaluate never creates. From 28757ad89644124be5a7d357d6732c36f5472900 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 1 Jul 2024 09:43:48 -0500 Subject: [PATCH 6/6] Try another locale --- tests/testthat/test-reproducible-output.R | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) diff --git a/tests/testthat/test-reproducible-output.R b/tests/testthat/test-reproducible-output.R index f7f20ff..4851b10 100644 --- a/tests/testthat/test-reproducible-output.R +++ b/tests/testthat/test-reproducible-output.R @@ -30,11 +30,12 @@ test_that("local_envvar respects local context", { }) test_that("local_collate respects local context", { - if (Sys.info()[["sysname"]] == "Windows") { - locale <- l10n_info()$codeset - } else { - locale <- "en_US" - } + locale <- switch(Sys.info()[["sysname"]], + Darwin = "en_US", + Linux = "en_US.UTF-8", + NULL + ) + skip_if(is.null(locale), "Don't know good locale to use for this platform") local_collate("C") expect_equal(Sys.getlocale("LC_COLLATE"), "C")