Snapshot refactoring (#2199)

* Generalise `test_file_reporter()` so we no longer need `test_files_reporter_parallel()`
* Add new `local_test_snapshotter()`
* Remove code needed for old R
* Drop deprecated argument

`local_snapshotter()` is [only used in devtools](https://github.com/search?q=org%3Acran+local_snapshotter+&type=code).

In preparation for #2066

Author: hadley

R/parallel.R

@@ -65,7 +65,7 @@ test_files_parallel <- function(
   )
 
   withr::with_dir(test_dir, {
-    reporters <- test_files_reporter_parallel(reporter)
+    reporters <- test_files_reporter(reporter, "parallel")
     with_reporter(reporters$multi, {
       parallel_updates <- reporter$capabilities$parallel_updates
       if (parallel_updates) {
@@ -83,23 +83,6 @@ test_files_parallel <- function(
   })
 }
 
-test_files_reporter_parallel <- function(reporter, .env = parent.frame()) {
-  lister <- ListReporter$new()
-  snapshotter <- MainprocessSnapshotReporter$new("_snaps")
-  reporters <- list(
-    find_reporter(reporter),
-    lister, # track data
-    snapshotter
-  )
-  withr::local_options(
-    "testthat.snapshotter" = snapshotter,
-    .local_envir = .env
-  )
-  list(
-    multi = MultiReporter$new(reporters = compact(reporters)),
-    list = lister
-  )
-}
 
 default_num_cpus <- function() {
   # Use common option, if set

R/snapshot-file-snaps.R

@@ -39,11 +39,6 @@ FileSnaps <- R6::R6Class(
     },
 
     append = function(test, variant, data) {
-      if (!has_name(self$snaps, variant)) {
-        # Needed for R < 3.6
-        self$snaps[[variant]] <- list()
-      }
-
       self$snaps[[variant]][[test]] <- c(self$snaps[[variant]][[test]], data)
       length(self$snaps[[variant]][[test]])
     },

R/snapshot-reporter.R

@@ -140,7 +140,7 @@ SnapshotReporter <- R6::R6Class(
         return()
       }
 
-      # If expectation errors or skips, need to reset remaining snapshots
+      # If expectation errors or skips, need to copy snapshots from old to cur
       if (expectation_error(result) || expectation_skip(result)) {
         self$cur_snaps$reset(self$test, self$old_snaps)
       }
@@ -204,23 +204,19 @@ get_snapshotter <- function() {
 #' @export
 #' @keywords internal
 local_snapshotter <- function(
-  snap_dir = NULL,
+  reporter = SnapshotReporter,
+  snap_dir = "_snaps",
   cleanup = FALSE,
   fail_on_new = NULL,
-  .env = parent.frame()
+  frame = caller_env()
 ) {
-  snap_dir <- snap_dir %||% withr::local_tempdir(.local_envir = .env)
-  reporter <- SnapshotReporter$new(
-    snap_dir = snap_dir,
-    fail_on_new = fail_on_new
-  )
-  if (!identical(cleanup, FALSE)) {
-    cli::cli_warn("{.arg cleanup} is deprecated.")
-  }
+  reporter <- reporter$new(snap_dir = snap_dir, fail_on_new = fail_on_new)
+  withr::local_options("testthat.snapshotter" = reporter, .local_envir = frame)
 
-  withr::local_options(
-    "testthat.snapshotter" = reporter,
-    .local_envir = .env
-  )
   reporter
 }
+
+local_test_snapshotter <- function(snap_dir = NULL, frame = caller_env()) {
+  snap_dir <- snap_dir %||% withr::local_tempdir(.local_envir = frame)
+  local_snapshotter(snap_dir = snap_dir, fail_on_new = FALSE, frame = frame)
+}

R/test-files.R

@@ -221,7 +221,7 @@ test_files_serial <- function(
   local_testing_env(env)
 
   test_files_setup_state(test_dir, test_package, load_helpers, env)
-  reporters <- test_files_reporter(reporter)
+  reporters <- test_files_reporter(reporter, "serial")
 
   with_reporter(
     reporters$multi,
@@ -315,15 +315,30 @@ test_files_setup_state <- function(
   withr::defer(source_test_teardown(".", env), frame) # old school
 }
 
-test_files_reporter <- function(reporter, .env = parent.frame()) {
+test_files_reporter <- function(
+  reporter,
+  mode = c("serial", "parallel"),
+  frame = caller_env()
+) {
+  mode <- arg_match(mode)
+
+  # User selected reporter
+  user <- find_reporter(reporter)
+
+  # Reporter that collect test results
   lister <- ListReporter$new()
-  reporters <- list(
-    find_reporter(reporter),
-    lister, # track data
-    local_snapshotter("_snaps", .env = .env)
-  )
+
+  # Snapshot reporter
+  if (mode == "parallel") {
+    snap_base <- MainprocessSnapshotReporter
+  } else {
+    snap_base <- SnapshotReporter
+  }
+  snap <- local_snapshotter(snap_base, fail_on_new = on_ci(), frame = frame)
+
+  reporters <- compact(list(user, lister, snap))
   list(
-    multi = MultiReporter$new(reporters = compact(reporters)),
+    multi = MultiReporter$new(reporters = reporters),
     list = lister
   )
 }

man/local_snapshotter.Rd

@@ -50,7 +50,7 @@ test_that("expect_snapshot_file finds duplicate snapshot files", {
 })
 
 test_that("basic workflow", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
 
   path <- write_tmp_lines(letters)
   # warns on first run
@@ -71,7 +71,7 @@ test_that("basic workflow", {
 })
 
 test_that("can announce snapshot file", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
   snapper$start_file("snapshot-announce", "test")
   announce_snapshot_file(name = "bar.svg")
   expect_equal(snapper$snap_file_seen, "snapshot-announce/bar.svg")

tests/testthat/test-snapshot-file.R

@@ -1,5 +1,5 @@
 test_that("can establish local snapshotter for testing", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
 
   snapper$start_file("snapshot-1", "test")
   expect_true(snapper$is_active())
@@ -9,7 +9,7 @@ test_that("can establish local snapshotter for testing", {
 
 test_that("basic workflow", {
   path <- withr::local_tempdir()
-  snapper <- local_snapshotter(path, fail_on_new = FALSE)
+  snapper <- local_test_snapshotter(snap_dir = path)
   snapper$start_file("snapshot-2")
   # output if not active (because test not set here)
   expect_snapshot_output("x") |>
@@ -42,15 +42,15 @@ test_that("defaults to failing on CI", {
   withr::local_envvar(CI = "true")
 
   path <- withr::local_tempdir()
-  snapper <- local_snapshotter(path)
+  snapper <- local_snapshotter(snap_dir = path)
   snapper$start_file("snapshot-2")
   # warns on first creation
   snapper$start_file("snapshot-2", "test")
   expect_error(expect_snapshot_output("x"), "Adding new")
 })
 
 test_that("only create new files for changed variants", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
   snapper$start_file("variants", "test")
   expect_warning(expect_snapshot_output("x"), "Adding new")
   expect_warning(expect_snapshot_output("x", variant = "a"), "Adding new")
@@ -86,7 +86,7 @@ test_that("only create new files for changed variants", {
 })
 
 test_that("only reverting change in variant deletes .new", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
   snapper$start_file("v", "test")
   expect_warning(expect_snapshot_output("x", variant = "a"), "Adding new")
   expect_warning(expect_snapshot_output("x", variant = "b"), "Adding new")
@@ -109,7 +109,7 @@ test_that("only reverting change in variant deletes .new", {
 
 test_that("removing tests removes snap file", {
   path <- withr::local_tempdir()
-  snapper <- local_snapshotter(path, fail_on_new = FALSE)
+  snapper <- local_test_snapshotter(snap_dir = path)
   snapper$start_file("snapshot-3", "test")
   expect_warning(expect_snapshot_output("x"), "Adding new")
   snapper$end_file()
@@ -121,7 +121,7 @@ test_that("removing tests removes snap file", {
 })
 
 test_that("errors in test doesn't change snapshot", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
 
   # First run
   snapper$start_file("snapshot-5", "test")

tests/testthat/test-snapshot-reporter.R

@@ -32,7 +32,7 @@ test_that("reparse handles common cases", {
 })
 
 test_that("errors if can't roundtrip", {
-  snapper <- local_snapshotter(fail_on_new = FALSE)
+  snapper <- local_test_snapshotter()
   snapper$start_file("snapshot-4", "test")
 
   expect_error(expect_snapshot_value(NULL), "safely serialized")