diff --git a/NEWS.md b/NEWS.md index 830f8be46a..c9533bcd56 100644 --- a/NEWS.md +++ b/NEWS.md @@ -38,6 +38,7 @@ * `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). @@ -45,7 +46,7 @@ * 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 index b6c1300c7c..4879a97589 100644 --- 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 index 04a80bd84c..bc43a6055b 100644 --- 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 index 5aa1a0cad7..cfbc5d3b09 100644 --- 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 index da42b51194..fafc89cae9 100644 --- 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 index 3c1eaeaebf..83590ed013 100644 --- 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 index c0d0c755c1..e29cc8c750 100644 --- 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 index 7eda5a7146..bfae47ea03 100644 --- 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 index 2dd24b83dd..a9656269b5 100644 --- 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 index aeaf42878c..cfd3946fe6 100644 --- 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 index f2c3424abb..7f8116d13d 100644 --- 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 index 8b13c8a921..bd777d12a1 100644 --- 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 index e20e53b4b1..baa9142405 100644 --- 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 index 2961ac9845..0c05f65a6b 100644 --- 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 index 87dc24169a..af15a9893f 100644 --- 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 index 4ca6bf04a3..e476e43842 100644 --- 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 index 880a66357d..c5b21a54b3 100644 --- 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 index 26d83ceb26..4339bd6d4c 100644 --- 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 index 10b15ff38b..e5e8d6597e 100644 --- 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 index 7389b2abc2..9866974430 100644 --- 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 index 61e839a97b..6e8e76653f 100644 --- 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 index c20eb393eb..dad7637c8c 100644 --- 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 index 6d669ed0bd..a9687756ae 100644 --- 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 index d3a02fc503..0569232ac0 100644 --- 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 index 921e002b22..ac00a99692 100644 --- 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 index 07e4ee4382..0a039840a1 100644 --- 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 index 758ba2102f..baef7a10a7 100644 --- 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 index 97b985dac9..da48ccb1fe 100644 --- 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 index c43d390e20..9b5b916209 100644 --- 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 index c7fa7bb1be..5f125bd312 100644 --- 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 index abba413daa..790835cf0e 100644 --- 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 index d850c51cf0..422fded838 100644 --- 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 index 7acc08a3eb..2f0a60d08f 100644 --- 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 index f5f52542c6..54800252d8 100644 --- 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 index ca163ea9a7..620d8c1d0a 100644 --- 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) diff --git a/R/lint.R b/R/lint.R index 541006dd7f..5c2799abc4 100644 --- a/R/lint.R +++ b/R/lint.R @@ -72,23 +72,30 @@ lint <- function(filename, linters = NULL, ..., cache = FALSE, parse_settings = expression_linter_names <- names(linters)[vapply(linters, is_linter_level, logical(1L), "expression")] lints <- list() - if (!is_tainted(source_expressions$lines)) { - for (expr in source_expressions$expressions) { - if (is_lint_level(expr, "expression")) { - necessary_linters <- expression_linter_names - } else { - necessary_linters <- file_linter_names - } - for (linter in necessary_linters) { - # use withCallingHandlers for friendlier failures on unexpected linter errors - lints[[length(lints) + 1L]] <- withCallingHandlers( - get_lints(expr, linter, linters[[linter]], lint_cache, source_expressions$lines), - error = function(cond) { - stop("Linter '", linter, "' failed in ", filename, ": ", conditionMessage(cond), call. = FALSE) - } - ) - } - } + if (!is_tainted(source_expressions$lines) && length(source_expressions$expressions) > 0L) { + exprs_expression <- head(source_expressions$expressions, -1L) + expr_file <- source_expressions$expressions[[length(source_expressions$expressions)]] + + lints <- handle_file_level_lints( + lints = lints, + file_linter_names = file_linter_names, + expr_file = expr_file, + lint_cache = lint_cache, + linters = linters, + lines = source_expressions$lines, + filename = filename + ) + + lints <- handle_expr_level_lints( + lints = lints, + expression_linter_names = expression_linter_names, + exprs_expression = exprs_expression, + expr_file = expr_file, + lint_cache = lint_cache, + linters = linters, + lines = source_expressions$lines, + filename = filename + ) } lints <- maybe_append_error_lint(lints, source_expressions$error, lint_cache, filename) @@ -277,34 +284,85 @@ lint_package <- function(path = ".", ..., lints } -#' Run a linter on a source expression, optionally using a cache +#' @name get_lints +#' @title Run a linter on a source expression, optionally using a cache #' #' @param expr A source expression. -#' @param linter Name of the linter. +#' @param exprs_to_lint A list of source expressions. +#' @param linter_name Name of the linter. #' @param linter_fun Closure of the linter. #' @param lint_cache Cache environment, or `NULL` if caching is disabled. #' -#' @return A list of lints generated by the linter on `expr`. +#' @return A list of lints generated by the linter on `expr` or all expressions in `exprs_to_lint`. #' #' @noRd -get_lints <- function(expr, linter, linter_fun, lint_cache, lines) { - expr_lints <- NULL - if (has_lint(lint_cache, expr, linter)) { - # retrieve_lint() might return NULL if missing line number is encountered. - # It could be caused by nolint comments. - expr_lints <- retrieve_lint(lint_cache, expr, linter, lines) - } +get_lints_single <- function(expr, linter_name, linter_fun, lint_cache, filename) { + withCallingHandlers( + { + expr_lints <- flatten_lints(linter_fun(expr)) - if (is.null(expr_lints)) { - expr_lints <- flatten_lints(linter_fun(expr)) + for (i in seq_along(expr_lints)) { + expr_lints[[i]]$linter <- linter_name + } + + cache_lint(lint_cache, expr, linter_name, expr_lints) - for (i in seq_along(expr_lints)) { - expr_lints[[i]]$linter <- linter + expr_lints + }, + error = function(cond) { + stop("Linter '", linter_name, "' failed in ", filename, ": ", conditionMessage(cond), call. = FALSE) } + ) +} - cache_lint(lint_cache, expr, linter, expr_lints) - } - expr_lints +#' @rdname get_lints +#' @noRd +get_lints_batched <- function(exprs_to_lint, exprlist_to_lint, linter_name, linter_fun, lint_cache, filename) { + withCallingHandlers( + { + # run on exprlist + expr_lints <- flatten_lints(linter_fun(exprlist_to_lint)) + + lines_to_cache <- vector(mode = "list", length(exprs_to_lint)) + for (i in seq_along(expr_lints)) { + expr_lints[[i]]$linter <- linter_name + + # Store in cache index if possible (i.e. line number is unique for expr) + curr_expr_index <- exprlist_to_lint$expr_index[as.character(expr_lints[[i]]$line)] + if (!is.na(curr_expr_index)) { + if (is.null(lines_to_cache[[curr_expr_index]])) { + lines_to_cache[[curr_expr_index]] <- list(expr_lints[[i]]) + } else { + lines_to_cache[[curr_expr_index]][[length(lines_to_cache[[curr_expr_index]]) + 1L]] <- expr_lints[[i]] + } + } + } + + # write results to expr-level cache + for (i in seq_along(lines_to_cache)) { + if (!is.null(lines_to_cache[[i]])) { + cache_lint(lint_cache, exprs_to_lint[[i]], linter_name, lines_to_cache[[i]]) + } + } + + expr_lints + }, + error = function(cond) { + stop("Linter '", linter_name, "' failed in ", filename, ": ", conditionMessage(cond), call. = FALSE) + } + ) +} + +#' @rdname get_lints +#' @noRd +get_lints_sequential <- function(exprs_to_lint, linter_name, linter_fun, lint_cache, filename) { + lapply( + exprs_to_lint, get_lints_single, + linter_name = linter_name, + linter_fun = linter_fun, + lint_cache = lint_cache, + filename = filename + ) } define_linters <- function(linters = NULL) { @@ -706,3 +764,152 @@ zap_temp_filename <- function(res, needs_tempfile) { } res } + +#' Collapse a list of expression-level source expressions to an exprlist-level source expression +#' +#' @param expr_list A list containing expression-level source expressions +#' +#' @return An exprlist-level source expression +#' +#' @keywords internal +#' @noRd +collapse_exprs <- function(expr_list, expr_file) { + if (length(expr_list) == 0L) { + return(list()) + } + if (!missing(expr_file)) { + xml_pc <- expr_file$full_xml_parsed_content + parsed_content <- expr_file$full_parsed_content + xml_find_function_calls <- expr_file$xml_find_function_calls + lines <- expr_file$file_lines + } else { + xml_pc <- xml2::xml_new_root("exprlist") + + for (expr in rev(expr_list)) { + # prepending is _much_ faster than appending, because it avoids a call to xml_children(). + xml2::xml_add_child(xml_pc, expr$xml_parsed_content, .where = 0L) + } + + parsed_content <- do.call(rbind, lapply(expr_list, function(expr) expr$parsed_content)) + + function_call_cache <- do.call( + combine_nodesets, + lapply(expr_list, function(expr) expr$xml_find_function_calls(NULL, keep_names = TRUE)) + ) + xml_find_function_calls <- build_xml_find_function_calls(xml_pc, cache = function_call_cache) + + lines <- do.call(c, lapply(expr_list, function(expr) expr$lines)) + } + + filename <- expr_list[[1L]]$filename + content <- paste(vapply(expr_list, function(expr) expr$content, character(1L)), collapse = "\n") + expr_index <- integer() + i <- 0L + for (expr in expr_list) { + i <- i + 1L + curr_lines <- names(expr$lines) + # line is not unique to this expr => can't find the expr to cache for from exprlist lints landing on this line + expr_index[intersect(curr_lines, names(expr_index))] <- NA_integer_ + expr_index[setdiff(curr_lines, names(expr_index))] <- i + } + + list( + filename = filename, + lines = lines, + parsed_content = parsed_content, + xml_parsed_content = xml_pc, + xml_find_function_calls = xml_find_function_calls, + content = content, + expr_index = expr_index + ) +} + +handle_file_level_lints <- function(lints, file_linter_names, expr_file, lint_cache, linters, lines, filename) { + # Compute execution plan + file_linter_cached <- vapply( + file_linter_names, has_lint, + expr = expr_file, + cache = lint_cache, + FUN.VALUE = logical(1L) + ) + # Retrieve cached lints where available + for (linter_name in file_linter_names[file_linter_cached]) { + lints[[length(lints) + 1L]] <- retrieve_lint( + cache = lint_cache, + expr = expr_file, + linter = linter_name, + lines = lines + ) + } + # Compute file-level lints where cache missed + for (linter_name in file_linter_names[!file_linter_cached]) { + linter_fun <- linters[[linter_name]] + lints[[length(lints) + 1L]] <- get_lints_single( + expr = expr_file, + linter_name = linter_name, + linter_fun = linter_fun, + lint_cache = lint_cache, + filename = filename + ) + } + + lints +} + +handle_expr_level_lints <- function(lints, expression_linter_names, supports_exprlist, exprs_expression, expr_file, + lint_cache, linters, lines, filename) { + + supports_exprlist <- vapply(linters[expression_linter_names], linter_supports_exprlist, logical(1L)) + + # For expression level linters, each column is a linter, each row an expr + expr_linter_cached <- vapply(expression_linter_names, function(linter_name) { + vapply(exprs_expression, has_lint, linter = linter_name, cache = lint_cache, FUN.VALUE = logical(1L)) + }, FUN.VALUE = logical(length(exprs_expression))) + + # Ensure 2D array even for just a single expr or linter + dim(expr_linter_cached) <- c(length(exprs_expression), length(expression_linter_names)) + colnames(expr_linter_cached) <- expression_linter_names + + # Retrieve cached lints where available + for (linter_name in expression_linter_names[colSums(expr_linter_cached) > 0L]) { + lints[[length(lints) + 1L]] <- lapply(exprs_expression[expr_linter_cached[, linter_name]], function(expr) { + retrieve_lint(cache = lint_cache, expr = expr, linter = linter_name, lines = lines) + }) + } + + # Compute individual expr-lints where exprlist batching is not supported + needs_running <- colSums(expr_linter_cached) < length(exprs_expression) + for (linter_name in expression_linter_names[needs_running & !supports_exprlist]) { + linter_fun <- linters[[linter_name]] + exprs_to_lint <- exprs_expression[!expr_linter_cached[, linter_name]] + lints[[length(lints) + 1L]] <- get_lints_sequential( + exprs_to_lint = exprs_to_lint, + linter_name = linter_name, + linter_fun = linter_fun, + lint_cache = lint_cache, + filename = filename + ) + } + + # Compute exprlist expr-lints where exprlist batching is supported + for (linter_name in expression_linter_names[needs_running & supports_exprlist]) { + linter_fun <- linters[[linter_name]] + if (any(expr_linter_cached[, linter_name])) { + exprs_to_lint <- exprs_expression[!expr_linter_cached[, linter_name]] + exprlist_to_lint <- collapse_exprs(exprs_to_lint) + } else { + exprs_to_lint <- exprs_expression + exprlist_to_lint <- collapse_exprs(exprs_to_lint, expr_file = expr_file) + } + lints[[length(lints) + 1L]] <- get_lints_batched( + exprs_to_lint = exprs_to_lint, + exprlist_to_lint = exprlist_to_lint, + linter_name = linter_name, + linter_fun = linter_fun, + lint_cache = lint_cache, + filename = filename + ) + } + + lints +} diff --git a/R/lintr-deprecated.R b/R/lintr-deprecated.R index 549109f2cb..8969caa81a 100644 --- a/R/lintr-deprecated.R +++ b/R/lintr-deprecated.R @@ -147,7 +147,7 @@ extraction_operator_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_exprs <- xml_find_all(xml, xpath) diff --git a/R/list_comparison_linter.R b/R/list_comparison_linter.R index 8303ff80bf..5bea81249c 100644 --- a/R/list_comparison_linter.R +++ b/R/list_comparison_linter.R @@ -38,7 +38,7 @@ list_comparison_linter <- function() { /parent::expr[{ xp_or(infix_metadata$xml_tag[infix_metadata$comparator]) }] ") - 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(names(list_mapper_alternatives)) bad_expr <- xml_find_all(xml_calls, xpath) diff --git a/R/literal_coercion_linter.R b/R/literal_coercion_linter.R index a64e6b4260..2341f5c0fd 100644 --- a/R/literal_coercion_linter.R +++ b/R/literal_coercion_linter.R @@ -72,7 +72,7 @@ literal_coercion_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(coercers) bad_expr <- xml_find_all(xml_calls, xpath) diff --git a/R/matrix_apply_linter.R b/R/matrix_apply_linter.R index fc12ab3684..c394031bdf 100644 --- a/R/matrix_apply_linter.R +++ b/R/matrix_apply_linter.R @@ -74,7 +74,7 @@ matrix_apply_linter <- function() { margin_xpath <- "expr[position() = 3]" fun_xpath <- "expr[position() = 4]" - 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("apply") bad_expr <- xml_find_all(xml_calls, xpath) diff --git a/R/nested_ifelse_linter.R b/R/nested_ifelse_linter.R index 6441896c57..f5b1d4bf59 100644 --- a/R/nested_ifelse_linter.R +++ b/R/nested_ifelse_linter.R @@ -85,7 +85,7 @@ nested_ifelse_linter <- function() { /following-sibling::expr[expr[1][SYMBOL_FUNCTION_CALL[ {xp_text_in_table(ifelse_funs)} ]]] ") - 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(ifelse_funs) bad_expr <- xml_find_all(xml_calls, xpath) diff --git a/R/nested_pipe_linter.R b/R/nested_pipe_linter.R index fd595b2339..63afb4595e 100644 --- a/R/nested_pipe_linter.R +++ b/R/nested_pipe_linter.R @@ -67,7 +67,7 @@ nested_pipe_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/nzchar_linter.R b/R/nzchar_linter.R index e9f0dadb57..353c69377f 100644 --- a/R/nzchar_linter.R +++ b/R/nzchar_linter.R @@ -126,7 +126,7 @@ nzchar_linter <- function() { op } - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content comparison_expr <- xml_find_all(xml, comparison_xpath) diff --git a/R/object_overwrite_linter.R b/R/object_overwrite_linter.R index 6c2eaa27d1..3a909ca54c 100644 --- a/R/object_overwrite_linter.R +++ b/R/object_overwrite_linter.R @@ -93,7 +93,7 @@ object_overwrite_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 assigned_exprs <- xml_find_all(xml, xpath_assignments) diff --git a/R/one_call_pipe_linter.R b/R/one_call_pipe_linter.R index b11e3a7b72..9e324ba9b5 100644 --- a/R/one_call_pipe_linter.R +++ b/R/one_call_pipe_linter.R @@ -65,7 +65,7 @@ one_call_pipe_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/outer_negation_linter.R b/R/outer_negation_linter.R index f9f5a67157..2620200720 100644 --- a/R/outer_negation_linter.R +++ b/R/outer_negation_linter.R @@ -49,7 +49,7 @@ outer_negation_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(c("any", "all")) bad_expr <- xml_find_all(xml_calls, xpath) diff --git a/R/paste_linter.R b/R/paste_linter.R index cd054a0683..ca36bd8570 100644 --- a/R/paste_linter.R +++ b/R/paste_linter.R @@ -157,7 +157,7 @@ paste_linter <- function(allow_empty_sep = FALSE, empty_paste_note <- 'Note that paste() converts empty inputs to "", whereas file.path() leaves it empty.' - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { paste_calls <- source_expression$xml_find_function_calls("paste") paste0_calls <- source_expression$xml_find_function_calls("paste0") both_calls <- combine_nodesets(paste_calls, paste0_calls) diff --git a/R/path_utils.R b/R/path_utils.R index d9c47a99cc..8ea69dceb7 100644 --- a/R/path_utils.R +++ b/R/path_utils.R @@ -136,7 +136,7 @@ split_path <- function(dirs, prefix) { #' @include utils.R path_linter_factory <- function(path_function, message, linter, name = linter_auto_name()) { force(name) - Linter(name = name, linter_level = "expression", function(source_expression) { + Linter(name = name, linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { lapply( ids_with_token(source_expression, "STR_CONST"), function(id) { diff --git a/R/pipe_call_linter.R b/R/pipe_call_linter.R index e0b55279ea..64d55e6f7e 100644 --- a/R/pipe_call_linter.R +++ b/R/pipe_call_linter.R @@ -26,7 +26,7 @@ pipe_call_linter <- function() { pipes <- setdiff(magrittr_pipes, "%$%") xpath <- glue("//SPECIAL[{ xp_text_in_table(pipes) }]/following-sibling::expr[*[1][self::SYMBOL]]") - 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/quotes_linter.R b/R/quotes_linter.R index 10099463ea..d2ef00edb9 100644 --- a/R/quotes_linter.R +++ b/R/quotes_linter.R @@ -60,7 +60,7 @@ quotes_linter <- function(delimiter = c('"', "'")) { lint_message <- "Only use single-quotes." } - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content string_exprs <- xml_find_all(xml, "//STR_CONST") diff --git a/R/redundant_equals_linter.R b/R/redundant_equals_linter.R index 48d524c5b9..2ba397eaa1 100644 --- a/R/redundant_equals_linter.R +++ b/R/redundant_equals_linter.R @@ -43,7 +43,7 @@ redundant_equals_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/redundant_ifelse_linter.R b/R/redundant_ifelse_linter.R index 4c01a3d32e..385adf70da 100644 --- a/R/redundant_ifelse_linter.R +++ b/R/redundant_ifelse_linter.R @@ -68,7 +68,7 @@ redundant_ifelse_linter <- function(allow10 = FALSE) { ] ") - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml_targets <- source_expression$xml_find_function_calls(ifelse_funs) lints <- list() diff --git a/R/regex_subset_linter.R b/R/regex_subset_linter.R index 33a9fd8d69..9120d1d06a 100644 --- a/R/regex_subset_linter.R +++ b/R/regex_subset_linter.R @@ -66,7 +66,7 @@ regex_subset_linter <- function() { grep_xpath <- glue(xpath_fmt, arg_pos = 3L) stringr_xpath <- glue(xpath_fmt, arg_pos = 2L) - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { grep_calls <- source_expression$xml_find_function_calls(c("grepl", "grep")) grep_expr <- xml_find_all(grep_calls, grep_xpath) diff --git a/R/repeat_linter.R b/R/repeat_linter.R index 877ff0da7a..325fc6fe9f 100644 --- a/R/repeat_linter.R +++ b/R/repeat_linter.R @@ -22,7 +22,7 @@ repeat_linter <- function() { xpath <- "//WHILE[following-sibling::expr[1]/NUM_CONST[text() = 'TRUE']]" - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content lints <- xml_find_all(xml, xpath) diff --git a/R/return_linter.R b/R/return_linter.R index fd3dd58315..24f1f89c06 100644 --- a/R/return_linter.R +++ b/R/return_linter.R @@ -142,7 +142,7 @@ return_linter <- function( params$allow_implicit_else <- allow_implicit_else - Linter(linter_level = "expression", function(source_expression) { + 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)) diff --git a/R/sample_int_linter.R b/R/sample_int_linter.R index dfdee8d0ee..fe8ec4609e 100644 --- a/R/sample_int_linter.R +++ b/R/sample_int_linter.R @@ -64,7 +64,7 @@ sample_int_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("sample") bad_expr <- xml_find_all(xml_calls, xpath) diff --git a/R/scalar_in_linter.R b/R/scalar_in_linter.R index 77ca702854..92882f78e8 100644 --- a/R/scalar_in_linter.R +++ b/R/scalar_in_linter.R @@ -37,7 +37,7 @@ scalar_in_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/seq_linter.R b/R/seq_linter.R index decc02c667..0cef1897fc 100644 --- a/R/seq_linter.R +++ b/R/seq_linter.R @@ -83,7 +83,7 @@ seq_linter <- function() { fun } - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content seq_calls <- source_expression$xml_find_function_calls("seq") diff --git a/R/sort_linter.R b/R/sort_linter.R index d4709370d7..4e4b3cae8a 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -97,7 +97,7 @@ sort_linter <- function() { arg_values_xpath <- glue("{arguments_xpath}/following-sibling::expr[1]") - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content order_expr <- xml_find_all(xml, order_xpath) diff --git a/R/source_utils.R b/R/source_utils.R index 3179847afd..cfef05527f 100644 --- a/R/source_utils.R +++ b/R/source_utils.R @@ -1,6 +1,7 @@ #' Build the `xml_find_function_calls()` helper for a source expression #' #' @param xml The XML parse tree as an XML object (`xml_parsed_content` or `full_xml_parsed_content`) +#' @param cache Optional precomputed call cache. If present, no XPath queries will be run. #' #' @return A fast function to query #' `xml_find_all(xml, glue::glue("//SYMBOL_FUNCTION_CALL[text() = '{function_names[1]}' or ...]"))`, @@ -8,9 +9,13 @@ #' `xml_find_all(xml, glue::glue("//SYMBOL_FUNCTION_CALL[{ xp_text_in_table(function_names) }]"))`. #' #' @noRd -build_xml_find_function_calls <- function(xml) { - function_call_cache <- xml_find_all(xml, "//SYMBOL_FUNCTION_CALL") - names(function_call_cache) <- get_r_string(function_call_cache) +build_xml_find_function_calls <- function(xml, cache = NULL) { + if (is.null(cache)) { + function_call_cache <- xml_find_all(xml, "//SYMBOL_FUNCTION_CALL") + names(function_call_cache) <- get_r_string(function_call_cache) + } else { + function_call_cache <- cache + } function(function_names, keep_names = FALSE) { if (is.null(function_names)) { diff --git a/R/string_boundary_linter.R b/R/string_boundary_linter.R index fe3727b9e1..8f59556355 100644 --- a/R/string_boundary_linter.R +++ b/R/string_boundary_linter.R @@ -139,7 +139,7 @@ string_boundary_linter <- function(allow_grepl = FALSE) { substr_arg2_xpath <- "string(./expr[expr[1][SYMBOL_FUNCTION_CALL]]/expr[3])" - 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/system_file_linter.R b/R/system_file_linter.R index 24fba540ed..ca947e1d81 100644 --- a/R/system_file_linter.R +++ b/R/system_file_linter.R @@ -35,7 +35,7 @@ system_file_linter <- function() { /parent::expr " - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { file_path_calls <- source_expression$xml_find_function_calls("file.path") system_file_calls <- source_expression$xml_find_function_calls("system.file") diff --git a/R/todo_comment_linter.R b/R/todo_comment_linter.R index 16e1de05f2..fa8fc44e1d 100644 --- a/R/todo_comment_linter.R +++ b/R/todo_comment_linter.R @@ -52,7 +52,7 @@ todo_comment_linter <- function(todo = c("todo", "fixme"), except_regex = NULL) valid_todo_regex <- if (!is.null(except_regex)) paste0("#+", rex::shortcuts$any_spaces, "(?:", paste(except_regex, collapse = "|"), ")") - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content comment_expr <- xml_find_all(xml, "//COMMENT") diff --git a/R/undesirable_function_linter.R b/R/undesirable_function_linter.R index 762ecda5df..9706e77497 100644 --- a/R/undesirable_function_linter.R +++ b/R/undesirable_function_linter.R @@ -79,7 +79,7 @@ undesirable_function_linter <- function(fun = default_undesirable_functions, } xpath <- glue("self::SYMBOL_FUNCTION_CALL[{xp_condition}]") - 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(names(fun)) diff --git a/R/undesirable_operator_linter.R b/R/undesirable_operator_linter.R index 734e6c4856..6c5d5b10bf 100644 --- a/R/undesirable_operator_linter.R +++ b/R/undesirable_operator_linter.R @@ -66,7 +66,7 @@ undesirable_operator_linter <- function(op = default_undesirable_operators) { xpath <- paste(paste0("//", operator_nodes), collapse = " | ") - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content bad_op <- xml_find_all(xml, xpath) diff --git a/R/unnecessary_concatenation_linter.R b/R/unnecessary_concatenation_linter.R index ed263bfb1e..b3f64775bf 100644 --- a/R/unnecessary_concatenation_linter.R +++ b/R/unnecessary_concatenation_linter.R @@ -95,7 +95,7 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # ") num_args_xpath <- "count(./expr) - 1" - 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") c_calls <- xml_find_all(xml_calls, call_xpath) diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index 0ca14d78a9..397460d1d2 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -156,7 +156,7 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { # path to the symbol of the simpler function that avoids a lambda symbol_xpath <- "expr[last()]//expr[SYMBOL_FUNCTION_CALL[text() != 'return']]" - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { default_calls <- source_expression$xml_find_function_calls(apply_funs) default_fun_expr <- xml_find_all(default_calls, default_fun_xpath) diff --git a/R/unnecessary_nesting_linter.R b/R/unnecessary_nesting_linter.R index fdd2a4798e..f4c006d134 100644 --- a/R/unnecessary_nesting_linter.R +++ b/R/unnecessary_nesting_linter.R @@ -141,7 +141,7 @@ unnecessary_nesting_linter <- function(allow_assignment = TRUE) { ] ") - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content if_else_exit_expr <- xml_find_all(xml, if_else_exit_xpath) diff --git a/R/unnecessary_placeholder_linter.R b/R/unnecessary_placeholder_linter.R index 9e546326d9..894288e6b6 100644 --- a/R/unnecessary_placeholder_linter.R +++ b/R/unnecessary_placeholder_linter.R @@ -49,7 +49,7 @@ unnecessary_placeholder_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/unreachable_code_linter.R b/R/unreachable_code_linter.R index 124b5a12f0..f669c8cec0 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -134,7 +134,7 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud expr[!is_valid_comment] } - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content # run here because 'settings$exclude_end' may not be set correctly at "compile time". diff --git a/R/utils.R b/R/utils.R index 159d58fdf0..51e5e4b002 100644 --- a/R/utils.R +++ b/R/utils.R @@ -162,10 +162,14 @@ reset_lang <- function(old_lang) { #' `"expression"` means an individual expression in `xml_parsed_content`, while `"file"` means all expressions #' in the current file are available in `full_xml_parsed_content`. #' `NA` means the linter will be run with both, expression-level and file-level source expressions. +#' @param supports_exprlist Relevant for expression-level linters. If TRUE, signals that the linter can accept +#' source expressions that contain multiple individual expressions in `xml_parsed_content`. #' #' @return The same function with its class set to 'linter'. #' @export -Linter <- function(fun, name = linter_auto_name(), linter_level = c(NA_character_, "file", "expression")) { # nolint: object_name, line_length. +# nolint next: object_name. +Linter <- function(fun, name = linter_auto_name(), linter_level = c(NA_character_, "file", "expression"), + supports_exprlist = FALSE) { if (!is.function(fun) || length(formals(args(fun))) != 1L) { stop("`fun` must be a function taking exactly one argument.", call. = FALSE) } @@ -174,6 +178,7 @@ Linter <- function(fun, name = linter_auto_name(), linter_level = c(NA_character class(fun) <- c("linter", "function") attr(fun, "name") <- name attr(fun, "linter_level") <- linter_level + attr(fun, "linter_exprlist") <- isTRUE(supports_exprlist) fun } diff --git a/R/vector_logic_linter.R b/R/vector_logic_linter.R index 2705288cca..b44daded44 100644 --- a/R/vector_logic_linter.R +++ b/R/vector_logic_linter.R @@ -102,7 +102,7 @@ vector_logic_linter <- function() { ]/*[2] " - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { xml <- source_expression$xml_parsed_content xml_call <- source_expression$xml_find_function_calls(c("subset", "filter")) diff --git a/R/yoda_test_linter.R b/R/yoda_test_linter.R index 1b4b0c6717..8972d5af06 100644 --- a/R/yoda_test_linter.R +++ b/R/yoda_test_linter.R @@ -54,7 +54,7 @@ yoda_test_linter <- function() { second_const_xpath <- glue("expr[position() = 3 and ({const_condition})]") - Linter(linter_level = "expression", function(source_expression) { + Linter(linter_level = "expression", supports_exprlist = TRUE, function(source_expression) { bad_expr <- xml_find_all( source_expression$xml_find_function_calls(c("expect_equal", "expect_identical", "expect_setequal")), xpath diff --git a/man/Linter.Rd b/man/Linter.Rd index ef8c5ccd8c..a93c8680f4 100644 --- a/man/Linter.Rd +++ b/man/Linter.Rd @@ -7,7 +7,8 @@ Linter( fun, name = linter_auto_name(), - linter_level = c(NA_character_, "file", "expression") + linter_level = c(NA_character_, "file", "expression"), + supports_exprlist = FALSE ) } \arguments{ @@ -20,6 +21,9 @@ Lints produced by the linter will be labelled with \code{name} by default.} \code{"expression"} means an individual expression in \code{xml_parsed_content}, while \code{"file"} means all expressions in the current file are available in \code{full_xml_parsed_content}. \code{NA} means the linter will be run with both, expression-level and file-level source expressions.} + +\item{supports_exprlist}{Relevant for expression-level linters. If TRUE, signals that the linter can accept +source expressions that contain multiple individual expressions in \code{xml_parsed_content}.} } \value{ The same function with its class set to 'linter'. diff --git a/man/todo_comment_linter.Rd b/man/todo_comment_linter.Rd index 24b730eabf..29dde11f9b 100644 --- a/man/todo_comment_linter.Rd +++ b/man/todo_comment_linter.Rd @@ -18,22 +18,17 @@ Check that the source contains no TODO comments (case-insensitive). \examples{ # will produce lints lint( - text = "x + y # TODO", - linters = todo_comment_linter() -) - -lint( - text = "pi <- 1.0 # FIXME", - linters = todo_comment_linter() + text = "x + y # TOODOO", + linters = todo_comment_linter(todo = "toodoo") ) lint( - text = "x <- TRUE # hack", - linters = todo_comment_linter(todo = c("todo", "fixme", "hack")) + text = "pi <- 1.0 # FIIXMEE", + linters = todo_comment_linter(todo = "fiixmee") ) lint( - text = "x <- TRUE # TODO(#1234): Fix this hack.", + text = "x <- TRUE # TOODOO(#1234): Fix this hack.", linters = todo_comment_linter() )