diff --git a/R/expect_lint.R b/R/expect_lint.R index 3d9b54e74..7928907a2 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) { + return(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::expect(FALSE, msg)) + return(testthat::fail(sprintf(wrong_number_fmt, n_lints, length(checks), lint_str))) } if (ignore_order) { @@ -85,42 +86,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") - 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 - ) - }) + expect_lint_impl_(lints, checks) + + testthat::succeed() +} - invisible(NULL) +#' 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", + # deparse ensures that NULL, list(), etc are handled gracefully + itr, field, deparse(value), deparse(check) + ))) + } + } + } } #' @rdname expect_lint @@ -162,12 +168,11 @@ 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) { + return(testthat::fail(paste0("Not lint free\n", lint_output))) + } + testthat::succeed() } # Helper function to check if testthat is installed.