Set option when snapshotting (#1798)

Fixes #1796

Author: hadley

NAMESPACE

@@ -145,6 +145,7 @@ export(is_less_than)
 export(is_more_than)
 export(is_null)
 export(is_parallel)
+export(is_snapshotting)
 export(is_testing)
 export(is_true)
 export(it)

NEWS.md

@@ -1,5 +1,11 @@
 # testthat (development version)
 
+* Experimental `is_snapshotting()` to determine if code is running inside a 
+  snapshot test (#1796).
+
+* All packages, regardless of whether or not they use rlang, now
+  use the new snapshot display for errors, warnings, and messages.
+
 * `skip_on_cran()` no longer skips (errors) when run interactively.
 
 * `testthat::teardown_env()` works in more cases.

R/snapshot.R

@@ -84,7 +84,9 @@ expect_snapshot <- function(x,
       cnd_class = cnd_class
     )
   }
-  out <- verify_exec(quo_get_expr(x), quo_get_env(x), replay)
+  with_is_snapshotting(
+    out <- verify_exec(quo_get_expr(x), quo_get_env(x), replay)
+  )
 
   # Use expect_error() machinery to confirm that error is as expected
   msg <- compare_condition_3e("error", state$error, quo_label(x), error)
@@ -219,7 +221,9 @@ expect_snapshot_output <- function(x, cran = FALSE, variant = NULL) {
   variant <- check_variant(variant)
 
   lab <- quo_label(enquo(x))
-  val <- capture_output_lines(x, print = TRUE, width = NULL)
+  with_is_snapshotting(
+    val <- capture_output_lines(x, print = TRUE, width = NULL)
+  )
 
   expect_snapshot_helper(lab, val,
     cran = cran,
@@ -261,7 +265,9 @@ expect_snapshot_condition <- function(base_class, x, class, cran = FALSE, varian
   variant <- check_variant(variant)
 
   lab <- quo_label(enquo(x))
-  val <- capture_matching_condition(x, cnd_matcher(class))
+  with_is_snapshotting(
+    val <- capture_matching_condition(x, cnd_matcher(class))
+  )
   if (is.null(val)) {
     if (base_class == class) {
       fail(sprintf("%s did not generate %s", lab, base_class))
@@ -326,6 +332,7 @@ expect_snapshot_value <- function(x,
     serialize = function(x) unserialize(jsonlite::base64_dec(x))
   )
 
+  with_is_snapshotting(force(x))
   expect_snapshot_helper(lab, x,
     save = save,
     load = load,
@@ -458,3 +465,20 @@ check_variant <- function(x) {
     abort("If supplied, `variant` must be a string")
   }
 }
+
+with_is_snapshotting <- function(code) {
+  withr::local_options(testthat_is_snapshotting = TRUE)
+  code
+}
+
+#' Is the code currently run within a snapshot test?
+#'
+#' This is often useful to compute a default argument for `quiet`. You
+#' often want to deliberatey suppress output for tests but still track
+#' it when snapshotting: `quiet = is_testing() && !is_snapshotting() `
+#'
+#' @export
+#' @keywords internal
+is_snapshotting <- function() {
+  getOption("testthat_is_snapshotting", FALSE)
+}

man/is_snapshotting.Rd

@@ -267,3 +267,26 @@
       * Run ]8;;ide:run:testthat::snapshot_accept('foo/bar.R')testthat::snapshot_accept('foo/bar.R')]8;; to accept the change.
       * Run ]8;;ide:run:testthat::snapshot_review('foo/bar.R')testthat::snapshot_review('foo/bar.R')]8;; to interactively review the change.
 
+# is_snapshotting is true in snapshots
+
+    Code
+      is_snapshotting()
+    Output
+      [1] TRUE
+
+---
+
+    true
+
+---
+
+    [1] TRUE
+
+---
+
+    Is snapshotting!
+
+---
+
+    Is snapshotting!
+

tests/testthat/_snaps/snapshot.md

@@ -201,3 +201,13 @@ test_that("hint is informative", {
     cat(snapshot_accept_hint("foo", "bar.R", reset_output = FALSE))
   })
 })
+
+test_that("is_snapshotting is true in snapshots", {
+  expect_false(is_snapshotting())
+
+  expect_snapshot(is_snapshotting())
+  expect_snapshot_value(is_snapshotting())
+  expect_snapshot_output(is_snapshotting())
+  expect_snapshot_warning(if (is_snapshotting()) warning("Is snapshotting!"))
+  expect_snapshot_error(if (is_snapshotting()) stop("Is snapshotting!"))
+})