More polishing

Author: hadley

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)
+}

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(

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(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")

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")