Make it easier to see what happens on CRAN

Fixes #2112

Author: hadley

NAMESPACE

@@ -156,6 +156,7 @@ export(it)
 export(local_edition)
 export(local_mock)
 export(local_mocked_bindings)
+export(local_on_cran)
 export(local_reproducible_output)
 export(local_snapshotter)
 export(local_test_context)

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* New `local_on_cran(TRUE)` allows you to simulate how your tests will run on CRAN (#2112).
 * New `pass()` function to use in place of `succeed()` (#2113).
 * `expectation()` is now a combination of `new_expectation()` and `exp_signal()` (#2125).
 * `is_null()`/`matches()` deprecated in 2.0.0 (2017-12-19) and `is_true()`/`is_false()` deprecated in 2.1.0 (2019-04-23) have been removed (#2109).

R/skip.R

@@ -27,7 +27,8 @@
 #'    env var).
 #'
 #' * `skip_on_cran()` skips on CRAN (using the `NOT_CRAN` env var set by
-#'    devtools and friends).
+#'    devtools and friends). `local_on_cran()` gives you the ability to
+#'    easily simulate what will happen on CRAN.
 #'
 #' * `skip_on_covr()` skips when covr is running (using the `R_COVR` env var).
 #'
@@ -178,6 +179,13 @@ skip_on_cran <- function() {
   skip_if(on_cran(), "On CRAN")
 }
 
+#' @export
+#' @rdname skip
+local_on_cran <- function(on_cran, frame = caller_env()) {
+  check_bool(on_cran)
+  withr::local_envvar(NOT_CRAN = tolower(!on_cran), .local_envir = frame)
+}
+
 #' @export
 #' @param os Character vector of one or more operating systems to skip on.
 #'   Supported values are `"windows"`, `"mac"`, `"linux"`, `"solaris"`,
@@ -292,7 +300,12 @@ on_bioc <- function() {
   env_var_is_true("IS_BIOC_BUILD_MACHINE")
 }
 on_cran <- function() {
-  !interactive() && !env_var_is_true("NOT_CRAN")
+  env <- Sys.getenv("NOT_CRAN")
+  if (identical(env, "")) {
+    !interactive()
+  } else {
+    !isTRUE(as.logical(env))
+  }
 }
 
 env_var_is_true <- function(x) {

R/snapshot-file.R

@@ -95,7 +95,7 @@ expect_snapshot_file <- function(
   variant = NULL
 ) {
   edition_require(3, "expect_snapshot_file()")
-  if (!cran && !interactive() && on_cran()) {
+  if (!cran && on_cran()) {
     skip("On CRAN")
   }
 

R/snapshot.R

@@ -298,7 +298,7 @@ expect_snapshot_helper <- function(
   variant = NULL,
   trace_env = caller_env()
 ) {
-  if (!cran && !interactive() && on_cran()) {
+  if (!cran && on_cran()) {
     skip("On CRAN")
   }
 

man/skip.Rd

@@ -36,6 +36,10 @@
 
     Reason: offline
 
+# skip_on_cran generates useful message
+
+    Reason: On CRAN
+
 # skip_on_cran() works as expected
 
     Reason: On CRAN

tests/testthat/_snaps/skip.md

@@ -55,18 +55,42 @@ test_that("skip_if_not_installed() works as expected", {
   expect_snapshot_skip(skip_if_offline())
 })
 
+test_that("skip_on_cran generates useful message", {
+  withr::local_envvar(NOT_CRAN = "false")
+  expect_snapshot_skip(skip_on_cran())
+})
+
 test_that("skip_on_cran() works as expected", {
-  skip_on_cran()
+  local({
+    local_on_cran(FALSE)
+    expect_no_skip(skip_on_cran())
+  })
+
+  local({
+    local_on_cran(TRUE)
+    expect_snapshot_skip(skip_on_cran())
+  })
 
-  withr::local_envvar(NOT_CRAN = "true")
+  withr::local_envvar(NOT_CRAN = NA)
+  local_mocked_bindings(interactive = function() TRUE)
   expect_no_skip(skip_on_cran())
 
-  withr::local_envvar(NOT_CRAN = "false")
   local_mocked_bindings(interactive = function() FALSE)
-  expect_snapshot_skip(skip_on_cran(), cran = TRUE)
+  expect_skip(skip_on_cran())
+})
 
-  local_mocked_bindings(interactive = function() TRUE)
-  expect_no_skip(skip_on_cran())
+test_that("local_on_cran sets NOT_CRAN", {
+  local({
+    local_on_cran(TRUE)
+    expect_equal(on_cran(), TRUE)
+    expect_equal(Sys.getenv("NOT_CRAN"), "false")
+  })
+
+  local({
+    local_on_cran(FALSE)
+    expect_equal(on_cran(), FALSE)
+    expect_equal(Sys.getenv("NOT_CRAN"), "true")
+  })
 })
 
 test_that("skip_on_ci() works as expected", {