From ba80e90aa2dcf75def2085e6e4e4c2dc1fbb52c4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 20 Jul 2025 18:00:28 -0700 Subject: [PATCH 01/18] Initial implementation --- NAMESPACE | 1 + R/skip.R | 21 +++++++++++++++++++++ man/skip.Rd | 7 +++++++ 3 files changed, 29 insertions(+) diff --git a/NAMESPACE b/NAMESPACE index 634b60815..8d29d8f7f 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -189,6 +189,7 @@ export(skip_on_covr) export(skip_on_cran) export(skip_on_os) export(skip_on_travis) +export(skip_unless_r) export(snapshot_accept) export(snapshot_review) export(source_dir) diff --git a/R/skip.R b/R/skip.R index 6dba4885b..791693222 100644 --- a/R/skip.R +++ b/R/skip.R @@ -126,6 +126,27 @@ package_version <- function(x) { utils::packageVersion(x) } +#' @export +#' @param spec A version specification like '>= 4.1.0' denoting that this test +#' should only be run on R versions 4.1.0 and later. If the comparison +#' operator is omitted, '>=' is assumed. +#' @rdname skip +skip_unless_r <- function(spec) { + parts <- unlist(strsplit(spec, " ", fixed = TRUE)) + if (length(parts) == 1L) parts <- c(">=", parts) + comparator <- match.fun(parts[1L]) + required_version <- numeric_version(parts[2L]) + + current_version <- getRversion() + skip_if_not( + comparator(current_version, required_version), + sprintf( + "Version requirement not satisfied: %s %s %s", + current_version, parts[1L], required_version + ) + ) +} + #' @export #' @rdname skip skip_if_offline <- function(host = "captive.apple.com") { diff --git a/man/skip.Rd b/man/skip.Rd index 2537a96f4..5c4999f25 100644 --- a/man/skip.Rd +++ b/man/skip.Rd @@ -5,6 +5,7 @@ \alias{skip_if_not} \alias{skip_if} \alias{skip_if_not_installed} +\alias{skip_unless_r} \alias{skip_if_offline} \alias{skip_on_cran} \alias{skip_on_os} @@ -22,6 +23,8 @@ skip_if(condition, message = NULL) skip_if_not_installed(pkg, minimum_version = NULL) +skip_unless_r(spec) + skip_if_offline(host = "captive.apple.com") skip_on_cran() @@ -46,6 +49,10 @@ skip_if_translated(msgid = "'\%s' not found") \item{minimum_version}{Minimum required version for the package} +\item{spec}{A version specification like '>= 4.1.0' denoting that this test +should only be run on R versions 4.1.0 and later. If the comparison +operator is omitted, '>=' is assumed.} + \item{host}{A string with a hostname to lookup} \item{os}{Character vector of one or more operating systems to skip on. From 01496dd20e3fd544b149319ed9095b109314abe9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 20 Jul 2025 18:05:05 -0700 Subject: [PATCH 02/18] backtrack: no default --- R/skip.R | 7 ++++--- man/skip.Rd | 3 +-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/skip.R b/R/skip.R index 791693222..4eeda00a0 100644 --- a/R/skip.R +++ b/R/skip.R @@ -128,12 +128,13 @@ package_version <- function(x) { #' @export #' @param spec A version specification like '>= 4.1.0' denoting that this test -#' should only be run on R versions 4.1.0 and later. If the comparison -#' operator is omitted, '>=' is assumed. +#' should only be run on R versions 4.1.0 and later. #' @rdname skip skip_unless_r <- function(spec) { parts <- unlist(strsplit(spec, " ", fixed = TRUE)) - if (length(parts) == 1L) parts <- c(">=", parts) + if (length(parts) != 2L) { + abort("`spec` should be a comparison like '>=' and an R version.") + } comparator <- match.fun(parts[1L]) required_version <- numeric_version(parts[2L]) diff --git a/man/skip.Rd b/man/skip.Rd index 5c4999f25..911db42f2 100644 --- a/man/skip.Rd +++ b/man/skip.Rd @@ -50,8 +50,7 @@ skip_if_translated(msgid = "'\%s' not found") \item{minimum_version}{Minimum required version for the package} \item{spec}{A version specification like '>= 4.1.0' denoting that this test -should only be run on R versions 4.1.0 and later. If the comparison -operator is omitted, '>=' is assumed.} +should only be run on R versions 4.1.0 and later.} \item{host}{A string with a hostname to lookup} From 5d8a4836a32e4d60134e0e355c8362536310537a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 20 Jul 2025 18:06:53 -0700 Subject: [PATCH 03/18] Add tests --- tests/testthat/test-skip.R | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/tests/testthat/test-skip.R b/tests/testthat/test-skip.R index cd224d96d..cc0d965da 100644 --- a/tests/testthat/test-skip.R +++ b/tests/testthat/test-skip.R @@ -135,3 +135,13 @@ test_that("can refine os with arch", { expect_no_skip(skip_on_os("windows", "x86_64")) expect_no_skip(skip_on_os("linux", "i386")) }) + +test_that("skip_unless_r works as expected", { + expect_no_skip(skip_unless_r(">= 0.0.0")) + expect_no_skip(skip_unless_r(paste("==", getRversion()))) + expect_no_skip(skip_unless_r("<= 999.999.999")) + + expect_skip(skip_unless_r(">= 999.999.999")) + expect_skip(skip_unless_r("== 0.0.0")) + expect_skip(skip_unless_r("<= 0.0.0")) +}) From 1ab7601c443b38c2b3c205462c439d1b3fe6a57f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 20 Jul 2025 18:09:03 -0700 Subject: [PATCH 04/18] NEWS --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index f73cfa7b1..1e7b89e8a 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,9 @@ * Fixed an issue where calling `skip()` outside of an active test could cause an unexpected error (@kevinushey, #2039). +* New `skip_unless_r()` to skip running tests on unsuitable versions of R, e.g. + `skip_unless_r(">= 4.1.0")` to skip tests that require `...names` (@MichaelChirico, #2022) + # testthat 3.2.2 ## New expectations From 9ecb52b2d332c6ffe2c4270565e8ea707d913e7a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 07:22:32 -0700 Subject: [PATCH 05/18] implement expect_skip --- R/expect-self-test.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/expect-self-test.R b/R/expect-self-test.R index 6ff00d5a4..28172bdd3 100644 --- a/R/expect-self-test.R +++ b/R/expect-self-test.R @@ -94,6 +94,9 @@ expect_no_failure <- function(expr) { expect_snapshot_skip <- function(x, cran = FALSE) { expect_snapshot_error(x, class = "skip", cran = cran) } +expect_skip <- function(code) { + expect_condition(code, class = "skip") +} expect_no_skip <- function(code) { expect_no_condition(code, class = "skip") } From 218f3f1bb27b4ce8ffa5470e07cc4beb596ec07a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 08:45:23 -0700 Subject: [PATCH 06/18] use cli_abort Co-authored-by: Hadley Wickham --- R/skip.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/skip.R b/R/skip.R index 4eeda00a0..da51194b2 100644 --- a/R/skip.R +++ b/R/skip.R @@ -133,7 +133,7 @@ package_version <- function(x) { skip_unless_r <- function(spec) { parts <- unlist(strsplit(spec, " ", fixed = TRUE)) if (length(parts) != 2L) { - abort("`spec` should be a comparison like '>=' and an R version.") + cli::cli_abort("{.arg spec} should be a comparison like '>=' and an R version separated by a space.") } comparator <- match.fun(parts[1L]) required_version <- numeric_version(parts[2L]) From 2e2d09b7d9eb849e821d7c76f0f1f502a756860a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 08:45:44 -0700 Subject: [PATCH 07/18] clarify: "R" version Co-authored-by: Hadley Wickham --- R/skip.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/skip.R b/R/skip.R index da51194b2..f0c467180 100644 --- a/R/skip.R +++ b/R/skip.R @@ -142,7 +142,7 @@ skip_unless_r <- function(spec) { skip_if_not( comparator(current_version, required_version), sprintf( - "Version requirement not satisfied: %s %s %s", + "R version requirement not satisfied: %s %s %s", current_version, parts[1L], required_version ) ) From 44c6b8097afde851559e3c922b4b59daa02d36ab Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 15:47:25 +0000 Subject: [PATCH 08/18] rebase NEWS --- NEWS.md | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index d1c86e65e..4a173d583 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,7 @@ * `expect_s4_class()` now supports unquoting (@stibu81, #2064). * `it()` now finds the correct evaluation environment in more cases (@averissimo, #2085). * Fixed an issue preventing compilation from succeeding due to deprecation / removal of `std::uncaught_exception()` (@kevinushey, #2047). +* New `skip_unless_r()` to skip running tests on unsuitable versions of R, e.g. `skip_unless_r(">= 4.1.0")` to skip tests that require `...names` (@MichaelChirico, #2022) # testthat 3.2.3 @@ -11,9 +12,6 @@ * Fixed an issue where calling `skip()` outside of an active test could cause an unexpected error (@kevinushey, #2039). -* New `skip_unless_r()` to skip running tests on unsuitable versions of R, e.g. - `skip_unless_r(">= 4.1.0")` to skip tests that require `...names` (@MichaelChirico, #2022) - # testthat 3.2.2 ## New expectations From c00eee68477bddb7291d11a8f93fd23467c23c5f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 08:49:11 -0700 Subject: [PATCH 09/18] tweak NEWS --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 4a173d583..af1344472 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,7 +3,7 @@ * `expect_s4_class()` now supports unquoting (@stibu81, #2064). * `it()` now finds the correct evaluation environment in more cases (@averissimo, #2085). * Fixed an issue preventing compilation from succeeding due to deprecation / removal of `std::uncaught_exception()` (@kevinushey, #2047). -* New `skip_unless_r()` to skip running tests on unsuitable versions of R, e.g. `skip_unless_r(">= 4.1.0")` to skip tests that require `...names` (@MichaelChirico, #2022) +* New `skip_unless_r()` to skip running tests on unsuitable versions of R, e.g. `skip_unless_r(">= 4.1.0")` to skip tests that require, say, `...names` (@MichaelChirico, #2022) # testthat 3.2.3 From c13dfea48ae8fd6123de08b71ee026cd26a97ecf Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 08:50:27 -0700 Subject: [PATCH 10/18] two snapshot tests [no output yet] --- tests/testthat/test-skip.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/tests/testthat/test-skip.R b/tests/testthat/test-skip.R index cc0d965da..9d5cd473e 100644 --- a/tests/testthat/test-skip.R +++ b/tests/testthat/test-skip.R @@ -141,6 +141,9 @@ test_that("skip_unless_r works as expected", { expect_no_skip(skip_unless_r(paste("==", getRversion()))) expect_no_skip(skip_unless_r("<= 999.999.999")) + expect_snapshot_skip(skip_unless_r(">= 999.999.999")) + expect_snapshot_skip(skip_unless_r("== 0.0.0")) + expect_skip(skip_unless_r(">= 999.999.999")) expect_skip(skip_unless_r("== 0.0.0")) expect_skip(skip_unless_r("<= 0.0.0")) From 0fd180dadcff457871185aa6d33b02384fc39df8 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 23 Jul 2025 14:44:26 -0400 Subject: [PATCH 11/18] Update snapshots --- tests/testthat/_snaps/skip.md | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/tests/testthat/_snaps/skip.md b/tests/testthat/_snaps/skip.md index 4756a3cbb..45f31f0d0 100644 --- a/tests/testthat/_snaps/skip.md +++ b/tests/testthat/_snaps/skip.md @@ -88,3 +88,11 @@ Reason: On Windows i386 +# skip_unless_r works as expected + + Reason: R version requirement not satisfied: 4.5.0 >= 999.999.999 + +--- + + Reason: R version requirement not satisfied: 4.5.0 == 0.0.0 + From 7773e6dadb289d664499194713ba5c58be4f7ea8 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 12:45:39 -0700 Subject: [PATCH 12/18] mock getRversion for static snapshots --- tests/testthat/test-skip.R | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-skip.R b/tests/testthat/test-skip.R index 9d5cd473e..2497934f9 100644 --- a/tests/testthat/test-skip.R +++ b/tests/testthat/test-skip.R @@ -141,10 +141,14 @@ test_that("skip_unless_r works as expected", { expect_no_skip(skip_unless_r(paste("==", getRversion()))) expect_no_skip(skip_unless_r("<= 999.999.999")) - expect_snapshot_skip(skip_unless_r(">= 999.999.999")) - expect_snapshot_skip(skip_unless_r("== 0.0.0")) - expect_skip(skip_unless_r(">= 999.999.999")) expect_skip(skip_unless_r("== 0.0.0")) expect_skip(skip_unless_r("<= 0.0.0")) }) + +test_that("skip_unless_r gives the expected output", { + local_mocked_bindings(getRversion = \() numeric_version("4.5.0")) + + expect_snapshot_skip(skip_unless_r(">= 999.999.999")) + expect_snapshot_skip(skip_unless_r("== 0.0.0")) +}) From cdc7442aaceacb68e213481dd7fb29b12b9935bb Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 12:56:40 -0700 Subject: [PATCH 13/18] tweak wording --- R/skip.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/skip.R b/R/skip.R index f0c467180..a807e68f1 100644 --- a/R/skip.R +++ b/R/skip.R @@ -142,7 +142,7 @@ skip_unless_r <- function(spec) { skip_if_not( comparator(current_version, required_version), sprintf( - "R version requirement not satisfied: %s %s %s", + "Current R version (%s) does not satisfy requirement (%s %s)", current_version, parts[1L], required_version ) ) From c852d964a5d59515e9d22fc137d100bc98a98770 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 12:58:35 -0700 Subject: [PATCH 14/18] manually tweak snapshots --- tests/testthat/_snaps/skip.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/_snaps/skip.md b/tests/testthat/_snaps/skip.md index 45f31f0d0..c9247c7d4 100644 --- a/tests/testthat/_snaps/skip.md +++ b/tests/testthat/_snaps/skip.md @@ -88,11 +88,11 @@ Reason: On Windows i386 -# skip_unless_r works as expected +# skip_unless_r gives the expected output - Reason: R version requirement not satisfied: 4.5.0 >= 999.999.999 + Reason: Current R version (4.5.0) does not satisfy requirement (>= 999.999.999) --- - Reason: R version requirement not satisfied: 4.5.0 == 0.0.0 + Reason: Current R version (4.5.0) does not satisfy requirement (== 0.0.0) From fe531a8eb75a03d958c207854b95a5235feac973 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 23 Jul 2025 16:07:53 -0400 Subject: [PATCH 15/18] Fix mocking --- R/skip.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/skip.R b/R/skip.R index a807e68f1..1ad1de7ed 100644 --- a/R/skip.R +++ b/R/skip.R @@ -147,6 +147,8 @@ skip_unless_r <- function(spec) { ) ) } +# for mocking +getRversion <- NULL #' @export #' @rdname skip From cc6d6da89843698ed730e8e9f53d21eb72ba7871 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 13:10:31 -0700 Subject: [PATCH 16/18] add placeholder to namespace for mocking --- R/expect-self-test.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/R/expect-self-test.R b/R/expect-self-test.R index 74e220e9d..f6dcf5495 100644 --- a/R/expect-self-test.R +++ b/R/expect-self-test.R @@ -134,6 +134,8 @@ local_rng_version <- function(version, .local_envir = parent.frame()) { suppressWarnings(RNGversion(version)) } +getRversion <- NULL # for mocking + # Use specifically for testthat tests in order to override the # defaults found when starting the reporter local_output_override <- function(width = 80, crayon = TRUE, unicode = TRUE, From 8fc564cf999c1a4cb8e1cac374eafc2ba9bcd0ee Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 13:11:41 -0700 Subject: [PATCH 17/18] (revert) --- R/expect-self-test.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/expect-self-test.R b/R/expect-self-test.R index f6dcf5495..74e220e9d 100644 --- a/R/expect-self-test.R +++ b/R/expect-self-test.R @@ -134,8 +134,6 @@ local_rng_version <- function(version, .local_envir = parent.frame()) { suppressWarnings(RNGversion(version)) } -getRversion <- NULL # for mocking - # Use specifically for testthat tests in order to override the # defaults found when starting the reporter local_output_override <- function(width = 80, crayon = TRUE, unicode = TRUE, From 0eaaf3841ff09d752e6fd945588ce8e209ee31da Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 23 Jul 2025 13:24:23 -0700 Subject: [PATCH 18/18] error check for coverage --- tests/testthat/test-skip.R | 2 ++ 1 file changed, 2 insertions(+) diff --git a/tests/testthat/test-skip.R b/tests/testthat/test-skip.R index 2497934f9..ff970078e 100644 --- a/tests/testthat/test-skip.R +++ b/tests/testthat/test-skip.R @@ -144,6 +144,8 @@ test_that("skip_unless_r works as expected", { expect_skip(skip_unless_r(">= 999.999.999")) expect_skip(skip_unless_r("== 0.0.0")) expect_skip(skip_unless_r("<= 0.0.0")) + + expect_error(skip_unless_r("idfjdij"), "should be a comparison like '>='", fixed = TRUE) }) test_that("skip_unless_r gives the expected output", {