Skipping overhaul (#1761)

* Use `IS_BIOC_BUILD_MACHINE` for `skip_on_bioc()`. Fixes #1712.
* `skip()` gains default message. Fixes #1586.
* Overhaul testing and get as close as possible to 100% test coverage.
* Replace mockery with `local_mocked_bindings()`.
* Move superseded skips to own doc.

Author: hadley

DESCRIPTION

@@ -42,7 +42,6 @@ Suggests:
     curl (>= 0.9.5),
     diffviewer (>= 0.1.0),
     knitr,
-    mockery,
     rmarkdown,
     rstudioapi,
     shiny,

NEWS.md

@@ -1,5 +1,8 @@
 # testthat (development version)
 
+* `skip_on_bioc()` now uses the documented environment variable
+  (`IS_BIOC_BUILD_MACHINE`) (#1712).
+
 * `test_path()` now works when called within helper files (#1562).
 
 * `it()` now calls `local_test_context()` so that it behaves more

R/expect-self-test.R

@@ -47,9 +47,13 @@ expect_failure <- function(expr, message = NULL, ...) {
   invisible(NULL)
 }
 
-expect_skip <- function(code, regexp = NULL) {
-  expect_condition(code, regexp, class = "skip")
+expect_snapshot_skip <- function(x) {
+  expect_snapshot_error(x, class = "skip")
 }
+expect_no_skip <- function(code) {
+  expect_no_condition(code, class = "skip")
+}
+
 
 #' @export
 #' @rdname expect_success

R/skip.R

@@ -22,16 +22,16 @@
 #'
 #' * `skip_if_translated("msg")` skips tests if the "msg" is translated.
 #'
-#' * `skip_on_bioc()` skips on Bioconductor (using the `BBS_HOME` env var).
+#' * `skip_on_bioc()` skips on Bioconductor (using the `IS_BIOC_BUILD_MACHINE`
+#'    env var).
 #'
 #' * `skip_on_cran()` skips on CRAN (using the `NOT_CRAN` env var set by
 #'    devtools and friends).
 #'
 #' * `skip_on_covr()` skips when covr is running (using the `R_COVR` env var).
 #'
 #' * `skip_on_ci()` skips on continuous integration systems like GitHub Actions,
-#'    travis, and appveyor (using the `CI` env var). It supersedes the older
-#'    `skip_on_travis()` and `skip_on_appveyor()` functions.
+#'    travis, and appveyor (using the `CI` env var).
 #'
 #' * `skip_on_os()` skips on the specified operating system(s) ("windows",
 #'   "mac", "linux", or "solaris").
@@ -48,7 +48,7 @@
 #'   expect_equal(1, 2)     # this one skipped
 #'   expect_equal(1, 3)     # this one is also skipped
 #' })
-skip <- function(message) {
+skip <- function(message = "Skipping") {
   message <- paste0(message, collapse = "\n")
   cond <- structure(
     list(message = paste0("Reason: ", message)),
@@ -76,6 +76,8 @@ skip_if_not <- function(condition, message = NULL) {
   }
   if (!isTRUE(condition)) {
     skip(message)
+  } else {
+    invisible()
   }
 }
 
@@ -87,6 +89,8 @@ skip_if <- function(condition, message = NULL) {
   }
   if (isTRUE(condition)) {
     skip(message)
+  } else {
+    invisible()
   }
 }
 
@@ -109,18 +113,18 @@ skip_if_not_installed <- function(pkg, minimum_version = NULL) {
     }
   }
 
-  return(invisible(TRUE))
+  invisible()
 }
 
 #' @export
 #' @rdname skip
 skip_if_offline <- function(host = "r-project.org") {
   skip_on_cran()
   skip_if_not_installed("curl")
-  has_internet <- !is.null(curl::nslookup(host, error = FALSE))
-  if (!has_internet) {
-    skip("offline")
-  }
+  skip_if_not(has_internet(host), "offline")
+}
+has_internet <- function(host) {
+  !is.null(curl::nslookup(host, error = FALSE))
 }
 
 #' @export
@@ -129,8 +133,6 @@ skip_on_cran <- function() {
   skip_if(on_cran(), "On CRAN")
 }
 
-on_cran <- function() !identical(Sys.getenv("NOT_CRAN"), "true")
-
 #' @export
 #' @param os Character vector of one or more operating systems to skip on.
 #'   Supported values are `"windows"`, `"mac"`, `"linux"`, and `"solaris"`.
@@ -175,62 +177,22 @@ skip_on_os <- function(os, arch = NULL) {
 system_os <- function() tolower(Sys.info()[["sysname"]])
 system_arch <- function() R.version$arch
 
-#' @export
-#' @rdname skip
-skip_on_travis <- function() {
-  if (!identical(Sys.getenv("TRAVIS"), "true")) {
-    return(invisible(TRUE))
-  }
-
-  skip("On Travis")
-}
-
-#' @export
-#' @rdname skip
-skip_on_appveyor <- function() {
-  if (!identical(Sys.getenv("APPVEYOR"), "True")) {
-    return()
-  }
-
-  skip("On Appveyor")
-}
-
 #' @export
 #' @rdname skip
 skip_on_ci <- function() {
-  if (!on_ci()) {
-    return(invisible(TRUE))
-  }
-
-  skip("On CI")
-}
-
-on_ci <- function() {
- isTRUE(as.logical(Sys.getenv("CI")))
-}
-
-in_covr <- function() {
-  identical(Sys.getenv("R_COVR"), "true")
+  skip_if(on_ci(), "On CI")
 }
 
 #' @export
 #' @rdname skip
 skip_on_covr <- function() {
-  if (! in_covr()) {
-    return(invisible(TRUE))
-  }
-
-  skip("On covr")
+  skip_if(in_covr(), "On covr")
 }
 
 #' @export
 #' @rdname skip
 skip_on_bioc <- function() {
-  if (identical(Sys.getenv("BBS_HOME"), "")) {
-    return(invisible(TRUE))
-  }
-
-  skip("On Bioconductor")
+  skip_if(on_bioc(), "On Bioconductor")
 }
 
 #' @export
@@ -239,9 +201,47 @@ skip_on_bioc <- function() {
 #'   [`R-base.pot`](https://github.com/wch/r-source/blob/master/src/library/base/po/R-base.pot).
 #' @rdname skip
 skip_if_translated <- function(msgid = "'%s' not found") {
-  if (gettext(msgid, domain = "R") == msgid) {
-    return(invisible(TRUE))
-  }
+  skip_if(
+    gettext(msgid, domain = "R") != msgid,
+    paste0("\"", msgid, "\" is translated")
+  )
+}
+
+#' Superseded skip functions
+#'
+#' @description
+#' `r lifecycle::badge("superseded")`
+#'
+#' * `skip_on_travis()` and `skip_on_appveyor()` have been superseded by
+#'   [skip_on_ci()].
+#'
+#' @export
+#' @keywords internal
+skip_on_travis <- function() {
+  skip_if(env_var_is_true("TRAVIS"), "On Travis")
+}
+
+#' @export
+#' @rdname skip_on_travis
+skip_on_appveyor <- function() {
+  skip_if(env_var_is_true("APPVEYOR"), "On Appveyor")
+}
+
+# helpers -----------------------------------------------------------------
+
+on_ci <- function() {
+ env_var_is_true("CI")
+}
+in_covr <- function() {
+  env_var_is_true("R_COVR")
+}
+on_bioc <- function() {
+  env_var_is_true("IS_BIOC_BUILD_MACHINE")
+}
+on_cran <- function() {
+  !env_var_is_true("NOT_CRAN")
+}
 
-  skip(paste0("\"", msgid, "\" is translated"))
+env_var_is_true <- function(x) {
+  isTRUE(as.logical(Sys.getenv(x, "false")))
 }

man/skip.Rd

@@ -1,10 +1,18 @@
-# skip on os checks os names
+# basic skips work as expected
 
-    Code
-      skip_on_os("amiga")
-    Condition
-      Error in `match.arg()`:
-      ! 'arg' should be one of "windows", "mac", "linux", "solaris"
+    Reason: Skipping
+
+---
+
+    Reason: TRUE is TRUE
+
+---
+
+    Reason: FALSE is not TRUE
+
+---
+
+    Reason: empty test
 
 # autogenerated message is always single line
 
@@ -16,3 +24,67 @@
         a_very_long_argument_name || a_very_long_argument_name || 
         a_very_long_argument_name is not TRUE
 
+# skip_if_not_installed() works as expected
+
+    Reason: doesntexist cannot be loaded
+
+---
+
+    Reason: Installed testthat is version 3.1.7.9000; but 9999.9999.999 is required
+
+---
+
+    Reason: offline
+
+# skip_on_cran() works as expected
+
+    Reason: On CRAN
+
+# skip_on_ci() works as expected
+
+    Reason: On CI
+
+# skip_on_covr() works as expected
+
+    Reason: On covr
+
+# skip_on_bioc() works as expected
+
+    Reason: On Bioconductor
+
+# superseded CI skips still work
+
+    Reason: On Travis
+
+---
+
+    Reason: On Appveyor
+
+# skip_if_translated() works as expected
+
+    Reason: "'%s' not found" is translated
+
+# skip on os checks os names
+
+    Code
+      skip_on_os("amiga")
+    Condition
+      Error in `match.arg()`:
+      ! 'arg' should be one of "windows", "mac", "linux", "solaris"
+
+# can skip on multiple oses
+
+    Reason: On Windows
+
+---
+
+    Reason: On Windows
+
+# can refine os with arch
+
+    Reason: On Windows
+
+---
+
+    Reason: On Windows i386
+