From 22701366ebf9b51ac4e0d89789f3880df3e5dcbd Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Sat, 9 Aug 2025 09:50:58 -0400 Subject: [PATCH 1/2] 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 --- R/parallel.R | 19 +-------------- R/snapshot-file-snaps.R | 5 ---- R/snapshot-reporter.R | 9 +++---- R/test-files.R | 31 +++++++++++++++++++------ man/local_snapshotter.Rd | 2 +- tests/testthat/test-snapshot-reporter.R | 4 ++-- 6 files changed, 31 insertions(+), 39 deletions(-) diff --git a/R/parallel.R b/R/parallel.R index cd07b4e10..b93babd63 100644 --- a/R/parallel.R +++ b/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 diff --git a/R/snapshot-file-snaps.R b/R/snapshot-file-snaps.R index d7ac27465..88445db05 100644 --- a/R/snapshot-file-snaps.R +++ b/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]]) }, diff --git a/R/snapshot-reporter.R b/R/snapshot-reporter.R index c226518ff..17ce43aa1 100644 --- a/R/snapshot-reporter.R +++ b/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, diff --git a/R/test-files.R b/R/test-files.R index eb67f6fce..e193718c4 100644 --- a/R/test-files.R +++ b/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 ) } diff --git a/man/local_snapshotter.Rd b/man/local_snapshotter.Rd index 642c42869..e632ec60b 100644 --- a/man/local_snapshotter.Rd +++ b/man/local_snapshotter.Rd @@ -5,8 +5,8 @@ \title{Instantiate local snapshotting context} \usage{ local_snapshotter( + reporter = SnapshotReporter, snap_dir = NULL, - cleanup = FALSE, fail_on_new = FALSE, .env = parent.frame() ) diff --git a/tests/testthat/test-snapshot-reporter.R b/tests/testthat/test-snapshot-reporter.R index 7f23f3118..8e8c76b4e 100644 --- a/tests/testthat/test-snapshot-reporter.R +++ b/tests/testthat/test-snapshot-reporter.R @@ -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() From a95d2d7d2fbac43eefa3a43b0b5ff9e6fa1f0a3b Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 13 Aug 2025 07:45:58 -0500 Subject: [PATCH 2/2] More polishing --- R/snapshot-reporter.R | 20 +++++++++----------- R/test-files.R | 20 +++++++++----------- man/local_snapshotter.Rd | 4 ++-- tests/testthat/test-snapshot-file.R | 4 ++-- tests/testthat/test-snapshot-reporter.R | 12 ++++++------ tests/testthat/test-snapshot-value.R | 2 +- 6 files changed, 29 insertions(+), 33 deletions(-) diff --git a/R/snapshot-reporter.R b/R/snapshot-reporter.R index 0cc0dfc59..9b28029e0 100644 --- a/R/snapshot-reporter.R +++ b/R/snapshot-reporter.R @@ -205,20 +205,18 @@ get_snapshotter <- function() { #' @keywords internal local_snapshotter <- function( reporter = SnapshotReporter, - snap_dir = NULL, + 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 <- reporter$new( - snap_dir = snap_dir, - fail_on_new = fail_on_new - ) + 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) +} diff --git a/R/test-files.R b/R/test-files.R index 36fd7b64c..a7a1e9391 100644 --- a/R/test-files.R +++ b/R/test-files.R @@ -318,25 +318,23 @@ test_files_setup_state <- function( test_files_reporter <- function( reporter, mode = c("serial", "parallel"), - .env = parent.frame() + frame = caller_env() ) { + mode <- arg_match(mode) + # User selected reporter user <- find_reporter(reporter) - # Track all + # Reporter that collect test results lister <- ListReporter$new() - snap_base <- if (mode == "parallel") { - MainprocessSnapshotReporter + # Snapshot reporter + if (mode == "parallel") { + snap_base <- MainprocessSnapshotReporter } else { - SnapshotReporter + snap_base <- SnapshotReporter } - snap <- local_snapshotter( - snap_base, - snap_dir = "_snaps", - fail_on_new = on_ci(), - .env = .env - ) + snap <- local_snapshotter(snap_base, fail_on_new = on_ci(), frame = frame) reporters <- compact(list(user, lister, snap)) list( diff --git a/man/local_snapshotter.Rd b/man/local_snapshotter.Rd index 39d022f61..a5c193eb3 100644 --- a/man/local_snapshotter.Rd +++ b/man/local_snapshotter.Rd @@ -6,10 +6,10 @@ \usage{ local_snapshotter( reporter = SnapshotReporter, - snap_dir = NULL, + snap_dir = "_snaps", cleanup = FALSE, fail_on_new = NULL, - .env = parent.frame() + frame = caller_env() ) } \description{ diff --git a/tests/testthat/test-snapshot-file.R b/tests/testthat/test-snapshot-file.R index 293b010bc..be4599c37 100644 --- a/tests/testthat/test-snapshot-file.R +++ b/tests/testthat/test-snapshot-file.R @@ -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") diff --git a/tests/testthat/test-snapshot-reporter.R b/tests/testthat/test-snapshot-reporter.R index 4a03a7cdf..65760b618 100644 --- a/tests/testthat/test-snapshot-reporter.R +++ b/tests/testthat/test-snapshot-reporter.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(snap_dir = 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") |> @@ -50,7 +50,7 @@ test_that("defaults to failing on CI", { }) 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(snap_dir = 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") diff --git a/tests/testthat/test-snapshot-value.R b/tests/testthat/test-snapshot-value.R index 010b0153c..3b1f4d6b2 100644 --- a/tests/testthat/test-snapshot-value.R +++ b/tests/testthat/test-snapshot-value.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")