Merge branch 'main' into which_grepl

DESCRIPTION

@@ -128,6 +128,7 @@ Collate:
     'linter_tags.R'
     'lintr-deprecated.R'
     'lintr-package.R'
+    'list_comparison_linter.R'
     'literal_coercion_linter.R'
     'make_linter_from_regex.R'
     'matrix_apply_linter.R'
@@ -139,6 +140,7 @@ Collate:
     'nested_ifelse_linter.R'
     'nonportable_path_linter.R'
     'numeric_leading_zero_linter.R'
+    'nzchar_linter.R'
     'object_length_linter.R'
     'object_name_linter.R'
     'object_usage_linter.R'

NAMESPACE

@@ -90,6 +90,7 @@ export(lint_dir)
 export(lint_package)
 export(linters_with_defaults)
 export(linters_with_tags)
+export(list_comparison_linter)
 export(literal_coercion_linter)
 export(make_linter_from_xpath)
 export(matrix_apply_linter)
@@ -101,6 +102,7 @@ export(nested_ifelse_linter)
 export(no_tab_linter)
 export(nonportable_path_linter)
 export(numeric_leading_zero_linter)
+export(nzchar_linter)
 export(object_length_linter)
 export(object_name_linter)
 export(object_usage_linter)

NEWS.md

@@ -1,5 +1,16 @@
 # lintr (development version)
 
