diff --git a/NEWS.md b/NEWS.md index 830f8be46..c9533bcd5 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 b6c1300c7..4879a9758 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 04a80bd84..bc43a6055 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 5aa1a0cad..cfbc5d3b0 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 da42b5119..fafc89cae 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 3c1eaeaeb..83590ed01 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 c0d0c755c..e29cc8c75 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 7eda5a714..bfae47ea0 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 2dd24b83d..a9656269b 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 aeaf42878..cfd3946fe 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 f2c3424ab..7f8116d13 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 8b13c8a92..bd777d12a 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 e20e53b4b..baa914240 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 2961ac984..0c05f65a6 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 87dc24169..af15a9893 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 4ca6bf04a..e476e4384 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 880a66357..c5b21a54b 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 26d83ceb2..4339bd6d4 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 10b15ff38..e5e8d6597 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 7389b2abc..986697443 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 61e839a97..6e8e76653 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 c20eb393e..dad7637c8 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 6d669ed0b..a9687756a 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 d3a02fc50..0569232ac 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 921e002b2..ac00a9969 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 07e4ee438..0a039840a 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 758ba2102..baef7a10a 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 97b985dac..da48ccb1f 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 c43d390e2..9b5b91620 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 c7fa7bb1b..5f125bd31 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 abba413da..790835cf0 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 d850c51cf..422fded83 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 7acc08a3e..2f0a60d08 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 f5f52542c..54800252d 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 ca163ea9a..620d8c1d0 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 541006dd7..5c2799abc 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 549109f2c..8969caa81 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 8303ff80b..5bea81249 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 a64e6b426..2341f5c0f 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 fc12ab368..c394031bd 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 6441896c5..f5b1d4bf5 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 fd595b233..63afb4595 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 e9f0dadb5..353c69377 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 6c2eaa27d..3a909ca54 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 b11e3a7b7..9e324ba9b 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 f9f5a6715..262020072 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 cd054a068..ca36bd857 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 d9c47a99c..8ea69dceb 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 e0b55279e..64d55e6f7 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 10099463e..d2ef00edb 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 48d524c5b..2ba397eaa 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 4c01a3d32..385adf70d 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 33a9fd8d6..9120d1d06 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 877ff0da7..325fc6fe9 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 fd3dd5831..24f1f89c0 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 dfdee8d0e..fe8ec4609 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 77ca70285..92882f78e 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 decc02c66..0cef1897f 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 d4709370d..4e4b3cae8 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 3179847af..cfef05527 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 fe3727b9e..8f5955635 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 24fba540e..ca947e1d8 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 16e1de05f..fa8fc44e1 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 762ecda5d..9706e7749 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 734e6c485..6c5d5b10b 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 ed263bfb1..b3f64775b 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 0ca14d78a..397460d1d 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 fdd2a4798..f4c006d13 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 9e546326d..894288e6b 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 124b5a12f..f669c8cec 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 159d58fdf..51e5e4b00 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 2705288cc..b44daded4 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 1b4b0c671..8972d5af0 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 ef8c5ccd8..a93c8680f 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 24b730eab..29dde11f9 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() )