Unnamed entries "just work" in undesirable_function_linter (and for operators)

NAMESPACE

@@ -167,6 +167,7 @@ export(yoda_test_linter)
 importFrom(cli,cli_abort)
 importFrom(cli,cli_inform)
 importFrom(cli,cli_warn)
+importFrom(cli,qty)
 importFrom(glue,glue)
 importFrom(glue,glue_collapse)
 importFrom(rex,character_class)

NEWS.md

@@ -23,12 +23,15 @@
 * `seq_linter()`:
    + recommends using `seq_along(x)` instead of `seq_len(length(x))` (#2577, @MichaelChirico).
    + recommends using `sequence()` instead of `unlist(lapply(ints, seq))` (#2618, @Bisaloo)
-* `undesirable_operator_linter()` lints operators in prefix form, e.g. `` `%%`(x, 2)`` (#1910, @MichaelChirico). Disable this by setting `call_is_undesirable=FALSE`.
+* `undesirable_operator_linter()`:
+   + Lints operators in prefix form, e.g. `` `%%`(x, 2)`` (#1910, @MichaelChirico). Disable this by setting `call_is_undesirable=FALSE`.
+   + Accepts unnamed entries, treating them as undesirable operators, e.g. `undesirable_operator_linter("%%")` (#2536, @MichaelChirico).
 * `indentation_linter()` handles `for` un-braced for loops correctly (#2564, @MichaelChirico).
 * Setting `exclusions` supports globs like `knitr*` to exclude files/directories with a pattern (#1554, @MichaelChirico).
 * `get_source_expression()` captures warnings emitted by the R parser (currently always for mis-specified literal integers like `1.1L`) and `lint()` returns them as lints (#2065, @MichaelChirico).
 * `object_name_linter()` and `object_length_linter()` apply to objects assigned with `assign()` or generics created with `setGeneric()` (#1665, @MichaelChirico).
 * `object_usage_linter()` gains argument `interpret_extensions` to govern which false positive-prone common syntaxes should be checked for used objects (#1472, @MichaelChirico). Currently `"glue"` (renamed from earlier argument `interpret_glue`) and `"rlang"` are supported. The latter newly covers usage of the `.env` pronoun like `.env$key`, where `key` was previously missed as being a used variable.
+* `undesirable_function_linter()` accepts unnamed entries, treating them as undesirable functions, e.g. `undesirable_function_linter("sum")` (#2536, @MichaelChirico).
 
 ### New linters
 

R/lintr-package.R

@@ -8,7 +8,7 @@
 "_PACKAGE"
 
 ## lintr namespace: start
-#' @importFrom cli cli_inform cli_abort cli_warn
+#' @importFrom cli cli_inform cli_abort cli_warn qty
 #' @importFrom glue glue glue_collapse
 #' @importFrom rex rex regex re_matches re_substitutes character_class
 #' @importFrom stats complete.cases na.omit

R/undesirable_function_linter.R

@@ -2,10 +2,17 @@
 #'
 #' Report the use of undesirable functions and suggest an alternative.
 #'
-#' @param fun Named character vector. `names(fun)` correspond to undesirable functions,
-#'   while the values give a description of why the function is undesirable.
-#'   If `NA`, no additional information is given in the lint message. Defaults to
-#'   [default_undesirable_functions]. To make small customizations to this list,
+#' @param fun Character vector of undesirable function names. Input can be any of three types:
+#'   - Unnamed entries must be a character string specifying an undesirable function.
+#'   - For named entries, the name specifies the undesirable function.
+#'     + If the entry is a character string, it is used as a description of
+#'       why a given function is undesirable
+#'     + Otherwise, entries should be missing (`NA`)
+#'   A generic message that the named function is undesirable is used if no
+#'     specific description is provided.
+#'   Input can also be a list of character strings for convenience.
+#'
+#'   Defaults to [default_undesirable_functions]. To make small customizations to this list,
 #'   use [modify_defaults()].
 #' @param symbol_is_undesirable Whether to consider the use of an undesirable function
 #'   name as a symbol undesirable or not.
@@ -35,6 +42,12 @@
 #'   linters = undesirable_function_linter(fun = c("dir" = NA))
 #' )
 #'
+#'
+#' lint(
+#'   text = 'dir <- "path/to/a/directory"',
+#'   linters = undesirable_function_linter(fun = "dir")
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = "vapply(x, mean, FUN.VALUE = numeric(1))",
@@ -51,16 +64,35 @@
 #'   linters = undesirable_function_linter(fun = c("dir" = NA), symbol_is_undesirable = FALSE)
 #' )
 #'
+#' lint(
+#'   text = 'dir <- "path/to/a/directory"',
+#'   linters = undesirable_function_linter(fun = "dir", symbol_is_undesirable = FALSE)
+#' )
+#'
 #' @evalRd rd_tags("undesirable_function_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 undesirable_function_linter <- function(fun = default_undesirable_functions,
                                         symbol_is_undesirable = TRUE) {
-  stopifnot(is.logical(symbol_is_undesirable))
-  if (is.null(names(fun)) || !all(nzchar(names(fun))) || length(fun) == 0L) {
-    cli_abort(c(
-      x = "{.arg fun} should be a non-empty named character vector.",
-      i = "Use missing elements to indicate default messages."
+  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)))
+  )
+
+  nm <- names2(fun)
+  implicit_idx <- !nzchar(nm)
+  if (any(implicit_idx)) {
+    names(fun)[implicit_idx] <- fun[implicit_idx]
+    is.na(fun) <- implicit_idx
+  }
+  if (anyNA(names(fun))) {
+    missing_idx <- which(is.na(names(fun))) # nolint: object_usage_linter. False positive.
+    cli_abort(paste(
+      "Unnamed elements of {.arg fun} must not be missing,",
+      "but {.val {missing_idx}} {qty(length(missing_idx))} {?is/are}."
     ))
   }
 

R/undesirable_operator_linter.R

@@ -3,10 +3,17 @@
 #' Report the use of undesirable operators, e.g. \code{\link[base:ns-dblcolon]{:::}} or
 #' [`<<-`][base::assignOps] and suggest an alternative.
 #'
-#' @param op Named character vector. `names(op)` correspond to undesirable operators,
-#'   while the values give a description of why the operator is undesirable.
-#'   If `NA`, no additional information is given in the lint message. Defaults to
-#'   [default_undesirable_operators]. To make small customizations to this list,
+#' @param op Character vector of undesirable operators. Input can be any of three types:
+#'   - Unnamed entries must be a character string specifying an undesirable operator.
+#'   - For named entries, the name specifies the undesirable operator.
+#'     + If the entry is a character string, it is used as a description of
+#'       why a given operator is undesirable
+#'     + Otherwise, entries should be missing (`NA`)
+#'   A generic message that the named operator is undesirable is used if no
+#'     specific description is provided.
+#'   Input can also be a list of character strings for convenience.
+#'
+#'   Defaults to [default_undesirable_operators]. To make small customizations to this list,
 #'   use [modify_defaults()].
 #' @param call_is_undesirable Logical, default `TRUE`. Should lints also be produced
 #'   for prefix-style usage of the operators provided in `op`?
@@ -31,6 +38,11 @@
 #'   linters = undesirable_operator_linter()
 #' )
 #'
+#' lint(
+#'   text = "mtcars$wt",
+#'   linters = undesirable_operator_linter("$")
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = "a <- log(10)",
@@ -51,17 +63,38 @@
 #'   linters = undesirable_operator_linter(call_is_undesirable = FALSE)
 #' )
 #'
+#' lint(
+#'   text = 'mtcars[["wt"]]',
+#'   linters = undesirable_operator_linter("$")
+#' )
+#'
 #' @evalRd rd_tags("undesirable_operator_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 undesirable_operator_linter <- function(op = default_undesirable_operators,
                                         call_is_undesirable = TRUE) {
-  if (is.null(names(op)) || !all(nzchar(names(op))) || length(op) == 0L) {
-    cli_abort(c(
-      x = "{.arg op} should be a non-empty named character vector.",
-      i = "Use missing elements to indicate default messages."
+  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)))
+  )
+
+  nm <- names2(op)
+  implicit_idx <- !nzchar(nm)
+  if (any(implicit_idx)) {
+    names(op)[implicit_idx] <- op[implicit_idx]
+    is.na(op) <- implicit_idx
+  }
+  if (anyNA(names(op))) {
+    missing_idx <- which(is.na(names(op))) # nolint: object_usage_linter. False positive.
+    cli_abort(paste(
+      "Unnamed elements of {.arg op} must not be missing,",
+      "but {.val {missing_idx}} {qty(length(missing_idx))} {?is/are}."
     ))
   }
+
   # infix must be handled individually below; non-assignment `=` are always OK
   operator_nodes <- infix_metadata$xml_tag_exact[
     infix_metadata$string_value %in% setdiff(names(op), "%%") &

tests/testthat/test-undesirable_function_linter.R

@@ -3,8 +3,8 @@ test_that("linter returns correct linting", {
   msg_return <- rex::rex('Avoid undesirable function "return".', end)
   msg_log10 <- rex::rex('Avoid undesirable function "log10". As an alternative, use log().')
 
-  expect_lint("x <- options()", NULL, linter)
-  expect_lint("cat(\"Try to return\")", NULL, linter)
+  expect_no_lint("x <- options()", linter)
+  expect_no_lint("cat(\"Try to return\")", linter)
   expect_lint("lapply(x, log10)", list(message = msg_log10, line_number = 1L, column_number = 11L), linter)
   expect_lint("return()", list(message = msg_return, line_number = 1L, column_number = 1L), linter)
   expect_lint(
@@ -21,31 +21,31 @@ test_that("linter returns correct linting", {
     linter
   )
   # regression test for #1050
-  expect_lint("df$return <- 1", NULL, linter)
-  expect_lint("df@return <- 1", NULL, linter)
+  expect_no_lint("df$return <- 1", linter)
+  expect_no_lint("df@return <- 1", linter)
 })
 
 test_that("it's possible to NOT lint symbols", {
   linter <- undesirable_function_linter(
     fun = c(dir = NA, log10 = "use log()"),
     symbol_is_undesirable = FALSE
   )
-  expect_lint("dir <- 'path/to/a/directory'", NULL, linter)
-  expect_lint("lapply(x, log10)", NULL, linter)
+  expect_no_lint("dir <- 'path/to/a/directory'", linter)
+  expect_no_lint("lapply(x, log10)", linter)
 })
 
 test_that("undesirable_function_linter doesn't lint library and require calls", {
   linter <- undesirable_function_linter(fun = c(foo = NA))
   expect_lint("test::foo()", "undesirable", linter)
-  expect_lint("foo::test()", NULL, linter)
-  expect_lint("library(foo)", NULL, linter)
-  expect_lint("require(foo)", NULL, linter)
+  expect_no_lint("foo::test()", linter)
+  expect_no_lint("library(foo)", linter)
+  expect_no_lint("require(foo)", linter)
 
   linter <- undesirable_function_linter(fun = c(foo = NA, bar = NA))
-  expect_lint("library(foo)", NULL, linter)
+  expect_no_lint("library(foo)", linter)
 
   linter <- undesirable_function_linter(fun = c(foo = NA, bar = NA), symbol_is_undesirable = FALSE)
-  expect_lint("library(foo)", NULL, linter)
+  expect_no_lint("library(foo)", linter)
 })
 
 # regression test for #866
@@ -55,32 +55,41 @@ test_that("Line numbers are extracted correctly", {
 })
 
 test_that("invalid inputs fail correctly", {
-  error_msg <- "`fun` should be a non-empty named character vector"
-
-  expect_error(
-    undesirable_function_linter("***"),
-    error_msg,
-    fixed = TRUE
-  )
-  expect_error(
-    undesirable_function_linter(c("***" = NA, NA)),
-    error_msg,
-    fixed = TRUE
-  )
   expect_error(
     undesirable_function_linter(fun = NULL),
-    error_msg,
+    "`fun` should be a non-empty character vector",
     fixed = TRUE
   )
   expect_error(
     undesirable_function_linter(fun = character(0L)),
-    error_msg,
+    "`fun` should be a non-empty character vector",
     fixed = TRUE
   )
+  expect_error(
+    undesirable_function_linter(c(NA, NA)),
+    rex::rex("Unnamed elements of `fun` must not be missing", anything, "1", anything, "2")
+  )
 
   expect_error(
     undesirable_function_linter(symbol_is_undesirable = 1.0),
     "is.logical(symbol_is_undesirable) is not TRUE",
     fixed = TRUE
   )
 })
+
+test_that("Default recommendations can be specified multiple ways", {
+  linter_na <- undesirable_function_linter(c(foo = NA))
+  linter_unnamed1 <- undesirable_function_linter("foo")
+  linter_unnamed2 <- undesirable_function_linter(c("foo", "bar"))
+  linter_mixed1 <- undesirable_function_linter(c("foo", bar = "no bar"))
+  linter_mixed2 <- undesirable_function_linter(c("foo", bar = NA))
+
+  lint_message <- rex::rex('Avoid undesirable function "foo"')
+
+  lint_str <- "foo()"
+  expect_lint(lint_str, lint_message, linter_na)
+  expect_lint(lint_str, lint_message, linter_unnamed1)
+  expect_lint(lint_str, lint_message, linter_unnamed2)
+  expect_lint(lint_str, lint_message, linter_mixed1)
+  expect_lint(lint_str, lint_message, linter_mixed2)
+})