Merge branch 'main' into feature/use-file-level

# Conflicts:
#	R/any_is_na_linter.R
#	R/vector_logic_linter.R

.lintr

@@ -2,6 +2,18 @@ linters: all_linters(
     backport_linter("3.6.0", except = c("R_user_dir", "deparse1", "...names")),
     line_length_linter(120L),
     object_overwrite_linter(allow_names = c("line", "lines", "pipe", "symbols")),
+    todo_comment_linter(
+      except_regex = rex::rex(
+        "TODO(",
+        group(or(
+          # GitHub issue number #1234, possibly from another repo org/repo#5678
+          list(maybe(one_or_more(alnum, "-"), "/", one_or_more(alnum, ".", "-", "_")), "#", one_or_more(digit)),
+          # GitHub user. TODO(#2450): remove this temporary immunity
+          one_or_more(alnum, "-")
+        )),
+        ")"
+      )
+    ),
     undesirable_function_linter(modify_defaults(
       defaults = default_undesirable_functions,
       library = NULL,

DESCRIPTION

@@ -141,6 +141,7 @@ Collate:
     'nested_ifelse_linter.R'
     'nested_pipe_linter.R'
     'nonportable_path_linter.R'
+    'shared_constants.R'
     'nrow_subset_linter.R'
     'numeric_leading_zero_linter.R'
     'nzchar_linter.R'
@@ -173,7 +174,6 @@ Collate:
     'seq_linter.R'
     'settings.R'
     'settings_utils.R'
-    'shared_constants.R'
     'sort_linter.R'
     'source_utils.R'
     'spaces_inside_linter.R'

NEWS.md

@@ -34,13 +34,18 @@
   + `allow_implicit_else` (default `TRUE`) which, when `FALSE`, checks that all terminal `if` statements are paired with a corresponding `else` statement (part of #884, @MichaelChirico).
   + `return_functions` to customize which functions are equivalent to `return()` as "exit" clauses, e.g. `rlang::abort()` can be considered in addition to the default functions like `stop()` and `q()` from base (#2271 and part of #884, @MichaelChirico and @MEO265).
   + `except` to customize which functions are ignored entirely (i.e., whether they have a return of the specified style is not checked; #2271 and part of #884, @MichaelChirico and @MEO265). Namespace hooks like `.onAttach()` and `.onLoad()` are always ignored.
+  + `except_regex`, the same purpose as `except=`, but filters functions by pattern. This is motivated by {RUnit}, where test suites are based on unit test functions matched by pattern, e.g. `^Test`, and where explicit return may be awkward (#2335, @MichaelChirico).
 * `unnecessary_lambda_linter` is extended to encourage vectorized comparisons where possible, e.g. `sapply(x, sum) > 0` instead of `sapply(x, function(x) sum(x) > 0)` (part of #884, @MichaelChirico). Toggle this behavior with argument `allow_comparison`.
 * `backport_linter()` is slightly faster by moving expensive computations outside the linting function (#2339, #2348, @AshesITR and @MichaelChirico).
 * `Linter()` has a new argument `linter_level` (default `NA`). This is used by `lint()` to more efficiently check for expression levels than the idiom `if (!is_lint_level(...)) { return(list()) }` (#2351, @AshesITR).
 * `string_boundary_linter()` recognizes regular expression calls like `grepl("^abc$", x)` that can be replaced by using `==` instead (#1613, @MichaelChirico).
 * `unreachable_code_linter()` has an argument `allow_comment_regex` for customizing which "terminal" comments to exclude (#2327, @MichaelChirico). `# nolint end` comments are always excluded, as are {covr} exclusions (e.g. `# nocov end`) by default.
 * `format()` and `print()` methods for `lint` and `lints` classes get a new option `width` to control the printing width of lint messages (#1884, @MichaelChirico). The default is controlled by a new option `lintr.format_width`; if unset, no wrapping occurs (matching earlier behavior).
+* `implicit_assignment_linter()` gets a custom message for the case of using `(` to induce printing like `(x <- foo())`; use an explicit call to `print()` for clarity (#2257, @MichaelChirico).
 * New function node caching for big efficiency gains to most linters (e.g. overall `lint_package()` improvement of 14-27% and core linting improvement up to 30%; #2357, @AshesITR). Most linters are written around function usage, and XPath performance searching for many functions is poor. The new `xml_find_function_calls()` entry in the `get_source_expressions()` output caches all function call nodes instead. See the vignette on creating linters for more details on how to use it.
+* `todo_comment_linter()` has a new argument `except_regex` for setting _valid_ TODO comments, e.g. for forcing TODO comments to be linked to GitHub issues like `TODO(#154)` (#2047, @MichaelChirico).
+* `vector_logic_linter()` is extended to recognize incorrect usage of scalar operators `&&` and `||` inside subsetting expressions like `dplyr::filter(x, A && B)` (#2166, @MichaelChirico).
+* `any_is_na_linter()` is extended to catch the unusual usage `NA %in% x` (#2113, @MichaelChirico).
 
 ### New linters
 
@@ -58,7 +63,7 @@
 * `consecutive_mutate_linter()` for encouraging consecutive calls to `dplyr::mutate()` to be combined (part of #884, @MichaelChirico).
 * `if_switch_linter()` for encouraging `switch()` over repeated `if`/`else` tests (part of #884, @MichaelChirico).
 * `nested_pipe_linter()` for discouraging pipes within pipes, e.g. `df1 %>% inner_join(df2 %>% select(a, b))` (part of #884, @MichaelChirico).
-* `nrow_subset_linter()` for discouraging usage like `nrow(subset(x, conditions))` in favor of something like `with(x, sum(conditions))` which doesn't require a full subset of `x` (part of #884, @MichaelChirico).
+* `nrow_subset_linter()` for discouraging usage like `nrow(subset(x, conditions))` in favor of something like `with(x, sum(conditions))` which doesn't require a full subset of `x` (#2314 and part of #884, @MichaelChirico).
 * `pipe_return_linter()` for discouraging usage of `return()` inside a {magrittr} pipeline (part of #884, @MichaelChirico).
 * `one_call_pipe_linter()` for discouraging one-step pipelines like `x |> as.character()` (#2330 and part of #884, @MichaelChirico).
 * `object_overwrite_linter()` for discouraging re-use of upstream package exports as local variables (#2344, #2346 and part of #884, @MichaelChirico and @AshesITR).
@@ -71,6 +76,7 @@
   + ignores calls on the RHS of operators like `lapply(l, function(x) "a" %in% names(x))` (#2310, @MichaelChirico).
 * `vector_logic_linter()` recognizes some cases where bitwise `&`/`|` are used correctly (#1453, @MichaelChirico).
 * `expect_comparison_linter()` ignores faulty usage like `expect_true(x, y > z)` (#2083, @MichaelChirico). Note that `y > z` is being passed to the `info=` argument, so this is likely a mistake.
+* `consecutive_assertion_linter()` ignores cases where a second asssertion follows assignment with `=` (#2444, @MichaelChirico).
 
 ### Lint accuracy fixes: removing false negatives
 

R/any_is_na_linter.R

@@ -36,7 +36,7 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 any_is_na_linter <- function() {
-  xpath <- "
+  any_xpath <- "
   parent::expr
     /following-sibling::expr[1][expr[1][SYMBOL_FUNCTION_CALL[text() = 'is.na']]]
     /parent::expr[
@@ -45,15 +45,28 @@ any_is_na_linter <- function() {
     ]
   "
 
+  in_xpath <- "//SPECIAL[text() = '%in%']/preceding-sibling::expr[NUM_CONST[starts-with(text(), 'NA')]]"
+
   Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
+    xml <- source_expression$xml_parsed_content
     xml_calls <- source_expression$xml_find_function_calls("any")
-    bad_expr <- xml_find_all(xml_calls, xpath)
 
-    xml_nodes_to_lints(
-      bad_expr,
+    any_expr <- xml_find_all(xml_calls, any_xpath)
+    any_lints <- xml_nodes_to_lints(
+      any_expr,
       source_expression = source_expression,
       lint_message = "anyNA(x) is better than any(is.na(x)).",
       type = "warning"
     )
+
+    in_expr <- xml_find_all(xml, in_xpath)
+    in_lints <- xml_nodes_to_lints(
+      in_expr,
+      source_expression = source_expression,
+      lint_message = "anyNA(x) is better than NA %in% x.",
+      type = "warning"
+    )
+
+    c(any_lints, in_lints)
   })
 }

R/brace_linter.R

@@ -74,7 +74,7 @@ brace_linter <- function(allow_single_line = FALSE) {
     )")
   ))
 
-  # TODO (AshesITR): if c_style_braces is TRUE, invert the preceding-sibling condition
+  # TODO(#1103): if c_style_braces is TRUE, invert the preceding-sibling condition
   xp_open_curly <- glue("//OP-LEFT-BRACE[
     { xp_cond_open }
     and (
@@ -109,7 +109,7 @@ brace_linter <- function(allow_single_line = FALSE) {
     )"
   ))
 
-  # TODO (AshesITR): if c_style_braces is TRUE, skip the not(ELSE) condition
+  # TODO(#1103): if c_style_braces is TRUE, skip the not(ELSE) condition
   xp_closed_curly <- glue("//OP-RIGHT-BRACE[
     { xp_cond_closed }
     and (
@@ -121,7 +121,7 @@ brace_linter <- function(allow_single_line = FALSE) {
   xp_else_closed_curly <- "preceding-sibling::IF/following-sibling::expr[2]/OP-RIGHT-BRACE"
   # need to (?) repeat previous_curly_path since != will return true if there is
   #   no such node. ditto for approach with not(@line1 = ...).
-  # TODO (AshesITR): if c_style_braces is TRUE, this needs to be @line2 + 1
+  # TODO(#1103): if c_style_braces is TRUE, this needs to be @line2 + 1
   xp_else_same_line <- glue("//ELSE[{xp_else_closed_curly} and @line1 != {xp_else_closed_curly}/@line2]")
 
   xp_function_brace <- "(//FUNCTION | //OP-LAMBDA)/parent::expr[@line1 != @line2 and not(expr[OP-LEFT-BRACE])]"

R/consecutive_assertion_linter.R

@@ -31,20 +31,23 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 consecutive_assertion_linter <- function() {
-  stopifnot_xpath <- "
+  # annoying expr-but-not-really nodes
+  next_expr <- "following-sibling::*[self::expr or self::expr_or_assign_or_help or self::equal_assign][1]"
+
+  stopifnot_xpath <- glue("
   parent::expr
     /parent::expr[
-      expr[1]/SYMBOL_FUNCTION_CALL = following-sibling::expr[1]/expr[1]/SYMBOL_FUNCTION_CALL
+      expr[1]/SYMBOL_FUNCTION_CALL = {next_expr}/expr[1]/SYMBOL_FUNCTION_CALL
     ]
-  "
-  assert_that_xpath <- "
+  ")
+  assert_that_xpath <- glue("
   parent::expr
     /parent::expr[
       not(SYMBOL_SUB[text() = 'msg'])
       and not(following-sibling::expr[1]/SYMBOL_SUB[text() = 'msg'])
-      and expr[1]/SYMBOL_FUNCTION_CALL = following-sibling::expr[1]/expr[1]/SYMBOL_FUNCTION_CALL
+      and expr[1]/SYMBOL_FUNCTION_CALL = {next_expr}/expr[1]/SYMBOL_FUNCTION_CALL
     ]
-  "
+  ")
 
   Linter(linter_level = "file", function(source_expression) {
     # need the full file to also catch usages at the top level

R/implicit_assignment_linter.R

@@ -102,21 +102,25 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr"
     )
   }
 
+  implicit_message <- paste(
+    "Avoid implicit assignments in function calls.",
+    "For example, instead of `if (x <- 1L) { ... }`, write `x <- 1L; if (x) { ... }`."
+  )
+
+  print_message <- "Call print() explicitly instead of relying on implicit printing behavior via '('."
+
   Linter(linter_level = "file", function(source_expression) {
     # need the full file to also catch usages at the top level
     xml <- source_expression$full_xml_parsed_content
 
     bad_expr <- xml_find_all(xml, xpath)
 
-    lint_message <- paste(
-      "Avoid implicit assignments in function calls.",
-      "For example, instead of `if (x <- 1L) { ... }`, write `x <- 1L; if (x) { ... }`."
-    )
+    print_only <- !is.na(xml_find_first(bad_expr, "parent::expr[parent::exprlist and *[1][self::OP-LEFT-PAREN]]"))
 
     xml_nodes_to_lints(
       bad_expr,
       source_expression = source_expression,
-      lint_message = lint_message,
+      lint_message = ifelse(print_only, print_message, implicit_message),
       type = "warning"
     )
   })

R/lint.R

@@ -24,8 +24,6 @@
 #' @param text Optional argument for supplying a string or lines directly, e.g. if the file is already in memory or
 #'   linting is being done ad hoc.
 #'
-#' @aliases lint_file
-# TODO(next release after 3.0.0): remove the alias
 #' @return An object of class `c("lints", "list")`, each element of which is a `"list"` object.
 #'
 #' @examplesIf requireNamespace("withr", quietly = TRUE)

R/missing_argument_linter.R

@@ -58,7 +58,7 @@ missing_argument_linter <- function(except = c("alist", "quote", "switch"), allo
     named_idx <- xml_name(missing_args) == "EQ_SUB"
     arg_id <- character(length(missing_args))
     arg_id[named_idx] <- sQuote(xml_find_chr(missing_args[named_idx], "string(preceding-sibling::SYMBOL_SUB[1])"), "'")
-    # TODO(r-lib/xml2#412-->CRAN): use xml_find_int() instead
+    # TODO(#2452): use xml_find_int() instead
     arg_id[!named_idx] <- xml_find_num(missing_args[!named_idx], "count(preceding-sibling::OP-COMMA)") + 1.0
 
     xml_nodes_to_lints(

R/nrow_subset_linter.R

@@ -22,19 +22,25 @@
 #'
 #' @evalRd rd_tags("nrow_subset_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
+#' @include shared_constants.R
 #' @export
 nrow_subset_linter <- make_linter_from_function_xpath(
   function_names = "subset",
-  xpath = "
+  xpath = glue("
   parent::expr
     /parent::expr
-    /parent::expr[expr/SYMBOL_FUNCTION_CALL[text() = 'nrow']]
-  ",
+    /parent::expr[
+      expr/SYMBOL_FUNCTION_CALL[text() = 'nrow']
+      or (self::expr | parent::expr)[
+        (PIPE or SPECIAL[{ xp_text_in_table(setdiff(magrittr_pipes, c('%$%', '%<>%'))) }])
+        and expr/expr/SYMBOL_FUNCTION_CALL[text() = 'nrow']
+      ]
+    ]
+  "),
   lint_message = paste(
     "Use arithmetic to count the number of rows satisfying a condition,",
     "rather than fully subsetting the data.frame and counting the resulting rows.",
-    "For example, replace nrow(subset(x, is_treatment))",
-    "with sum(x$is_treatment). NB: use na.rm = TRUE if `is_treatment` has",
-    "missing values."
+    "For example, replace nrow(subset(x, is_treatment)) with sum(x$is_treatment).",
+    "NB: use na.rm = TRUE if `is_treatment` has missing values."
   )
 )

R/object_usage_linter.R

@@ -87,8 +87,6 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) {
         skip_with = skip_with
       )
 
-      # TODO handle assignment functions properly
-      # e.g. `not_existing<-`(a, b)
       res$name <- re_substitutes(res$name, rex("<-"), "")
 
       lintable_symbols <- xml_find_all(fun_assignment, xpath_culprit_symbol)
@@ -211,7 +209,7 @@ parse_check_usage <- function(expression,
   # nocov start
   is_missing <- is.na(res$message)
   if (any(is_missing)) {
-    # TODO (AshesITR): Remove this in the future, if no bugs arise from this safeguard
+    # TODO(AshesITR): Remove this in the future, if no bugs arise from this safeguard
     warning(
       "Possible bug in lintr: Couldn't parse usage message ", sQuote(vals[is_missing][[1L]]), ". ",
       "Ignoring ", sum(is_missing), " usage warnings. Please report an issue at https://github.com/r-lib/lintr/issues.",

R/return_linter.R

@@ -14,10 +14,11 @@
 #'   from base that are always allowed: [stop()], [q()], [quit()], [invokeRestart()],
 #'   `tryInvokeRestart()`, [UseMethod()], [NextMethod()], [standardGeneric()],
 #'   [callNextMethod()], [.C()], [.Call()], [.External()], and [.Fortran()].
-#' @param except Character vector of functions that are not checked when
+#' @param except,except_regex Character vector of functions that are not checked when
 #'   `return_style = "explicit"`. These are in addition to namespace hook functions
 #'   that are never checked: `.onLoad()`, `.onUnload()`, `.onAttach()`, `.onDetach()`,
-#'   `.Last.lib()`, `.First()` and `.Last()`.
+#'   `.Last.lib()`, `.First()` and `.Last()`. `except` matches function names exactly,
+#'   while `except_regex` does exclusion by pattern matching with [rex::re_matches()].
 #'
 #' @examples
 #' # will produce lints
@@ -73,16 +74,25 @@ return_linter <- function(
     return_style = c("implicit", "explicit"),
     allow_implicit_else = TRUE,
     return_functions = NULL,
-    except = NULL) {
+    except = NULL,
+    except_regex = NULL) {
   return_style <- match.arg(return_style)
 
-  if (!allow_implicit_else || return_style == "explicit") {
-    except_xpath <- glue("parent::expr[not(
-      preceding-sibling::expr/SYMBOL[{ xp_text_in_table(union(special_funs, except)) }]
-    )]")
+  check_except <- !allow_implicit_else || return_style == "explicit"
+  # We defer building the XPath strings in this case since we can't build the
+  #   pattern-based "except" logic directly into the XPath (because of v1.0)
+  defer_except <- check_except && !is.null(except_regex)
+
+  if (check_except) {
+    except_xpath_fmt <- "parent::expr[not(
+      preceding-sibling::expr/SYMBOL[{ xp_text_in_table(except) }]
+    )]"
+    except <- union(special_funs, except)
+    if (!defer_except) except_xpath <- glue(except_xpath_fmt, except = except)
   }
 
   if (return_style == "implicit") {
+    # nolint next: object_usage. False positive.
     body_xpath <- "(//FUNCTION | //OP-LAMBDA)/following-sibling::expr[1]"
     params <- list(
       implicit = TRUE,
@@ -91,8 +101,6 @@ return_linter <- function(
       lint_message = "Use implicit return behavior; explicit return() is not needed."
     )
   } else {
-    except <- union(special_funs, except)
-
     base_return_functions <- c(
       # Normal calls
       "return", "stop", "q", "quit",
@@ -110,11 +118,17 @@ return_linter <- function(
 
     return_functions <- union(base_return_functions, return_functions)
 
-    body_xpath <- glue("
+    body_xpath_fmt <- "
     (//FUNCTION | //OP-LAMBDA)[{ except_xpath }]
       /following-sibling::expr[OP-LEFT-BRACE and expr[last()]/@line1 != @line1]
       /expr[last()]
-    ")
+    "
+    if (defer_except) {
+      function_name_xpath <- "(//FUNCTION | //OP-LAMBDA)/parent::expr/preceding-sibling::expr/SYMBOL"
+    } else {
+      body_xpath <- glue(body_xpath_fmt, except_xpath = except_xpath)
+    }
+
     params <- list(
       implicit = FALSE,
       type = "warning",
@@ -130,6 +144,12 @@ return_linter <- function(
 
   Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
+    if (defer_except) {
+      assigned_functions <- xml_text(xml_find_all(xml, function_name_xpath))
+      except <- union(except, assigned_functions[re_matches(assigned_functions, except_regex)])
+      except_xpath <- glue(except_xpath_fmt, except = except)
+      body_xpath <- glue(body_xpath_fmt, except_xpath = except_xpath)
+    }
 
     body_expr <- xml_find_all(xml, body_xpath)
 

R/shared_constants.R

@@ -243,18 +243,7 @@ extract_glued_symbols <- function(expr, interpret_glue) {
   if (!isTRUE(interpret_glue)) {
     return(character())
   }
-  # TODO support more glue functions
-  # Package glue:
-  #  - glue_sql
-  #  - glue_safe
-  #  - glue_col
-  #  - glue_data
-  #  - glue_data_sql
-  #  - glue_data_safe
-  #  - glue_data_col
-  #
-  # Package stringr:
-  #  - str_interp
+  # TODO(#2448): support more glue functions
   # NB: position() > 1 because position=1 is <expr><SYMBOL_FUNCTION_CALL>
   glue_call_xpath <- "
     descendant::SYMBOL_FUNCTION_CALL[text() = 'glue']

R/sort_linter.R

@@ -125,7 +125,11 @@ sort_linter <- function() {
     order_lints <- xml_nodes_to_lints(
       order_expr,
       source_expression = source_expression,
-      lint_message = paste0(new_call, " is better than ", orig_call, "."),
+      lint_message = paste0(
+        new_call, " is better than ", orig_call, ". ",
+        "Note that it's always preferable to save the output of order() for the same variable ",
+        "as a local variable than to re-compute it."
+      ),
       type = "warning"
     )