Refactor stopifnot into cli_abort

R/implicit_assignment_linter.R

@@ -76,7 +76,9 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr"
                                        allow_lazy = FALSE,
                                        allow_scoped = FALSE,
                                        allow_paren_print = FALSE) {
-  stopifnot(is.null(except) || is.character(except))
+  if (!is.null(except) && !is.character(except)) {
+    cli_abort("{.arg except} must be a character vector or NULL, not {.obj_type_friendly {except}}.")
+  }
 
   if (length(except) > 0L) {
     exceptions <- xp_text_in_table(except)

R/lint.R

@@ -678,7 +678,9 @@ sarif_output <- function(lints, filename = "lintr_results.sarif") {
 #' @param filename The file name of the output report
 #' @export
 gitlab_output <- function(lints, filename = "lintr_results.json") {
-  stopifnot(inherits(lints, "lints"))
+  if (!inherits(lints, "lints")) {
+    cli_abort("{.arg lints} must be a {.cls lints} object, not {.obj_type_friendly {lints}}.")
+  }
   if (!requireNamespace("jsonlite", quietly = TRUE)) {
     cli_abort("{.pkg jsonlite} is required to produce Gitlab reports. Please install to continue.") # nocov
   }

R/make_linter_from_xpath.R

@@ -18,10 +18,12 @@ make_linter_from_xpath <- function(xpath,
   type <- match.arg(type)
   level <- match.arg(level)
 
-  stopifnot(
-    "xpath should be a character string" = is.character(xpath) && length(xpath) == 1L && !is.na(xpath),
-    "lint_message is required" = !missing(lint_message)
-  )
+  if (!is.character(xpath) || length(xpath) != 1L || is.na(xpath)) {
+    cli_abort("{.arg xpath} should be a character string.")
+  }
+  if (missing(lint_message)) {
+    cli_abort("{.arg lint_message} is required.")
+  }
 
   xml_key <- if (level == "expression") "xml_parsed_content" else "full_xml_parsed_content"
 
@@ -54,11 +56,15 @@ make_linter_from_function_xpath <- function(function_names,
   type <- match.arg(type)
   level <- match.arg(level)
 
-  stopifnot(
-    "function_names should be a character vector" = is.character(function_names) && length(function_names) > 0L,
-    "xpath should be a character string" = is.character(xpath) && length(xpath) == 1L && !is.na(xpath),
-    "lint_message is required" = !missing(lint_message)
-  )
+  if (!is.character(function_names) || length(function_names) == 0L) {
+    cli_abort("{.arg function_names} should be a character vector.")
+  }
+  if (!is.character(xpath) || length(xpath) != 1L || is.na(xpath)) {
+    cli_abort("{.arg xpath} should be a character string.")
+  }
+  if (missing(lint_message)) {
+    cli_abort("{.arg lint_message} is required.")
+  }
 
   function() {
     Linter(linter_level = level, function(source_expression) {

R/methods.R

@@ -116,13 +116,17 @@ as_tibble.lints <- function(x, ..., # nolint: object_name_linter.
                             .rows = NULL,
                             .name_repair = c("check_unique", "unique", "universal", "minimal"),
                             rownames = NULL) {
-  stopifnot(requireNamespace("tibble", quietly = TRUE))
+  if (!requireNamespace("tibble", quietly = TRUE)) {
+    cli_abort("Package {.pkg tibble} is required to convert lints to a tibble.")
+  }
   tibble::as_tibble(as.data.frame(x), ..., .rows = .rows, .name_repair = .name_repair, rownames = rownames)
 }
 
 #' @exportS3Method data.table::as.data.table
 as.data.table.lints <- function(x, keep.rownames = FALSE, ...) { # nolint: object_name_linter.
-  stopifnot(requireNamespace("data.table", quietly = TRUE))
+  if (!requireNamespace("data.table", quietly = TRUE)) {
+    cli_abort("Package {.pkg data.table} is required to convert lints to a data.table.")
+  }
   data.table::setDT(as.data.frame(x), keep.rownames = keep.rownames, ...)
 }
 

R/undesirable_function_linter.R

@@ -75,12 +75,13 @@
 undesirable_function_linter <- function(fun = default_undesirable_functions,
                                         symbol_is_undesirable = TRUE) {
   if (is.list(fun)) fun <- unlist(fun)
-  stopifnot(
-    is.logical(symbol_is_undesirable),
-    # allow (uncoerced->implicitly logical) 'NA'
-    `\`fun\` should be a non-empty character vector` =
-      length(fun) > 0L && (is.character(fun) || all(is.na(fun)))
-  )
+  if (!is.logical(symbol_is_undesirable)) {
+    cli_abort("{.arg symbol_is_undesirable} must be a logical, not {.obj_type_friendly {symbol_is_undesirable}}.")
+  }
+  # allow (uncoerced->implicitly logical) 'NA'
+  if (length(fun) == 0L || !(is.character(fun) || all(is.na(fun)))) {
+    cli_abort("{.arg fun} should be a non-empty character vector.")
+  }
 
   nm <- names2(fun)
   implicit_idx <- !nzchar(nm)

R/undesirable_operator_linter.R

@@ -74,12 +74,13 @@
 undesirable_operator_linter <- function(op = default_undesirable_operators,
                                         call_is_undesirable = TRUE) {
   if (is.list(op)) op <- unlist(op)
-  stopifnot(
-    is.logical(call_is_undesirable),
-    # allow (uncoerced->implicitly logical) 'NA'
-    `\`op\` should be a non-empty character vector` =
-      length(op) > 0L && (is.character(op) || all(is.na(op)))
-  )
+  if (!is.logical(call_is_undesirable)) {
+    cli_abort("{.arg call_is_undesirable} must be a logical, not {.obj_type_friendly {call_is_undesirable}}.")
+  }
+  # allow (uncoerced->implicitly logical) 'NA'
+  if (length(op) == 0L || !(is.character(op) || all(is.na(op)))) {
+    cli_abort("{.arg op} should be a non-empty character vector.")
+  }
 
   nm <- names2(op)
   implicit_idx <- !nzchar(nm)

R/unnecessary_concatenation_linter.R

@@ -52,10 +52,9 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # nolint: object_length_linter.
-  stopifnot(
-    is.logical(allow_single_expression),
-    length(allow_single_expression) == 1L
-  )
+  if (!is.logical(allow_single_expression) || length(allow_single_expression) != 1L) {
+    cli_abort("{.arg allow_single_expression} must be a single logical value.")
+  }
 
   msg_empty <-
     "Replace unnecessary c() by NULL or, whenever possible, vector() seeded with the correct type and/or length."

R/xp_utils.R

@@ -77,10 +77,12 @@ xp_or <- function(...) paren_wrap(..., sep = "or")
 #'
 #' @export
 xp_call_name <- function(expr, depth = 1L, condition = NULL) {
-  stopifnot(
-    is.numeric(depth), depth >= 0L,
-    is.null(condition) || is.character(condition)
-  )
+  if (!is.numeric(depth) || depth < 0L) {
+    cli_abort("{.arg depth} must be a non-negative number, not {.obj_type_friendly {depth}}.")
+  }
+  if (!is.null(condition) && !is.character(condition)) {
+    cli_abort("{.arg condition} must be a character vector or NULL, not {.obj_type_friendly {condition}}.")
+  }
   is_valid_expr <- is_node(expr) || is_nodeset(expr)
   if (!is_valid_expr) {
     cli_abort(c(

tests/testthat/test-implicit_assignment_linter.R

@@ -128,6 +128,12 @@ test_that("implicit_assignment_linter respects except argument", {
     "local(a <- 1L)",
     implicit_assignment_linter(except = "local")
   )
+
+  expect_error(
+    implicit_assignment_linter(except = 1L),
+    "`except` must be a character",
+    fixed = TRUE
+  )
 })
 
 test_that("implicit_assignment_linter skips allowed usages with braces", {

tests/testthat/test-lint.R

@@ -278,6 +278,8 @@ test_that("gitlab_output() writes expected report", {
       severity = "info"
     ))
   )
+
+  expect_error(gitlab_output(NULL), "must be a <lints> object", fixed = TRUE)
 })
 
 test_that("explicit parse_settings=TRUE works for inline data", {

tests/testthat/test-make_linter_from_xpath.R

@@ -21,14 +21,17 @@ test_that("input validation works for make_linter_from_xpath", {
     fixed = TRUE
   )
 
-  err_msg <- "xpath should be a character string"
+  err_msg <- "`xpath` should be a character string"
   expect_error(make_linter_from_xpath(FALSE), err_msg, fixed = TRUE)
   expect_error(make_linter_from_xpath(letters), err_msg, fixed = TRUE)
   expect_error(make_linter_from_xpath(NA_character_), err_msg, fixed = TRUE)
   expect_error(make_linter_from_xpath(character()), err_msg, fixed = TRUE)
 
-  err_msg <- "lint_message is required"
-  expect_error(make_linter_from_xpath(""), err_msg, fixed = TRUE)
+  expect_error(
+    make_linter_from_xpath(""),
+    "`lint_message` is required",
+    fixed = TRUE
+  )
 })
 
 test_that("basic usage of make_linter_from_function_xpath works", {
@@ -45,39 +48,39 @@ test_that("basic usage of make_linter_from_function_xpath works", {
 test_that("input validation works for make_linter_from_function_xpath", {
   expect_error(
     make_linter_from_function_xpath(1L),
-    "function_names should be a character vector",
+    "`function_names` should be a character vector",
     fixed = TRUE
   )
   expect_error(
     make_linter_from_function_xpath(character()),
-    "function_names should be a character vector",
+    "`function_names` should be a character vector",
     fixed = TRUE
   )
 
   expect_error(
     make_linter_from_function_xpath("sum", 1L),
-    "xpath should be a character string",
+    "`xpath` should be a character string",
     fixed = TRUE
   )
   expect_error(
     make_linter_from_function_xpath("sum", character()),
-    "xpath should be a character string",
+    "`xpath` should be a character string",
     fixed = TRUE
   )
   expect_error(
     make_linter_from_function_xpath("sum", letters),
-    "xpath should be a character string",
+    "`xpath` should be a character string",
     fixed = TRUE
   )
   expect_error(
     make_linter_from_function_xpath("sum", NA_character_),
-    "xpath should be a character string",
+    "`xpath` should be a character string",
     fixed = TRUE
   )
 
   expect_error(
     make_linter_from_function_xpath("sum", "XP"),
-    "lint_message is required",
+    "`lint_message` is required",
     fixed = TRUE
   )
 })

tests/testthat/test-methods.R

@@ -137,13 +137,26 @@ test_that("as_tibble.list is _not_ dispatched directly", {
 
   lints <- lint(text = "a = 1", linters = assignment_linter())
   expect_identical(nrow(tibble::as_tibble(lints)), 1L)
+
+  as_tibble <- tibble::as_tibble
+  with_mocked_bindings(
+    requireNamespace = \(pkg, ...) pkg != "tibble" && base::requireNamespace(pkg, ...),
+    expect_error(as_tibble(lints), "tibble is required to convert lints", fixed = TRUE)
+  )
 })
 
 test_that("as.data.table.list is _not_ dispatched directly", {
   skip_if_not_installed("data.table")
 
   lints <- lint(text = "a = 1", linters = assignment_linter())
   expect_identical(nrow(data.table::as.data.table(lints)), 1L)
+
+  # nolint next: object_name_linter. Retain data.table naming style for clarity.
+  as.data.table <- data.table::as.data.table
+  with_mocked_bindings(
+    requireNamespace = \(pkg, ...) pkg != "data.table" && base::requireNamespace(pkg, ...),
+    expect_error(as.data.table(lints), "data.table is required to convert lints", fixed = TRUE)
+  )
 })
 
 local({

tests/testthat/test-undesirable_function_linter.R

@@ -72,7 +72,7 @@ test_that("invalid inputs fail correctly", {
 
   expect_error(
     undesirable_function_linter(symbol_is_undesirable = 1.0),
-    "is.logical(symbol_is_undesirable) is not TRUE",
+    "symbol_is_undesirable` must be a logical",
     fixed = TRUE
   )
 })

tests/testthat/test-unnecessary_concatenation_linter.R

@@ -112,11 +112,11 @@ test_that("c(...) does not lint under !allow_single_expression", {
 test_that("invalid allow_single_expression argument produce informative error messages", {
   expect_error(
     expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = 1.0)),
-    rex::rex("is.logical(allow_single_expression) is not TRUE")
+    rex::rex("`allow_single_expression` must be a single logical value.")
   )
 
   expect_error(
     expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = c(TRUE, FALSE))),
-    rex::rex("length(allow_single_expression) == 1L is not TRUE")
+    rex::rex("`allow_single_expression` must be a single logical value.")
   )
 })

tests/testthat/test-xp_utils.R

@@ -15,7 +15,7 @@ test_that("xp_call_name input validation works", {
   expect_error(xp_call_name(2L), "`expr` must be an <xml_nodeset>", fixed = TRUE)
 
   xml <- xml2::read_xml("<a></a>")
-  expect_error(xp_call_name(xml, depth = -1L), "depth >= 0", fixed = TRUE)
-  expect_error(xp_call_name(xml, depth = "1"), "is.numeric(depth)", fixed = TRUE)
-  expect_error(xp_call_name(xml, condition = 1L), "is.character(condition)", fixed = TRUE)
+  expect_error(xp_call_name(xml, depth = -1L), "`depth` must be a non-negative number", fixed = TRUE)
+  expect_error(xp_call_name(xml, depth = "1"), "`depth` must be a non-negative number", fixed = TRUE)
+  expect_error(xp_call_name(xml, condition = 1L), "`condition` must be a character vector or NULL", fixed = TRUE)
 })