r-lib · AshesITR · Dec 15, 2023 · Dec 15, 2023 · Dec 15, 2023 · Dec 15, 2023
diff --git a/NEWS.md b/NEWS.md
@@ -38,14 +38,15 @@
 * `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).
+* `Linter()` has a new argument `supports_exprlist` (default `FALSE`). This is used by `lint()` to more efficiently run expression-level linters if they support linting multiple expressions in parallel. Most linters are cacheable on the expression level, but support running for many expressions in parallel. Exprlist linting mode aggregates expressions before calling the linter and causes linting to be roughly 2x faster (#2449, @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).
+* `any_is_na_linter()` is extended to catch the unusual usage `NA %in% x` (#2113, @MichaelChirico). 
 
 ### New linters
 

diff --git a/R/T_and_F_symbol_linter.R b/R/T_and_F_symbol_linter.R
@@ -44,7 +44,7 @@ T_and_F_symbol_linter <- function() { # nolint: object_name.
 
   replacement_map <- c(T = "TRUE", F = "FALSE")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_usage <- xml_find_all(xml, usage_xpath)

diff --git a/R/any_duplicated_linter.R b/R/any_duplicated_linter.R
@@ -84,7 +84,7 @@ any_duplicated_linter <- function() {
 
   uses_nrow_xpath <- "./parent::expr/expr/expr[1]/SYMBOL_FUNCTION_CALL[text() = 'nrow']"
 
-  Linter(linter_level = "expression", function(source_expression) {
+  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")
 

diff --git a/R/any_is_na_linter.R b/R/any_is_na_linter.R
@@ -47,7 +47,7 @@ any_is_na_linter <- function() {
 
   in_xpath <- "//SPECIAL[text() = '%in%']/preceding-sibling::expr[NUM_CONST[starts-with(text(), 'NA')]]"
 
-  Linter(linter_level = "expression", function(source_expression) {
+  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")
 

diff --git a/R/assignment_linter.R b/R/assignment_linter.R
@@ -99,7 +99,7 @@ assignment_linter <- function(allow_cascading_assign = TRUE,
     if (!allow_pipe_assign) "//SPECIAL[text() = '%<>%']"
   ))
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml_find_all(xml, xpath)

diff --git a/R/backport_linter.R b/R/backport_linter.R
@@ -45,7 +45,7 @@ backport_linter <- function(r_version = getRversion(), except = character()) {
   backport_index <- rep(names(backport_blacklist), times = lengths(backport_blacklist))
   names(backport_index) <- unlist(backport_blacklist)
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     used_symbols <- xml_find_all(xml, "//SYMBOL")

diff --git a/R/boolean_arithmetic_linter.R b/R/boolean_arithmetic_linter.R
@@ -52,7 +52,7 @@ boolean_arithmetic_linter <- function() {
     ]
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     length_calls <- source_expression$xml_find_function_calls(c("which", "grep"))
     sum_calls <- source_expression$xml_find_function_calls("sum")
     any_expr <- c(

diff --git a/R/brace_linter.R b/R/brace_linter.R
@@ -146,7 +146,7 @@ brace_linter <- function(allow_single_line = FALSE) {
   ]
   "
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     lints <- list()

diff --git a/R/class_equals_linter.R b/R/class_equals_linter.R
@@ -43,7 +43,7 @@ class_equals_linter <- function() {
     ]
   "
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls("class")
     bad_expr <- xml_find_all(xml_calls, xpath)
 

diff --git a/R/commas_linter.R b/R/commas_linter.R
@@ -77,7 +77,7 @@ commas_linter <- function(allow_trailing = FALSE) {
     "]"
   )
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     before_lints <- xml_nodes_to_lints(

diff --git a/R/comparison_negation_linter.R b/R/comparison_negation_linter.R
@@ -60,7 +60,7 @@ comparison_negation_linter <- function() {
     ]
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml_find_all(xml, xpath)

diff --git a/R/condition_call_linter.R b/R/condition_call_linter.R
@@ -79,7 +79,7 @@ condition_call_linter <- function(display_call = FALSE) {
 
   xpath <- glue::glue("parent::expr[{call_cond}]/parent::expr")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls(c("stop", "warning"))
     bad_expr <- xml_find_all(xml_calls, xpath)
 

diff --git a/R/condition_message_linter.R b/R/condition_message_linter.R
@@ -55,7 +55,7 @@ condition_message_linter <- function() {
     /parent::expr
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls(translators)
     bad_expr <- xml_find_all(xml_calls, xpath)
     sep_value <- get_r_string(bad_expr, xpath = "./expr/SYMBOL_SUB[text() = 'sep']/following-sibling::expr/STR_CONST")

diff --git a/R/equals_na_linter.R b/R/equals_na_linter.R
@@ -46,7 +46,7 @@ equals_na_linter <- function() {
     /parent::expr
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml_find_all(xml, xpath)

diff --git a/R/expect_comparison_linter.R b/R/expect_comparison_linter.R
@@ -62,7 +62,7 @@ expect_comparison_linter <- function() {
     `==` = "expect_identical"
   )
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls("expect_true")
     bad_expr <- xml_find_all(xml_calls, xpath)
 

diff --git a/R/expect_identical_linter.R b/R/expect_identical_linter.R
@@ -77,7 +77,7 @@ expect_identical_linter <- function() {
     /following-sibling::expr[1][expr[1]/SYMBOL_FUNCTION_CALL[text() = 'identical']]
     /parent::expr
   "
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     expect_equal_calls <- source_expression$xml_find_function_calls("expect_equal")
     expect_true_calls <- source_expression$xml_find_function_calls("expect_true")
     bad_expr <- c(

diff --git a/R/expect_length_linter.R b/R/expect_length_linter.R
@@ -31,7 +31,7 @@ expect_length_linter <- function() {
     /parent::expr[not(SYMBOL_SUB[text() = 'info' or contains(text(), 'label')])]
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls(c("expect_equal", "expect_identical"))
     bad_expr <- xml_find_all(xml_calls, xpath)
 

diff --git a/R/expect_named_linter.R b/R/expect_named_linter.R
@@ -40,7 +40,7 @@ expect_named_linter <- function() {
     /parent::expr
   "
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls(c("expect_equal", "expect_identical"))
     bad_expr <- xml_find_all(xml_calls, xpath)
     matched_function <- xp_call_name(bad_expr)

diff --git a/R/expect_null_linter.R b/R/expect_null_linter.R
@@ -50,7 +50,7 @@ expect_null_linter <- function() {
     /parent::expr
   "
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     expect_equal_identical_calls <- source_expression$xml_find_function_calls(c("expect_equal", "expect_identical"))
     expect_true_calls <- source_expression$xml_find_function_calls("expect_true")
 

diff --git a/R/expect_s3_class_linter.R b/R/expect_s3_class_linter.R
@@ -66,7 +66,7 @@ expect_s3_class_linter <- function() {
     /parent::expr[not(SYMBOL_SUB[text() = 'info' or text() = 'label'])]
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     expect_equal_identical_calls <- source_expression$xml_find_function_calls(c("expect_equal", "expect_identical"))
     expect_true_calls <- source_expression$xml_find_function_calls("expect_true")
 

diff --git a/R/expect_s4_class_linter.R b/R/expect_s4_class_linter.R
@@ -31,7 +31,7 @@ expect_s4_class_linter <- function() {
     /parent::expr[not(SYMBOL_SUB[text() = 'info' or text() = 'label'])]
   "
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     # TODO(#2423): also catch expect_{equal,identical}(methods::is(x), k).
     #   this seems empirically rare, but didn't check many S4-heavy packages.
 

diff --git a/R/expect_true_false_linter.R b/R/expect_true_false_linter.R
@@ -38,7 +38,7 @@ expect_true_false_linter <- function() {
     /parent::expr
   "
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls(c("expect_equal", "expect_identical"))
     bad_expr <- xml_find_all(xml_calls, xpath)
 

diff --git a/R/expect_type_linter.R b/R/expect_type_linter.R
@@ -56,7 +56,7 @@ expect_type_linter <- function() {
     /parent::expr[not(SYMBOL_SUB[text() = 'info' or text() = 'label'])]
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     expect_equal_identical_calls <- source_expression$xml_find_function_calls(c("expect_equal", "expect_identical"))
     expect_true_calls <- source_expression$xml_find_function_calls("expect_true")
     bad_expr <- combine_nodesets(

diff --git a/R/fixed_regex_linter.R b/R/fixed_regex_linter.R
@@ -138,7 +138,7 @@ fixed_regex_linter <- function(allow_unescaped = FALSE) {
     ]
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     pos_1_calls <- source_expression$xml_find_function_calls(pos_1_regex_funs)
     pos_2_calls <- source_expression$xml_find_function_calls(pos_2_regex_funs)
     patterns <- combine_nodesets(

diff --git a/R/function_argument_linter.R b/R/function_argument_linter.R
@@ -59,7 +59,7 @@ function_argument_linter <- function() {
     text() = following-sibling::expr[last()]//expr[expr/SYMBOL_FUNCTION_CALL[text() = 'missing']]/expr[2]/SYMBOL/text()
   "
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml_find_all(xml, xpath)

diff --git a/R/function_left_parentheses_linter.R b/R/function_left_parentheses_linter.R
@@ -57,7 +57,7 @@ function_left_parentheses_linter <- function() { # nolint: object_length.
     and @col2 != parent::expr/following-sibling::OP-LEFT-PAREN/@col1 - 1
   ]"
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_line_fun_exprs <- xml_find_all(xml, bad_line_fun_xpath)

diff --git a/R/if_not_else_linter.R b/R/if_not_else_linter.R
@@ -82,7 +82,7 @@ if_not_else_linter <- function(exceptions = c("is.null", "is.na", "missing")) {
     ]]
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
     ifelse_calls <- source_expression$xml_find_function_calls(ifelse_funs)
 

diff --git a/R/if_switch_linter.R b/R/if_switch_linter.R
@@ -61,7 +61,7 @@ if_switch_linter <- function() {
     ]
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml_find_all(xml, xpath)

diff --git a/R/ifelse_censor_linter.R b/R/ifelse_censor_linter.R
@@ -45,7 +45,7 @@ ifelse_censor_linter <- function() {
     /parent::expr
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     ifelse_calls <- source_expression$xml_find_function_calls(ifelse_funs)
     bad_expr <- xml_find_all(ifelse_calls, xpath)
 

diff --git a/R/infix_spaces_linter.R b/R/infix_spaces_linter.R
@@ -105,7 +105,7 @@ infix_spaces_linter <- function(exclude_operators = NULL, allow_multiple_spaces
     )
   ]")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml_find_all(xml, xpath)

diff --git a/R/inner_combine_linter.R b/R/inner_combine_linter.R
@@ -82,7 +82,7 @@ inner_combine_linter <- function() {
     /parent::expr
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls("c")
     bad_expr <- xml_find_all(xml_calls, xpath)
 

diff --git a/R/is_lint_level.R b/R/is_lint_level.R
@@ -43,3 +43,16 @@ is_linter_level <- function(linter, level = c("expression", "file")) {
   level <- match.arg(level)
   identical(linter_level, level)
 }
+
+#' Determine whether an expression-level linter can handle multiple expressions at once
+#'
+#' Used by [lint()] to efficiently batch calls to expression-level linters.
+#'
+#' @param linter A linter.
+#'
+#' @keywords internal
+#' @noRd
+linter_supports_exprlist <- function(linter) {
+  linter_exprlist <- attr(linter, "linter_exprlist", exact = TRUE)
+  isTRUE(linter_exprlist)
+}
diff --git a/R/is_numeric_linter.R b/R/is_numeric_linter.R
@@ -69,7 +69,7 @@ is_numeric_linter <- function() {
     /parent::expr
   "
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     or_expr <- xml_find_all(xml, or_xpath)

diff --git a/R/keyword_quote_linter.R b/R/keyword_quote_linter.R
@@ -93,7 +93,7 @@ keyword_quote_linter <- function() {
   no_quote_msg <- "Use backticks to create non-syntactic names, not quotes."
   clarification <- "i.e., if the name is not a valid R symbol (see ?make.names)."
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml <- source_expression$xml_parsed_content
     xml_calls <- source_expression$xml_find_function_calls(NULL)
 

diff --git a/R/length_test_linter.R b/R/length_test_linter.R
@@ -26,7 +26,7 @@ length_test_linter <- function() {
     /parent::expr
   ")
 
-  Linter(linter_level = "expression", function(source_expression) {
+  Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) {
     xml_calls <- source_expression$xml_find_function_calls("length")
     bad_expr <- xml_find_all(xml_calls, xpath)