From 0dd6d6c80e2a6e78e098ba20b7566e64d770fbdd Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Mon, 29 Sep 2025 17:38:38 -0500 Subject: [PATCH 1/5] Partial fix for upcoming testthat release `expect_success()` and `expect_failure()` now test that you have exactly one success/failure and zero failures/successes. I can't quite figure out why the tests are still failing here; maybe it's something to do with recycling? I'm happy to help but I unfortunately I don't know enough about the lintr internals to figure out what's going wrong here. We're planning to submit testthat to CRAN on Nov 10. --- R/expect_lint.R | 73 +++++++++++++++++++++++++------------------------ 1 file changed, 38 insertions(+), 35 deletions(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index 3d9b54e74..0163f1193 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -70,7 +70,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno if (n_lints != length(checks)) { msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_str) - return(testthat::expect(FALSE, msg)) + return(testthat::fail(msg)) } if (ignore_order) { @@ -90,37 +90,40 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno itr_env$itr <- 0L # valid fields are those from Lint(), plus 'linter' lint_fields <- c(names(formals(Lint)), "linter") - Map( - function(lint, check) { - itr_env$itr <- itr_env$itr + 1L - lapply(names(check), function(field) { - if (!field %in% lint_fields) { - cli_abort(c( - x = "Check {.val {itr_env$itr}} has an invalid field: {.field {field}}.", - i = "Valid fields are: {.field {lint_fields}}." - )) - } - check <- check[[field]] - value <- lint[[field]] - msg <- sprintf( - "check #%d: %s %s did not match %s", - itr_env$itr, field, deparse(value), deparse(check) - ) - # deparse ensures that NULL, list(), etc are handled gracefully - ok <- if (field == "message") { - re_matches_logical(value, check) - } else { - isTRUE(all.equal(value, check)) - } - testthat::expect(ok, msg) - }) - }, - lints, - checks - ) + + for (i in seq_along(lints)) { + lint <- lints[[i]] + check <- checks[[i]] + + itr_env$itr <- itr_env$itr + 1L + + for (field in names(check)) { + if (!field %in% lint_fields) { + cli_abort(c( + x = "Check {.val {itr_env$itr}} has an invalid field: {.field {field}}.", + i = "Valid fields are: {.field {lint_fields}}." + )) + } + check_field <- check[[field]] + value <- lint[[field]] + msg <- sprintf( + "check #%d: %s %s did not match %s", + itr_env$itr, field, deparse(value), deparse(check) + ) + # deparse ensures that NULL, list(), etc are handled gracefully + ok <- if (field == "message") { + re_matches_logical(value, check_field) + } else { + isTRUE(all.equal(value, check_field)) + } + if (!ok) { + return(testthat::fail(msg)) + } + } + } }) - invisible(NULL) + testthat::succeed() } #' @rdname expect_lint @@ -162,12 +165,12 @@ expect_lint_free <- function(...) { if (has_lints) { lint_output <- format(lints) } - result <- testthat::expect( - !has_lints, - paste0("Not lint free\n", lint_output) - ) - invisible(result) + if (!has_lints) { + testthat::succeed() + } else { + testthat::fail(paste0("Not lint free\n", lint_output)) + } } # Helper function to check if testthat is installed. From dd9b3dbbb4e25d1f5c8b2935bae44b807623fd92 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 8 Oct 2025 07:13:11 -0700 Subject: [PATCH 2/5] simple delint --- R/expect_lint.R | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index 0163f1193..d20be0b24 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -97,7 +97,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno itr_env$itr <- itr_env$itr + 1L - for (field in names(check)) { + for (field in names(check)) { if (!field %in% lint_fields) { cli_abort(c( x = "Check {.val {itr_env$itr}} has an invalid field: {.field {field}}.", @@ -166,11 +166,10 @@ expect_lint_free <- function(...) { lint_output <- format(lints) } - if (!has_lints) { - testthat::succeed() - } else { + if (has_lints) { testthat::fail(paste0("Not lint free\n", lint_output)) } + testthat::succeed() } # Helper function to check if testthat is installed. From ebc0318fe8aec68147d9c093f235b41d350b3563 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 8 Oct 2025 07:23:30 -0700 Subject: [PATCH 3/5] extract to helper for cyclo complexity --- R/expect_lint.R | 74 +++++++++++++++++++++++++------------------------ 1 file changed, 38 insertions(+), 36 deletions(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index d20be0b24..dbe9a7bb1 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -85,45 +85,47 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno checks <- checks[check_order] } - local({ - itr_env <- new.env(parent = emptyenv()) - itr_env$itr <- 0L - # valid fields are those from Lint(), plus 'linter' - lint_fields <- c(names(formals(Lint)), "linter") - - for (i in seq_along(lints)) { - lint <- lints[[i]] - check <- checks[[i]] - - itr_env$itr <- itr_env$itr + 1L - - for (field in names(check)) { - if (!field %in% lint_fields) { - cli_abort(c( - x = "Check {.val {itr_env$itr}} has an invalid field: {.field {field}}.", - i = "Valid fields are: {.field {lint_fields}}." - )) - } - check_field <- check[[field]] - value <- lint[[field]] - msg <- sprintf( + expect_lint_impl_(lints, checks) + + testthat::succeed() +} + +#' NB: must _not_ succeed(), should only fail() or abort() +#' @noRd +expect_lint_impl_ <- function(lints, checks) { + itr <- 0L + # valid fields are those from Lint(), plus 'linter' + lint_fields <- c(names(formals(Lint)), "linter") + + for (i in seq_along(lints)) { + lint <- lints[[i]] + check <- checks[[i]] + + itr <- itr + 1L + + for (field in names(check)) { + if (!field %in% lint_fields) { + cli_abort(c( + x = "Check {.val {itr}} has an invalid field: {.field {field}}.", + i = "Valid fields are: {.field {lint_fields}}." + )) + } + check_field <- check[[field]] + value <- lint[[field]] + ok <- if (field == "message") { + re_matches_logical(value, check_field) + } else { + isTRUE(all.equal(value, check_field)) + } + if (!ok) { + return(testthat::fail(sprintf( "check #%d: %s %s did not match %s", - itr_env$itr, field, deparse(value), deparse(check) - ) - # deparse ensures that NULL, list(), etc are handled gracefully - ok <- if (field == "message") { - re_matches_logical(value, check_field) - } else { - isTRUE(all.equal(value, check_field)) - } - if (!ok) { - return(testthat::fail(msg)) - } + # deparse ensures that NULL, list(), etc are handled gracefully + itr, field, deparse(value), deparse(check) + ))) } } - }) - - testthat::succeed() + } } #' @rdname expect_lint From 4138dea689631cb9038b027f725087995d5e7167 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 8 Oct 2025 07:28:25 -0700 Subject: [PATCH 4/5] avoid testthat::expect() again --- R/expect_lint.R | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index dbe9a7bb1..183c0757f 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -59,8 +59,10 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno wrong_number_fmt <- "got %d lints instead of %d%s" if (is.null(checks)) { - msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_str) - return(testthat::expect(n_lints %==% 0L, msg)) + if (n_lints != 0L) { + testthat::fail(sprintf(wrong_number_fmt, n_lints, 0L, lint_str)) + } + return(testthat::succeed()) } if (!is.list(checks) || !is.null(names(checks))) { # vector or named list @@ -69,8 +71,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno checks[] <- lapply(checks, fix_names, "message") if (n_lints != length(checks)) { - msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_str) - return(testthat::fail(msg)) + return(testthat::fail(sprintf(wrong_number_fmt, n_lints, length(checks), lint_str))) } if (ignore_order) { From f18aec851802d015e614143e26e56fa3e78d0f51 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 8 Oct 2025 07:30:36 -0700 Subject: [PATCH 5/5] fail() needs return() --- R/expect_lint.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index 183c0757f..7928907a2 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -60,7 +60,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno wrong_number_fmt <- "got %d lints instead of %d%s" if (is.null(checks)) { if (n_lints != 0L) { - testthat::fail(sprintf(wrong_number_fmt, n_lints, 0L, lint_str)) + return(testthat::fail(sprintf(wrong_number_fmt, n_lints, 0L, lint_str))) } return(testthat::succeed()) } @@ -170,7 +170,7 @@ expect_lint_free <- function(...) { } if (has_lints) { - testthat::fail(paste0("Not lint free\n", lint_output)) + return(testthat::fail(paste0("Not lint free\n", lint_output))) } testthat::succeed() }