Skip snapshot on CRAN at end of test

This ensures that the snapshots are not deleted. This also made me realise I missed the analgous update in `expect_snapshot_file()` and it's also clear that it should announce the file so it doesn't get deleted.

With these changes in place I can now run all the tests and ensure they pass on CRAN. This fixes #2214

Author: hadley

R/snapshot-file.R

@@ -99,8 +99,11 @@ expect_snapshot_file <- function(
   check_bool(cran)
 
   edition_require(3, "expect_snapshot_file()")
+
+  announce_snapshot_file(name = name)
   if (!cran && on_cran()) {
-    skip("On CRAN")
+    signal(class = "snapshot_on_cran")
+    return(invisible())
   }
 
   check_variant(variant)

R/snapshot.R

@@ -313,6 +313,7 @@ expect_snapshot_helper <- function(
   trace_env = caller_env()
 ) {
   if (!cran && on_cran()) {
+    signal(class = "snapshot_on_cran")
     return(invisible())
   }
 

R/test-that.R

@@ -65,6 +65,7 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) {
   starting_expectations <- the$test_expectations
 
   ok <- TRUE
+  snapshot_skipped <- FALSE
 
   # @param debug_end How many frames should be skipped to find the
   #   last relevant frame call. Only useful for the DebugReporter.
@@ -164,7 +165,9 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) {
         {
           eval(code, test_env)
           new_expectations <- the$test_expectations > starting_expectations
-          if (!new_expectations && skip_on_empty) {
+          if (snapshot_skipped) {
+            skip("On CRAN")
+          } else if (!new_expectations && skip_on_empty) {
             skip_empty()
           }
         },
@@ -174,6 +177,9 @@ test_code <- function(code, env, reporter = NULL, skip_on_empty = TRUE) {
             skip(paste0("{", e$package, "} is not installed."))
           }
         },
+        snapshot_on_cran = function(cnd) {
+          snapshot_skipped <<- TRUE
+        },
         skip = handle_skip,
         warning = handle_warning,
         message = handle_message,

tests/testthat/test-parallel.R

@@ -62,7 +62,9 @@ test_that("fail", {
 
 test_that("snapshots", {
   skip_on_covr()
+  skip_on_cran()
   withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE"))
+
   tmp <- withr::local_tempdir("testthat-snap-")
   file.copy(test_path("test-parallel", "snap"), tmp, recursive = TRUE)
   # we cannot run these with the silent reporter, because it is not
@@ -85,7 +87,9 @@ test_that("snapshots", {
 
 test_that("new snapshots are added", {
   skip_on_covr()
+  skip_on_cran()
   withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE", CI = "false"))
+
   tmp <- withr::local_tempdir("testthat-snap-")
   file.copy(test_path("test-parallel", "snap"), tmp, recursive = TRUE)
   unlink(file.path(tmp, "snap", "tests", "testthat", "_snaps", "snap-2.md"))
@@ -110,7 +114,9 @@ test_that("new snapshots are added", {
 
 test_that("snapshots are removed if test file has no snapshots", {
   skip_on_covr()
+  skip_on_cran()
   withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE"))
+
   tmp <- withr::local_tempdir("testthat-snap-")
   file.copy(test_path("test-parallel", "snap"), tmp, recursive = TRUE)
   writeLines(
@@ -138,6 +144,8 @@ test_that("snapshots are removed if test file has no snapshots", {
 
 test_that("snapshots are removed if test file is removed", {
   skip_on_covr()
+  skip_on_cran()
+
   withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE"))
   withr::defer(unlink(tmp, recursive = TRUE))
   dir.create(tmp <- tempfile("testthat-snap-"))

tests/testthat/test-snapshot-file.R

@@ -30,6 +30,8 @@ test_that("expect_snapshot_file works in a different directory", {
 })
 
 test_that("expect_snapshot_file works with variant", {
+  local_on_cran(FALSE)
+
   expect_snapshot_file(
     write_tmp_lines(r_version()),
     "version.txt",
@@ -39,6 +41,8 @@ test_that("expect_snapshot_file works with variant", {
 })
 
 test_that("expect_snapshot_file finds duplicate snapshot files", {
+  local_on_cran(FALSE)
+
   expect_snapshot(
     expect_snapshot_file(
       write_tmp_lines(r_version()),
@@ -50,6 +54,7 @@ test_that("expect_snapshot_file finds duplicate snapshot files", {
 })
 
 test_that("basic workflow", {
+  local_on_cran(FALSE)
   snapper <- local_test_snapshotter()
 
   path <- write_tmp_lines(letters)

tests/testthat/test-snapshot-reporter.R

@@ -8,6 +8,8 @@ test_that("can establish local snapshotter for testing", {
 })
 
 test_that("basic workflow", {
+  local_on_cran(FALSE)
+
   path <- withr::local_tempdir()
   snapper <- local_test_snapshotter(snap_dir = path)
   snapper$start_file("snapshot-2")
@@ -39,6 +41,7 @@ test_that("basic workflow", {
 })
 
 test_that("defaults to failing on CI", {
+  local_on_cran(FALSE)
   withr::local_envvar(CI = "true")
 
   path <- withr::local_tempdir()
@@ -50,6 +53,8 @@ test_that("defaults to failing on CI", {
 })
 
 test_that("only create new files for changed variants", {
+  local_on_cran(FALSE)
+
   snapper <- local_test_snapshotter()
   snapper$start_file("variants", "test")
   expect_warning(expect_snapshot_output("x"), "Adding new")
@@ -86,6 +91,8 @@ test_that("only create new files for changed variants", {
 })
 
 test_that("only reverting change in variant deletes .new", {
+  local_on_cran(FALSE)
+
   snapper <- local_test_snapshotter()
   snapper$start_file("v", "test")
   expect_warning(expect_snapshot_output("x", variant = "a"), "Adding new")
@@ -108,6 +115,8 @@ test_that("only reverting change in variant deletes .new", {
 
 
 test_that("removing tests removes snap file", {
+  local_on_cran(FALSE)
+
   path <- withr::local_tempdir()
   snapper <- local_test_snapshotter(snap_dir = path)
   snapper$start_file("snapshot-3", "test")
@@ -121,6 +130,7 @@ test_that("removing tests removes snap file", {
 })
 
 test_that("errors in test doesn't change snapshot", {
+  local_on_cran(FALSE)
   snapper <- local_test_snapshotter()
 
   # First run

tests/testthat/test-snapshot.R

@@ -176,6 +176,7 @@ test_that("hint is informative", {
 
 test_that("expect_snapshot requires a non-empty test label", {
   local_description_set()
+  local_on_cran(FALSE)
 
   test_that("", {
     expect_error(expect_snapshot(1 + 1))
@@ -212,13 +213,14 @@ test_that("expect_snapshot_warning validates its inputs", {
   })
 })
 
-test_that("on CRAN, snapshots are not run but don't skill entire test", {
+test_that("on CRAN, snapshots generate skip at end of test", {
   local_on_cran(TRUE)
 
   expectations <- capture_expectations(test_that("", {
     expect_snapshot(1 + 1)
     expect_true(TRUE)
   }))
-  expect_length(expectations, 1)
+  expect_length(expectations, 2)
   expect_s3_class(expectations[[1]], "expectation_success")
+  expect_s3_class(expectations[[2]], "expectation_skip")
 })