In R CMD check, only notify about snapshots once

Fixes #2207

Author: hadley

R/expect-that.R

@@ -18,6 +18,7 @@
 #'   informative traceack for failures. You should only need to set this if
 #'   you're calling `fail()` from a helper function; see
 #'   `vignette("custom-expectation")` for details.
+#' @param snapshot Is this a snapshot failure?
 #' @param trace An optional backtrace created by [rlang::trace_back()].
 #'   When supplied, the expectation is displayed with the backtrace.
 #'   Expert use only.
@@ -39,7 +40,8 @@ fail <- function(
   info = NULL,
   srcref = NULL,
   trace_env = caller_env(),
-  trace = NULL
+  trace = NULL,
+  snapshot = FALSE
 ) {
   if (is.null(trace)) {
     trace <- trace_back(top = getOption("testthat_topenv"), bottom = trace_env)
@@ -50,7 +52,13 @@ fail <- function(
   }
 
   message <- paste(c(message, info), collapse = "\n")
-  expectation("failure", message, srcref = srcref, trace = trace)
+  expectation(
+    "failure",
+    message,
+    srcref = srcref,
+    trace = trace,
+    snapshot = snapshot
+  )
 }
 
 #' @rdname fail

R/expectation.R

@@ -49,8 +49,20 @@ expect <- function(
 #' @keywords internal
 #' @inheritParams expect
 #' @export
-expectation <- function(type, message, srcref = NULL, trace = NULL) {
-  exp <- new_expectation(type, message, srcref = srcref, trace = trace)
+expectation <- function(
+  type,
+  message,
+  snapshot = FALSE,
+  srcref = NULL,
+  trace = NULL
+) {
+  exp <- new_expectation(
+    type,
+    message,
+    snapshot = snapshot,
+    srcref = srcref,
+    trace = trace
+  )
   exp_signal(exp)
 }
 #' @rdname expectation

R/reporter-check.R

@@ -13,6 +13,7 @@ CheckReporter <- R6::R6Class(
     skips = NULL,
     warnings = NULL,
     n_ok = 0L,
+    has_snapshot_failure = FALSE,
 
     initialize = function(...) {
       self$capabilities$parallel_support <- TRUE
@@ -64,6 +65,11 @@ CheckReporter <- R6::R6Class(
         self$rule("Failed tests", line = 2)
         self$cat_line(map_chr(problems, issue_summary, rule = TRUE))
         self$cat_line()
+
+        if (some(problems, \(x) isTRUE(attr(x, "snapshot")))) {
+          self$rule("To resolve snapshot failures", line = 1)
+          self$cat_line(snapshot_check_hint())
+        }
       } else {
         # clean up
         unlink("testthat-problems.rds")
@@ -105,3 +111,36 @@ summary_line <- function(n_fail, n_warn, n_skip, n_pass) {
     " ]"
   )
 }
+
+snapshot_check_hint <- function() {
+  if (on_gh()) {
+    repository <- Sys.getenv("GITHUB_REPOSITORY")
+    run_id <- Sys.getenv("GITHUB_RUN_ID")
+
+    call <- sprintf(
+      "testthat::snapshot_download_gh(\"%s\", \"%s\")",
+      repository,
+      run_id
+    )
+    copy <- sprintf("* Run `%s` to download snapshots.", call)
+  } else {
+    copy <- c(
+      if (on_ci()) {
+        "* Download and unzip artifact."
+      } else {
+        "* Locate check directory."
+      },
+      "* Copy 'tests/testthat/_snaps' to local package."
+    )
+  }
+
+  action <- c(
+    "* Run `testthat::snapshot_accept()` to accept all changes.",
+    "* Run `testthat::snapshot_review()` to review all changes."
+  )
+  c(copy, action)
+}
+
+run <- function(x) {
+  cli::format_inline(paste0("{.run testthat::", x, "}"))
+}

R/snapshot-file.R

@@ -142,7 +142,11 @@ expect_snapshot_file <- function(
     return(equal)
   }
 
-  hint <- snapshot_review_hint(snapshotter$file, name)
+  if (in_rcmd_check()) {
+    hint <- ""
+  } else {
+    hint <- snapshot_review_hint(snapshotter$file, name)
+  }
 
   if (!equal) {
     msg <- sprintf(
@@ -151,7 +155,7 @@ expect_snapshot_file <- function(
       paste0(snapshotter$file, "/", name),
       hint
     )
-    return(fail(msg))
+    return(fail(msg, snapshot = TRUE))
   }
   pass(NULL)
 }
@@ -167,45 +171,16 @@ announce_snapshot_file <- function(path, name = basename(path)) {
   }
 }
 
-snapshot_review_hint <- function(
-  test,
-  name,
-  ci = on_ci(),
-  check = in_rcmd_check(),
-  reset_output = TRUE
-) {
+snapshot_review_hint <- function(test, name, reset_output = TRUE) {
   if (reset_output) {
     local_reporter_output()
   }
 
-  path <- paste0("tests/testthat/_snaps/", test, "/", new_name(name))
-
-  if (check) {
-    if (on_gh()) {
-      bullets <- snap_download_hint()
-    } else {
-      bullets <- c(
-        if (ci) "* Download and unzip run artifact\n",
-        if (!ci) "* Locate check directory\n",
-        paste0("* Copy '", path, "' to local test directory\n")
-      )
-    }
-  } else {
-    bullets <- NULL
-  }
-
-  paste0(
-    c(
-      bullets,
-      cli::format_inline(
-        "* Run {.run testthat::snapshot_review('{test}/')} to review changes"
-      )
-    ),
-    collapse = ""
+  cli::format_inline(
+    "* Run {.run testthat::snapshot_review('{test}/{name}')} to review the change."
   )
 }
 
-
 snapshot_file_equal <- function(
   snap_dir, # _snaps/
   snap_test, # test file name
@@ -254,7 +229,7 @@ snapshot_file_equal <- function(
     # We want to fail on CI since this suggests that the user has failed
     # to record the value locally
     if (fail_on_new) {
-      return(fail(message, trace_env = trace_env))
+      return(fail(message, snapshot = TRUE, trace_env = trace_env))
     }
     testthat_warn(message)
     TRUE

R/snapshot-github.R

@@ -40,17 +40,6 @@ snapshot_download_gh <- function(repository, run_id, dest_dir = ".") {
   dir_copy(src_snaps, dest_snaps)
 }
 
-snap_download_hint <- function() {
-  repository <- Sys.getenv("GITHUB_REPOSITORY")
-  run_id <- Sys.getenv("GITHUB_RUN_ID")
-
-  sprintf(
-    "* Call `snapshot_download_gh(\"%s\", \"%s\")` to download the snapshots from GitHub.\n",
-    repository,
-    run_id
-  )
-}
-
 gh_find_job <- function(repository, run_id) {
   jobs_json <- gh::gh(
     "/repos/{repository}/actions/runs/{run_id}/jobs",

R/snapshot.R

@@ -289,7 +289,7 @@ expect_snapshot_condition_ <- function(
         class
       )
     }
-    return(fail(msg, trace_env = trace_env))
+    return(fail(msg, snapshot = TRUE, trace_env = trace_env))
   }
 
   expect_snapshot_helper(
@@ -340,7 +340,11 @@ expect_snapshot_helper <- function(
   } else {
     variant_lab <- ""
   }
-  hint <- snapshot_accept_hint(variant, snapshotter$file)
+  if (in_rcmd_check()) {
+    hint <- ""
+  } else {
+    hint <- snapshot_accept_hint(variant, snapshotter$file)
+  }
 
   if (length(comp) != 0) {
     msg <- sprintf(
@@ -350,7 +354,7 @@ expect_snapshot_helper <- function(
       paste0(comp, collapse = "\n\n"),
       hint
     )
-    return(fail(msg, trace_env = trace_env))
+    return(fail(msg, snapshot = TRUE, trace_env = trace_env))
   }
 
   pass(NULL)
@@ -368,13 +372,12 @@ snapshot_accept_hint <- function(variant, file, reset_output = TRUE) {
   }
 
   paste0(
-    if (on_gh()) snap_download_hint(),
     cli::format_inline(
       "* Run {.run testthat::snapshot_accept('{name}')} to accept the change."
     ),
     "\n",
     cli::format_inline(
-      "* Run {.run testthat::snapshot_review('{name}')} to interactively review the change."
+      "* Run {.run testthat::snapshot_review('{name}')} to review the change."
     )
   )
 }

man/expectation.Rd

@@ -96,3 +96,32 @@
 
     [ FAIL 4 | WARN 1 | SKIP 3 | PASS 1 ]
 
+# generates informative snapshot hints
+
+    Code
+      base::writeLines(snapshot_check_hint())
+    Output
+      * Locate check directory.
+      * Copy 'tests/testthat/_snaps' to local package.
+      * Run `testthat::snapshot_accept()` to accept all changes.
+      * Run `testthat::snapshot_review()` to review all changes.
+
+---
+
+    Code
+      base::writeLines(snapshot_check_hint())
+    Output
+      * Download and unzip artifact.
+      * Copy 'tests/testthat/_snaps' to local package.
+      * Run `testthat::snapshot_accept()` to accept all changes.
+      * Run `testthat::snapshot_review()` to review all changes.
+
+---
+
+    Code
+      base::writeLines(snapshot_check_hint())
+    Output
+      * Run `testthat::snapshot_download_gh("r-lib/testthat", "123")` to download snapshots.
+      * Run `testthat::snapshot_accept()` to accept all changes.
+      * Run `testthat::snapshot_review()` to review all changes.
+

man/fail.Rd

@@ -22,38 +22,12 @@
       Error in `snapshot_file_equal_()`:
       ! 'doesnt-exist.txt' not found.
 
-# snapshot_hint output differs in R CMD check
+# generates informative hint
 
     Code
-      cat(snapshot_review_hint("lala", "foo.r", check = FALSE, ci = FALSE))
+      cat(snapshot_review_hint("lala", "foo.r", reset_output = FALSE))
     Output
-      * Run `testthat::snapshot_review('lala/')` to review changes
-
----
-
-    Code
-      cat(snapshot_review_hint("lala", "foo.r", check = TRUE, ci = FALSE))
-    Output
-      * Locate check directory
-      * Copy 'tests/testthat/_snaps/lala/foo.new.r' to local test directory
-      * Run `testthat::snapshot_review('lala/')` to review changes
-
----
-
-    Code
-      cat(snapshot_review_hint("lala", "foo.r", check = TRUE, ci = TRUE))
-    Output
-      * Download and unzip run artifact
-      * Copy 'tests/testthat/_snaps/lala/foo.new.r' to local test directory
-      * Run `testthat::snapshot_review('lala/')` to review changes
-
----
-
-    Code
-      cat(snapshot_review_hint("lala", "foo.r", check = TRUE, ci = TRUE))
-    Output
-      * Call `snapshot_download_gh("r-lib/testthat", "123")` to download the snapshots from GitHub.
-      * Run `testthat::snapshot_review('lala/')` to review changes
+      * Run `testthat::snapshot_review('lala/foo.r')` to review the change.
 
 # expect_snapshot_file validates its inputs