+## Deprecations & breaking changes
+
+* Various things marked deprecated since {lintr} 3.0.0 have been fully deprecated. They will be completely removed in the subsequent release.
+   + `source_file=` argument to `ids_with_token()` and `with_id()`.
+   + Passing linters by name or as non-`"linter"`-classed functions.
+   + `linter=` argument of `Lint()`.
+   + Linters `closed_curly_linter()`, `open_curly_linter()`, `paren_brace_linter()`, and `semicolon_terminator_linter()`..
+   + `with_defaults()`.
+   + Linters `closed_curly_linter()`, `open_curly_linter()`, `paren_brace_linter()`, and `semicolon_terminator_linter()`.
+   + Helper `with_defaults()`.
+
 ## Bug fixes
 
 * `object_name_linter()` no longer errors when user-supplied `regexes=` have capture groups (#2188, @MichaelChirico).
@@ -14,8 +25,10 @@
 * `sample_int_linter()` for encouraging `sample.int(n, ...)` over equivalents like `sample(1:n, ...)` (part of #884, @MichaelChirico).
 * `stopifnot_all_linter()` discourages tests with `all()` like `stopifnot(all(x > 0))`; `stopifnot()` runs `all()` itself, and uses a better error message (part of #884, @MichaelChirico).
 * `comparison_negation_linter()` for discouraging negated comparisons when a direct negation is preferable, e.g. `!(x == y)` could be `x != y` (part of #884, @MichaelChirico).
+* `nzchar_linter()` for encouraging `nzchar()` to test for empty strings, e.g. `nchar(x) > 0` can be `nzchar(x)` (part of #884, @MichaelChirico).
 * `terminal_close_linter()` for discouraging using `close()` to end functions (part of #884, @MichaelChirico). Such usages are not robust to errors, where `close()` will not be run as intended. Put `close()` in an `on.exit()` hook, or use {withr} to manage connections with proper cleanup.
 * `which_grepl_linter()` for discouraging `which(grepl(ptn, x))` in favor of directly using `grep(ptn, x)` (part of #884, @MichaelChirico).
+* `list_comparison_linter()` for discouraging comparisons on the output of `lapply()`, e.g. `lapply(x, sum) > 10` (part of #884, @MichaelChirico).
 * `print_linter()` for discouraging usage of `print()` on string literals like `print("Reached here")` or `print(paste("Found", nrow(DF), "rows."))` (#1894, @MichaelChirico).
 
 ### Lint accuracy fixes: removing false positives

R/deprecated.R

@@ -6,7 +6,9 @@
 NULL
 
 lintr_deprecated <- function(old, new = NULL, version = NULL,
-                             type = "Function") {
+                             type = "Function", signal = c("warning", "stop")) {
+  signal <- match.arg(signal)
+  signal <- match.fun(signal)
   msg <- c(
     c(type, " ", old, " was deprecated"),
     if (length(version) > 0L) {
@@ -18,5 +20,5 @@ lintr_deprecated <- function(old, new = NULL, version = NULL,
     }
   )
   msg <- paste0(msg, collapse = "")
-  warning(msg, call. = FALSE, domain = NA)
+  signal(msg, call. = FALSE, domain = NA)
 }

R/expect_comparison_linter.R

@@ -49,7 +49,7 @@
 #' @export
 expect_comparison_linter <- function() {
   # != doesn't have a clean replacement
-  comparator_nodes <- setdiff(as.list(infix_metadata$xml_tag[infix_metadata$comparator]), "NE")
+  comparator_nodes <- setdiff(infix_metadata$xml_tag[infix_metadata$comparator], "NE")
   xpath <- glue("
   //SYMBOL_FUNCTION_CALL[text() = 'expect_true']
     /parent::expr

R/ids_with_token.R

@@ -29,8 +29,11 @@
 #' @export
 ids_with_token <- function(source_expression, value, fun = `==`, source_file = NULL) {
   if (!missing(source_file)) {
-    lintr_deprecated(old = "source_file", new = "source_expression", version = "3.0.0", type = "Argument")
-    source_expression <- source_file
+    lintr_deprecated(
+      old = "source_file", new = "source_expression",
+      version = "3.0.0", type = "Argument",
+      signal = "stop"
+    )
   }
   if (!is_lint_level(source_expression, "expression")) {
     return(integer())

R/lint.R

@@ -336,31 +336,27 @@ define_linters <- function(linters = NULL) {
 }
 
 validate_linter_object <- function(linter, name) {
-  if (!is_linter(linter) && is.function(linter)) {
-    if (is_linter_factory(linter)) {
-      lintr_deprecated(
-        old = "Passing linters as variables",
-        new =  "a call to the linters (see ?linters)",
-        version = "3.0.0",
-        type = ""
-      )
-      linter <- linter()
-    } else {
-      lintr_deprecated(
-        old = "The use of linters of class 'function'",
-        new = "linters classed as 'linter' (see ?Linter)",
-        version = "3.0.0",
-        type = ""
-      )
-      linter <- Linter(linter, name = name)
-    }
-  } else if (!is.function(linter)) {
+  if (is_linter(linter)) {
+    return(linter)
+  }
+  if (!is.function(linter)) {
     stop(gettextf(
       "Expected '%s' to be a function of class 'linter', not a %s of class '%s'",
       name, typeof(linter), class(linter)[[1L]]
     ))
   }
-  linter
+  if (is_linter_factory(linter)) {
+    old <- "Passing linters as variables"
+    new <- "a call to the linters (see ?linters)"
+  } else {
+    old <- "The use of linters of class 'function'"
+    new <- "linters classed as 'linter' (see ?Linter)"
+  }
+  lintr_deprecated(
+    old = old, new = new, version = "3.0.0",
+    type = "",
+    signal = "stop"
+  )
 }
 
 is_linter_factory <- function(fun) {
@@ -404,7 +400,8 @@ Lint <- function(filename, line_number = 1L, column_number = 1L, # nolint: objec
     lintr_deprecated(
       old = "Using the `linter` argument of `Lint()`",
       version = "3.0.0",
-      type = ""
+      type = "",
+      signal = "stop"
     )
   }
 

R/linter_tag_docs.R

@@ -85,7 +85,7 @@ NULL
 #' @name deprecated_linters
 #' @description
 #' Linters that are deprecated and provided for backwards compatibility only.
-#' These linters will be excluded from `linters_with_tags()` by default.
+#' These linters will be excluded from [linters_with_tags()] by default.
 #' @evalRd rd_linters("deprecated")
 #' @seealso [linters] for a complete list of linters available in lintr.
 NULL

R/linter_tags.R

@@ -4,11 +4,12 @@
 #'
 #' @param packages A character vector of packages to search for linters.
 #' @param tags Optional character vector of tags to search. Only linters with at least one matching tag will be
-#' returned. If `tags` is `NULL`, all linters will be returned. See `available_tags("lintr")` to find out what
-#' tags are already used by lintr.
+#'   returned. If `tags` is `NULL`, all linters will be returned. See `available_tags("lintr")` to find out what
+#'   tags are already used by lintr.
 #' @param exclude_tags Tags to exclude from the results. Linters with at least one matching tag will not be returned.
-#' If `except_tags` is `NULL`, no linters will be excluded. Note that `tags` takes priority, meaning that any
-#' tag found in both `tags` and `exclude_tags` will be included, not excluded.
+#'   If `exclude_tags` is `NULL`, no linters will be excluded. Note that `tags` takes priority, meaning that any
+#'   tag found in both `tags` and `exclude_tags` will be included, not excluded. Note that linters with tag `"defunct"`
+#'   (which do not work and can no longer be run) cannot be queried directly. See [lintr-deprecated] instead.
 #'
 #' @section Package Authors:
 #'
@@ -58,7 +59,8 @@ available_linters <- function(packages = "lintr", tags = NULL, exclude_tags = "d
   }
 
   # any tags specified explicitly will not be excluded (#1959)
-  exclude_tags <- setdiff(exclude_tags, tags)
+  # never include defunct linters, which don't work / error on instantiation (#2284).
+  exclude_tags <- unique(c(setdiff(exclude_tags, tags), "defunct"))
 
   # Handle multiple packages
   if (length(packages) > 1L) {

R/lintr-deprecated.R

@@ -5,160 +5,37 @@
 #'
 #' These functions have been deprecated from lintr.
 #'
-#' - `open_curly_linter()` and `closed_curly_linter()` check that open and closed curly braces
-#'   are on their own line unless they follow an else, a comma, or a closing bracket.
-#'   Deprecated in favor of `brace_linter()`.
+#' - `open_curly_linter()` (use [brace_linter()])
+#' - `closed_curly_linter()` (use `brace_linter()`)
+#' - `paren_brace_linter()` (use `brace_linter()`)
+#' - `semicolon_terminator_linter()` (use [semicolon_linter()])
 #'
-#' - `paren_brace_linter()` checks that there is a space between right parentheses and an opening
-#'    curly brace. E.g., `function(){}` doesn't have a space, while `function() {}` does.
-#'    Deprecated in favor of `brace_linter()`.
-#'
-#' - `semicolon_terminator_linter()` checks that no semicolons terminate expressions.
-#'    Deprecated in favor of `semicolon_linter()`.
-#'
-#' @param allow_single_line if `TRUE`, allow an open and closed curly pair on the same line.
-#' @param semicolon A character vector defining which semicolons to report:
-#' \describe{
-#'   \item{compound}{Semicolons that separate two statements on the same line.}
-#'   \item{trailing}{Semicolons following the last statement on the line.}
-#' }
+#' @param allow_single_line,semicolon Irrelevant parameters to defunct linters.
 #'
 #' @seealso [linters] for a complete list of linters available in lintr.
-#' @evalRd rd_tags("closed_curly_linter")
+#' @evalRd rd_tags("single_quotes_linter")
 #' @keywords internal
 NULL
 
 #' Closed curly linter
 #' @rdname lintr-deprecated
 #' @export
 closed_curly_linter <- function(allow_single_line = FALSE) {
-  lintr_deprecated("closed_curly_linter", new = "brace_linter", version = "3.0.0", type = "Linter")
-  xp_cond_closed <- xp_and(c(
-    # matching { is on same line
-    if (isTRUE(allow_single_line)) {
-      "(@line1 != preceding-sibling::OP-LEFT-BRACE/@line1)"
-    },
-    # immediately followed by ",", "]" or ")"
-    "not(
-      @line1 = ancestor::expr/following-sibling::*[1][
-        self::OP-COMMA or self::OP-RIGHT-BRACKET or self::OP-RIGHT-PAREN
-      ]/@line1
-    )",
-    # double curly
-    "not(
-      (@line1 = parent::expr/following-sibling::OP-RIGHT-BRACE/@line1) or
-      (@line1 = preceding-sibling::expr/OP-RIGHT-BRACE/@line1)
-    )"
-  ))
-
-  xpath <- glue("//OP-RIGHT-BRACE[
-    { xp_cond_closed } and (
-      (@line1 = preceding-sibling::*[1]/@line2) or
-      (@line1 = parent::expr/following-sibling::*[1][not(self::ELSE)]/@line1)
-    )
-  ]")
-
-  Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
-    xml_nodes_to_lints(
-      xml_find_all(source_expression$xml_parsed_content, xpath),
-      source_expression = source_expression,
-      lint_message = "Closing curly-braces should always be on their own line, unless they are followed by an else."
-    )
-  })
+  lintr_deprecated("closed_curly_linter", new = "brace_linter", version = "3.0.0", type = "Linter", signal = "stop")
 }
 
 #' Open curly linter
 #' @rdname lintr-deprecated
 #' @export
 open_curly_linter <- function(allow_single_line = FALSE) {
-  lintr_deprecated("open_curly_linter", new = "brace_linter", version = "3.0.0", type = "Linter")
-
-  xpath_before <- "//OP-LEFT-BRACE[
-    not(following-sibling::expr[1][OP-LEFT-BRACE])
-    and not(parent::expr/preceding-sibling::*[1][OP-LEFT-BRACE])
-    and @line1 != parent::expr/preceding-sibling::*[1][not(self::ELSE)]/@line2
-  ]"
-  if (allow_single_line) {
-    xpath_after <- "//OP-LEFT-BRACE[
-      not(following-sibling::expr[1][OP-LEFT-BRACE])
-      and not(parent::expr/preceding-sibling::OP-LEFT-BRACE)
-      and not(@line2 = following-sibling::OP-RIGHT-BRACE/@line1)
-      and @line2 = following-sibling::expr[position() = 1 and not(OP-LEFT-BRACE)]/@line1
-    ]"
-    message_after <- paste(
-      "Opening curly braces should always be followed by a new line",
-      "unless the paired closing brace is on the same line."
-    )
-  } else {
-    xpath_after <- "//OP-LEFT-BRACE[
-      not(following-sibling::expr[1][OP-LEFT-BRACE])
-      and not(parent::expr/preceding-sibling::OP-LEFT-BRACE)
-      and @line2 = following-sibling::expr[1]/@line1
-    ]"
-    message_after <- "Opening curly braces should always be followed by a new line."
-  }
-
-  Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
-    xml <- source_expression$xml_parsed_content
-
-    expr_before <- xml_find_all(xml, xpath_before)
-    lints_before <- xml_nodes_to_lints(
-      expr_before,
-      source_expression = source_expression,
-      lint_message = "Opening curly braces should never go on their own line.",
-      type = "style"
-    )
-
-    expr_after <- xml_find_all(xml, xpath_after)
-    lints_after <- xml_nodes_to_lints(
-      expr_after,
-      source_expression = source_expression,
-      lint_message = message_after,
-      type = "style"
-    )
-
-    return(c(lints_before, lints_after))
-  })
+  lintr_deprecated("open_curly_linter", new = "brace_linter", version = "3.0.0", type = "Linter", signal = "stop")
 }
 
 #' Parentheses before brace linter
 #' @rdname lintr-deprecated
 #' @export
 paren_brace_linter <- function() {
-  lintr_deprecated("paren_brace_linter", new = "brace_linter", version = "3.0.0", type = "Linter")
-
-  xpath <- paste(
-    "//OP-LEFT-BRACE[",
-    "@line1 = parent::expr/preceding-sibling::OP-RIGHT-PAREN/@line1",
-    "and",
-    "@col1 = parent::expr/preceding-sibling::OP-RIGHT-PAREN/@col1 + 1",
-    "]"
-  )
-
-  Linter(function(source_expression) {
-    if (!is_lint_level(source_expression, "expression")) {
-      return(list())
-    }
-
-    xml <- source_expression$xml_parsed_content
-
-    match_exprs <- xml_find_all(xml, xpath)
-
-    xml_nodes_to_lints(
-      match_exprs,
-      source_expression = source_expression,
-      lint_message = "There should be a space between right parenthesis and an opening curly brace.",
-      type = "style"
-    )
-  })
+  lintr_deprecated("paren_brace_linter", new = "brace_linter", version = "3.0.0", type = "Linter", signal = "stop")
 }
 
 #' Semicolon linter
@@ -169,12 +46,9 @@ semicolon_terminator_linter <- function(semicolon = c("compound", "trailing")) {
     old = "semicolon_terminator_linter",
     new = "semicolon_linter",
     version = "3.0.0",
-    type = "Linter"
+    type = "Linter",
+    signal = "stop"
   )
-  semicolon <- match.arg(semicolon, several.ok = TRUE)
-  allow_compound <- !"compound" %in% semicolon
-  allow_trailing <- !"trailing" %in% semicolon
-  semicolon_linter(allow_compound, allow_trailing)
 }
 
 #' Unnecessary concatenation linter