Snapshot refactoring

* Generalise `test_file_reporter()` so we no longer need `test_files_reporter_parallel()`
* 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

@@ -63,7 +63,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) {
@@ -81,23 +81,6 @@ test_files_parallel <- function(
   })
 }
 
-test_files_reporter_parallel <- function(reporter, .env = parent.frame()) {
-  lister <- ListReporter$new()
-  snapshotter <- MainprocessSnapshotReporter$new("_snaps", fail_on_new = FALSE)
-  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

@@ -130,7 +130,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)
       }
@@ -194,19 +194,16 @@ get_snapshotter <- function() {
 #' @export
 #' @keywords internal
 local_snapshotter <- function(
+  reporter = SnapshotReporter,
   snap_dir = NULL,
-  cleanup = FALSE,
   fail_on_new = FALSE,
   .env = parent.frame()
 ) {
   snap_dir <- snap_dir %||% withr::local_tempdir(.local_envir = .env)
-  reporter <- SnapshotReporter$new(
+  reporter <- reporter$new(
     snap_dir = snap_dir,
     fail_on_new = fail_on_new
   )
-  if (!identical(cleanup, FALSE)) {
-    cli::cli_warn("{.arg cleanup} is deprecated.")
-  }
 
   withr::local_options(
     "testthat.snapshotter" = reporter,

R/test-files.R

@@ -213,7 +213,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,
@@ -306,15 +306,32 @@ 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"),
+  .env = parent.frame()
+) {
+  # User selected reporter
+  user <- find_reporter(reporter)
+
+  # Track all
   lister <- ListReporter$new()
-  reporters <- list(
-    find_reporter(reporter),
-    lister, # track data
-    local_snapshotter("_snaps", fail_on_new = on_ci(), .env = .env)
+
+  snap_base <- if (mode == "parallel") {
+    MainprocessSnapshotReporter
+  } else {
+    SnapshotReporter
+  }
+  snap <- local_snapshotter(
+    snap_base,
+    snap_dir = "_snaps",
+    fail_on_new = on_ci(),
+    .env = .env
   )
+
+  reporters <- compact(list(user, lister, snap))
   list(
-    multi = MultiReporter$new(reporters = compact(reporters)),
+    multi = MultiReporter$new(reporters = reporters),
     list = lister
   )
 }

man/local_snapshotter.Rd

@@ -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_snapshotter(snap_dir = path, fail_on_new = FALSE)
   snapper$start_file("snapshot-2")
   # output if not active (because test not set here)
   expect_snapshot_output("x") |>
@@ -98,7 +98,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_snapshotter(snap_dir = path, fail_on_new = FALSE)
   snapper$start_file("snapshot-3", "test")
   expect_warning(expect_snapshot_output("x"), "Adding new")
   snapper$end_file()