From d4e1411e5dce2ff52c4001e0150f6e17d9acde35 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 21:15:10 +0000 Subject: [PATCH 1/8] logic to make linters robust to adversarial comments --- R/coalesce_linter.R | 28 +++--- R/conjunct_test_linter.R | 3 +- R/expect_comparison_linter.R | 2 +- R/fixed_regex_linter.R | 2 +- R/if_switch_linter.R | 19 ++-- R/implicit_assignment_linter.R | 4 +- R/length_test_linter.R | 7 +- R/object_usage_linter.R | 30 ++++-- R/outer_negation_linter.R | 2 +- R/redundant_equals_linter.R | 2 +- R/regex_subset_linter.R | 27 ++--- R/seq_linter.R | 1 + R/sort_linter.R | 37 +++---- R/sprintf_linter.R | 9 +- R/string_boundary_linter.R | 36 ++++--- R/strings_as_factors_linter.R | 4 +- R/unnecessary_concatenation_linter.R | 2 +- R/unnecessary_lambda_linter.R | 15 ++- R/unnecessary_placeholder_linter.R | 2 +- tests/testthat/test-coalesce_linter.R | 10 ++ tests/testthat/test-conjunct_test_linter.R | 71 ++++++++------ .../testthat/test-expect_comparison_linter.R | 19 +++- tests/testthat/test-fixed_regex_linter.R | 17 +++- tests/testthat/test-if_switch_linter.R | 98 ++++++++++--------- .../test-implicit_assignment_linter.R | 27 +++++ tests/testthat/test-length_test_linter.R | 38 ++++++- tests/testthat/test-object_length_linter.R | 10 ++ tests/testthat/test-object_name_linter.R | 10 ++ tests/testthat/test-object_usage_linter.R | 15 +++ tests/testthat/test-outer_negation_linter.R | 36 ++++--- tests/testthat/test-redundant_equals_linter.R | 17 +++- tests/testthat/test-regex_subset_linter.R | 40 ++++++-- tests/testthat/test-seq_linter.R | 9 ++ tests/testthat/test-sort_linter.R | 62 +++++++++--- tests/testthat/test-sprintf_linter.R | 51 +++++++--- tests/testthat/test-string_boundary_linter.R | 10 ++ .../testthat/test-strings_as_factors_linter.R | 38 ++++--- .../test-unnecessary_concatenation_linter.R | 42 +++++--- .../testthat/test-unnecessary_lambda_linter.R | 28 ++++++ .../test-unnecessary_placeholder_linter.R | 10 ++ 40 files changed, 622 insertions(+), 268 deletions(-) diff --git a/R/coalesce_linter.R b/R/coalesce_linter.R index befa1636b2..2cb0f53334 100644 --- a/R/coalesce_linter.R +++ b/R/coalesce_linter.R @@ -46,7 +46,7 @@ coalesce_linter <- function() { braced_expr_cond <- "expr[1][OP-LEFT-BRACE and count(*) = 3]/expr" xpath <- glue(" - parent::expr[ + expr[expr[ preceding-sibling::IF and ( expr[2] = following-sibling::ELSE/following-sibling::expr @@ -54,25 +54,25 @@ coalesce_linter <- function() { or expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::ELSE/following-sibling::expr or expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::ELSE/following-sibling::{braced_expr_cond} ) - ] - /parent::expr + ]] | - parent::expr[ - preceding-sibling::OP-EXCLAMATION - and parent::expr/preceding-sibling::IF + self::*[expr[ + preceding-sibling::IF + and OP-EXCLAMATION and ( - expr[2] = parent::expr/following-sibling::expr[1] - or expr[2] = parent::expr/following-sibling::{braced_expr_cond} - or expr[2][LEFT_ASSIGN]/expr[1] = parent::expr/following-sibling::expr[1] - or expr[2][LEFT_ASSIGN]/expr[1] = parent::expr/following-sibling::{braced_expr_cond} + expr/expr[2] = following-sibling::expr[1] + or expr/expr[2] = following-sibling::{braced_expr_cond} + or expr/expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::expr[1] + or expr/expr[2][LEFT_ASSIGN]/expr[1] = following-sibling::{braced_expr_cond} ) - ] - /parent::expr - /parent::expr + ]] ") Linter(linter_level = "expression", function(source_expression) { - null_calls <- source_expression$xml_find_function_calls("is.null") + null_calls <- xml_parent(xml_parent(xml_parent( + source_expression$xml_find_function_calls("is.null") + ))) + null_calls <- strip_comments_from_subtree(null_calls) bad_expr <- xml_find_all(null_calls, xpath) is_negation <- !is.na(xml_find_first(bad_expr, "expr/OP-EXCLAMATION")) observed <- ifelse(is_negation, "if (!is.null(x)) x else y", "if (is.null(x)) y else x") diff --git a/R/conjunct_test_linter.R b/R/conjunct_test_linter.R index 95eee51507..8fd825b4a8 100644 --- a/R/conjunct_test_linter.R +++ b/R/conjunct_test_linter.R @@ -82,7 +82,8 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE, following-sibling::expr[1][AND2] /parent::expr " - named_stopifnot_condition <- if (allow_named_stopifnot) "and not(preceding-sibling::*[1][self::EQ_SUB])" else "" + named_stopifnot_condition <- + if (allow_named_stopifnot) "and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])" else "" stopifnot_xpath <- glue(" following-sibling::expr[1][AND2 {named_stopifnot_condition}] /parent::expr diff --git a/R/expect_comparison_linter.R b/R/expect_comparison_linter.R index 6f8b35577c..fdd8b1911b 100644 --- a/R/expect_comparison_linter.R +++ b/R/expect_comparison_linter.R @@ -65,7 +65,7 @@ expect_comparison_linter <- function() { xml_calls <- source_expression$xml_find_function_calls("expect_true") bad_expr <- xml_find_all(xml_calls, xpath) - comparator <- xml_find_chr(bad_expr, "string(expr[2]/*[2])") + comparator <- xml_find_chr(bad_expr, "string(expr[2]/*[not(self::COMMENT)][2])") expectation <- comparator_expectation_map[comparator] lint_message <- sprintf("%s(x, y) is better than expect_true(x %s y).", expectation, comparator) xml_nodes_to_lints(bad_expr, source_expression, lint_message = lint_message, type = "warning") diff --git a/R/fixed_regex_linter.R b/R/fixed_regex_linter.R index 5ab8680d5c..6655cda0ce 100644 --- a/R/fixed_regex_linter.R +++ b/R/fixed_regex_linter.R @@ -120,7 +120,7 @@ fixed_regex_linter <- function(allow_unescaped = FALSE) { and not({ in_pipe_cond }) ) or ( STR_CONST - and preceding-sibling::*[2][self::SYMBOL_SUB/text() = 'pattern'] + and preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB/text() = 'pattern'] ) ] ") diff --git a/R/if_switch_linter.R b/R/if_switch_linter.R index eaaa66d571..3cd4e6653b 100644 --- a/R/if_switch_linter.R +++ b/R/if_switch_linter.R @@ -191,8 +191,6 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L) # NB: IF AND {...} AND ELSE/... implies >= 3 equality conditions are present # .//expr/IF/...: the expr in `==` that's _not_ the STR_CONST # not(preceding::IF): prevent nested matches which might be incorrect globally - # not(. != .): don't match if there are _any_ expr which _don't_ match the top - # expr if_xpath <- glue(" //IF /parent::expr[ @@ -203,21 +201,28 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L) and {equal_str_cond} and ELSE/following-sibling::expr[IF and {equal_str_cond}] ] - and not( - .//expr/IF/following-sibling::{equal_str_cond}/expr[not(STR_CONST)] - != expr[1][EQ]/expr[not(STR_CONST)] - ) and not({ max_lines_cond }) ] ") + # not(. != .): don't match if there are _any_ expr which _don't_ match the top expr + # do this as a second step to + equality_test_cond <- glue("self::*[ + .//expr/IF/following-sibling::{equal_str_cond}/expr[not(STR_CONST)] + != expr[1][EQ]/expr[not(STR_CONST)] + ]") + Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content bad_expr <- xml_find_all(xml, if_xpath) + expr_all_equal <- is.na(xml_find_first( + strip_comments_from_subtree(bad_expr), + equality_test_cond + )) lints <- xml_nodes_to_lints( - bad_expr, + bad_expr[expr_all_equal], source_expression = source_expression, lint_message = paste( "Prefer switch() statements over repeated if/else equality tests,", diff --git a/R/implicit_assignment_linter.R b/R/implicit_assignment_linter.R index 70dfd3376b..d2c18ac0f6 100644 --- a/R/implicit_assignment_linter.R +++ b/R/implicit_assignment_linter.R @@ -82,7 +82,7 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr" xpath <- glue(" ({assignments}) /parent::expr[ - preceding-sibling::*[2][self::IF or self::WHILE] + preceding-sibling::*[not(self::COMMENT)][2][self::IF or self::WHILE] or parent::forcond or preceding-sibling::expr/{xpath_exceptions} or parent::expr/*[1][self::OP-LEFT-PAREN] @@ -94,7 +94,7 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr" } if (allow_scoped) { # force 2nd preceding to ensure we're in the loop condition, not the loop expression - in_branch_cond <- "ancestor::expr[preceding-sibling::*[2][self::IF or self::WHILE]]" + in_branch_cond <- "ancestor::expr[preceding-sibling::*[not(self::COMMENT)][2][self::IF or self::WHILE]]" xpath <- paste0( xpath, # _if_ we're in an IF/WHILE branch, lint if the assigned SYMBOL appears anywhere later on. diff --git a/R/length_test_linter.R b/R/length_test_linter.R index 1a984ef666..4524a68668 100644 --- a/R/length_test_linter.R +++ b/R/length_test_linter.R @@ -28,8 +28,13 @@ length_test_linter <- function() { Linter(linter_level = "expression", function(source_expression) { xml_calls <- source_expression$xml_find_function_calls("length") bad_expr <- xml_find_all(xml_calls, xpath) + bad_expr <- strip_comments_from_subtree(bad_expr) - expr_parts <- vapply(lapply(bad_expr, xml_find_all, "expr[2]/*"), xml_text, character(3L)) + expr_parts <- vapply( + lapply(bad_expr, xml_find_all, "expr[2]/*[not(self::COMMENT)]"), + xml_text, + character(3L) + ) lint_message <- sprintf( "Checking the length of a logical vector is likely a mistake. Did you mean `length(%s) %s %s`?", expr_parts[1L, ], expr_parts[2L, ], expr_parts[3L, ] diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index be2b959228..e707fd482c 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -61,13 +61,21 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c( # NB: the repeated expr[2][FUNCTION] XPath has no performance impact, so the different direct assignment XPaths are # split for better readability, see PR#1197 # TODO(#1106): use //[...] to capture assignments in more scopes - xpath_function_assignment <- " - expr[LEFT_ASSIGN or EQ_ASSIGN]/expr[2][FUNCTION or OP-LAMBDA] - | expr_or_assign_or_help[EQ_ASSIGN]/expr[2][FUNCTION or OP-LAMBDA] - | equal_assign[EQ_ASSIGN]/expr[2][FUNCTION or OP-LAMBDA] - | //SYMBOL_FUNCTION_CALL[text() = 'assign']/parent::expr/following-sibling::expr[2][FUNCTION or OP-LAMBDA] - | //SYMBOL_FUNCTION_CALL[text() = 'setMethod']/parent::expr/following-sibling::expr[3][FUNCTION or OP-LAMBDA] - " + fun_node <- "FUNCTION or OP-LAMBDA" + xpath_function_assignment <- glue(" + expr[LEFT_ASSIGN or EQ_ASSIGN]/expr[2][{fun_node}] + | expr_or_assign_or_help[EQ_ASSIGN]/expr[2][{fun_node}] + | equal_assign[EQ_ASSIGN]/expr[2][{fun_node}] + | //SYMBOL_FUNCTION_CALL[text() = 'assign']/parent::expr/following-sibling::expr[2][{fun_node}] + | //SYMBOL_FUNCTION_CALL[text() = 'setMethod']/parent::expr/following-sibling::expr[3][{fun_node}] + ") + + # code like:content + # foo <- \ #comment + # (x) x + # is technically valid, but won't parse unless the lambda is in a bigger expression (here '<-'). + # the same doesn't apply to 'function'. + xpath_unsafe_lambda <- "OP-LAMBDA[@line1 = following-sibling::*[1][self::COMMENT]/@line1]" # not all instances of linted symbols are potential sources for the observed violations -- see #1914 symbol_exclude_cond <- "preceding-sibling::OP-DOLLAR or preceding-sibling::OP-AT or ancestor::expr[OP-TILDE]" @@ -100,7 +108,9 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c( fun_assignments <- xml_find_all(xml, xpath_function_assignment) lapply(fun_assignments, function(fun_assignment) { - code <- get_content(lines = source_expression$content, fun_assignment) + # this will mess with the source line numbers. but I don't think anybody cares. + known_safe <- is.na(xml_find_first(fun_assignment, xpath_unsafe_lambda)) + code <- get_content(lines = source_expression$content, fun_assignment, known_safe = known_safe) fun <- try_silently(eval( envir = env, parse( @@ -190,8 +200,8 @@ get_assignment_symbols <- function(xml) { expr[RIGHT_ASSIGN]/expr[2]/SYMBOL[1] | equal_assign/expr[1]/SYMBOL[1] | expr_or_assign_or_help/expr[1]/SYMBOL[1] | - expr[expr[1][SYMBOL_FUNCTION_CALL/text()='assign']]/expr[2]/* | - expr[expr[1][SYMBOL_FUNCTION_CALL/text()='setMethod']]/expr[2]/* + expr[expr[1][SYMBOL_FUNCTION_CALL/text() = 'assign']]/expr[2]/* | + expr[expr[1][SYMBOL_FUNCTION_CALL/text() = 'setMethod']]/expr[2]/* " )) } diff --git a/R/outer_negation_linter.R b/R/outer_negation_linter.R index 6a5ce6e180..584573fd67 100644 --- a/R/outer_negation_linter.R +++ b/R/outer_negation_linter.R @@ -44,7 +44,7 @@ outer_negation_linter <- function() { not(expr[ position() > 1 and not(OP-EXCLAMATION) - and not(preceding-sibling::*[1][self::EQ_SUB]) + and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]) ]) ] " diff --git a/R/redundant_equals_linter.R b/R/redundant_equals_linter.R index d986dc184e..232deea712 100644 --- a/R/redundant_equals_linter.R +++ b/R/redundant_equals_linter.R @@ -58,7 +58,7 @@ redundant_equals_linter <- function() { xml <- source_expression$xml_parsed_content bad_expr <- xml_find_all(xml, xpath) - op <- xml_text(xml_find_first(bad_expr, "*[2]")) + op <- xml_text(xml_find_first(bad_expr, "*[not(self::COMMENT)][2]")) xml_nodes_to_lints( bad_expr, diff --git a/R/regex_subset_linter.R b/R/regex_subset_linter.R index bf55b4827c..7dcbc698a3 100644 --- a/R/regex_subset_linter.R +++ b/R/regex_subset_linter.R @@ -47,25 +47,23 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export regex_subset_linter <- function() { - # parent::expr for LEFT_ASSIGN and RIGHT_ASSIGN, but, strangely, - # parent::equal_assign for EQ_ASSIGN. So just use * as a catchall. - # See https://www.w3.org/TR/1999/REC-xpath-19991116/#booleans; - # equality of nodes is based on the string value of the nodes, which - # is basically what we need, i.e., whatever expression comes in - # [grepl(pattern, )] matches exactly, e.g. names(x)[grepl(ptn, names(x))]. xpath_fmt <- " - parent::expr[ - parent::expr[ + self::*[ + not(LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN) + ] + /expr[ OP-LEFT-BRACKET - and not(parent::*[LEFT_ASSIGN or EQ_ASSIGN or RIGHT_ASSIGN]) + and expr[1] = expr/expr[position() = {arg_pos} ] ] - and expr[position() = {arg_pos} ] = parent::expr/expr[1] - ]" + " grep_xpath <- glue(xpath_fmt, arg_pos = 3L) stringr_xpath <- glue(xpath_fmt, arg_pos = 2L) Linter(linter_level = "expression", function(source_expression) { - grep_calls <- source_expression$xml_find_function_calls(c("grepl", "grep")) + grep_calls <- xml_parent(xml_parent(xml_parent( + source_expression$xml_find_function_calls(c("grepl", "grep")) + ))) + grep_calls <- strip_comments_from_subtree(grep_calls) grep_expr <- xml_find_all(grep_calls, grep_xpath) grep_lints <- xml_nodes_to_lints( @@ -78,7 +76,10 @@ regex_subset_linter <- function() { type = "warning" ) - stringr_calls <- source_expression$xml_find_function_calls(c("str_detect", "str_which")) + stringr_calls <- xml_parent(xml_parent(xml_parent( + source_expression$xml_find_function_calls(c("str_detect", "str_which")) + ))) + stringr_calls <- strip_comments_from_subtree(stringr_calls) stringr_expr <- xml_find_all(stringr_calls, stringr_xpath) stringr_lints <- xml_nodes_to_lints( diff --git a/R/seq_linter.R b/R/seq_linter.R index c55e661f55..04d7d96ea2 100644 --- a/R/seq_linter.R +++ b/R/seq_linter.R @@ -126,6 +126,7 @@ seq_linter <- function() { xml_find_all(seq_calls, seq_xpath), xml_find_all(xml, colon_xpath) ) + seq_expr <- strip_comments_from_subtree(seq_expr) dot_expr1 <- get_fun(seq_expr, 1L) dot_expr2 <- get_fun(seq_expr, 2L) diff --git a/R/sort_linter.R b/R/sort_linter.R index aa66ece89a..2a0e6fa084 100644 --- a/R/sort_linter.R +++ b/R/sort_linter.R @@ -69,26 +69,24 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export sort_linter <- function() { - non_keyword_arg <- "expr[not(preceding-sibling::*[1][self::EQ_SUB])]" + # NB: assumes COMMENTs stripped + non_keyword_arg <- "expr[position() > 1 and not(preceding-sibling::*[1][self::EQ_SUB])]" order_xpath <- glue(" - //OP-LEFT-BRACKET + self::expr[ + expr[1] = expr/{non_keyword_arg} + ] + /OP-LEFT-BRACKET /following-sibling::expr[1][ - expr[1][ - SYMBOL_FUNCTION_CALL[text() = 'order'] - and count(following-sibling::{non_keyword_arg}) = 1 - and following-sibling::{non_keyword_arg} = - parent::expr[1]/parent::expr[1]/expr[1] - ] + count({non_keyword_arg}) = 1 ] ") sorted_xpath <- " - parent::expr[not(SYMBOL_SUB)] - /parent::expr[ - (EQ or NE) - and expr/expr = expr - ] - " + self::*[ + (EQ or NE) + and expr/expr = expr + and not(expr/EQ_SUB) + ]" arguments_xpath <- @@ -97,9 +95,11 @@ sort_linter <- function() { arg_values_xpath <- glue("{arguments_xpath}/following-sibling::expr[1]") Linter(linter_level = "expression", function(source_expression) { - xml <- source_expression$xml_parsed_content + order_calls <- strip_comments_from_subtree(xml_parent(xml_parent( + source_expression$xml_find_function_calls("order") + ))) - order_expr <- xml_find_all(xml, order_xpath) + order_expr <- xml_find_all(order_calls, order_xpath) variable <- xml_text(xml_find_first( order_expr, @@ -132,8 +132,9 @@ sort_linter <- function() { type = "warning" ) - xml_calls <- source_expression$xml_find_function_calls("sort") - sorted_expr <- xml_find_all(xml_calls, sorted_xpath) + sort_calls <- xml_parent(xml_parent(source_expression$xml_find_function_calls("sort"))) + sort_calls <- strip_comments_from_subtree(sort_calls) + sorted_expr <- xml_find_all(sort_calls, sorted_xpath) sorted_op <- xml_text(xml_find_first(sorted_expr, "*[2]")) lint_message <- ifelse( diff --git a/R/sprintf_linter.R b/R/sprintf_linter.R index 1eb3b345d2..fb06af1732 100644 --- a/R/sprintf_linter.R +++ b/R/sprintf_linter.R @@ -38,9 +38,12 @@ sprintf_linter <- function() { pipes <- setdiff(magrittr_pipes, "%$%") in_pipe_xpath <- glue("self::expr[ - preceding-sibling::*[1][self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }]] + preceding-sibling::*[not(self::COMMENT)][1][ + self::PIPE + or self::SPECIAL[{ xp_text_in_table(pipes) } + ]] and ( - preceding-sibling::*[2]/STR_CONST + preceding-sibling::*[not(self::COMMENT)][2]/STR_CONST or SYMBOL_SUB[text() = 'fmt']/following-sibling::expr[1]/STR_CONST ) ]") @@ -89,7 +92,7 @@ sprintf_linter <- function() { arg_idx <- 2L:length(parsed_expr) parsed_expr[arg_idx + 1L] <- parsed_expr[arg_idx] names(parsed_expr)[arg_idx + 1L] <- arg_names[arg_idx] - parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[2]")) + parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[not(self::COMMENT)][2]")) names(parsed_expr)[2L] <- "" } parsed_expr <- zap_extra_args(parsed_expr) diff --git a/R/string_boundary_linter.R b/R/string_boundary_linter.R index aaaa67f2d0..536556085d 100644 --- a/R/string_boundary_linter.R +++ b/R/string_boundary_linter.R @@ -116,25 +116,18 @@ string_boundary_linter <- function(allow_grepl = FALSE) { list(lint_expr = expr[should_lint], lint_type = lint_type) } + string_comparison_xpath <- "self::*[(EQ or NE) and expr/STR_CONST]" substr_xpath <- glue(" - (//EQ | //NE) - /parent::expr[ - expr[STR_CONST] - and expr[ - expr[1][SYMBOL_FUNCTION_CALL[text() = 'substr' or text() = 'substring']] - and expr[ - ( - position() = 3 - and NUM_CONST[text() = '1' or text() = '1L'] - ) or ( - position() = 4 - and expr[1][SYMBOL_FUNCTION_CALL[text() = 'nchar']] - and expr[position() = 2] = preceding-sibling::expr[2] - ) - ] - ] - ] - ") + self::*[expr/expr[ + ( + position() = 3 + and NUM_CONST[text() = '1' or text() = '1L'] + ) or ( + position() = 4 + and expr[1][SYMBOL_FUNCTION_CALL[text() = 'nchar']] + and expr[position() = 2] = preceding-sibling::expr[2] + ) + ]]") substr_arg2_xpath <- "string(./expr[expr[1][SYMBOL_FUNCTION_CALL]]/expr[3])" @@ -168,7 +161,12 @@ string_boundary_linter <- function(allow_grepl = FALSE) { )) } - substr_expr <- xml_find_all(xml, substr_xpath) + substr_calls <- xml_parent(xml_parent( + source_expression$xml_find_function_calls(c("substr", "substring")) + )) + is_str_comparison <- !is.na(xml_find_first(substr_calls, string_comparison_xpath)) + substr_calls <- strip_comments_from_subtree(substr_calls[is_str_comparison]) + substr_expr <- xml_find_all(substr_calls, substr_xpath) substr_one <- xml_find_chr(substr_expr, substr_arg2_xpath) %in% c("1", "1L") substr_lint_message <- paste( ifelse( diff --git a/R/strings_as_factors_linter.R b/R/strings_as_factors_linter.R index 6c8ef3f462..0e33419c3d 100644 --- a/R/strings_as_factors_linter.R +++ b/R/strings_as_factors_linter.R @@ -66,7 +66,7 @@ strings_as_factors_linter <- local({ parent::expr[ expr[ ( - STR_CONST[not(following-sibling::*[1][self::EQ_SUB])] + STR_CONST[not(following-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])] or ( {c_combine_strings} ) or expr[1][ SYMBOL_FUNCTION_CALL[text() = 'rep'] @@ -74,7 +74,7 @@ strings_as_factors_linter <- local({ ] or expr[1][SYMBOL_FUNCTION_CALL[ {xp_text_in_table(known_character_funs)} ]] ) - and not(preceding-sibling::*[2][self::SYMBOL_SUB and text() = 'row.names']) + and not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB and text() = 'row.names']) ] and not(SYMBOL_SUB[text() = 'stringsAsFactors']) ]") diff --git a/R/unnecessary_concatenation_linter.R b/R/unnecessary_concatenation_linter.R index 271d2ece6a..519662a910 100644 --- a/R/unnecessary_concatenation_linter.R +++ b/R/unnecessary_concatenation_linter.R @@ -66,7 +66,7 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # pipes <- setdiff(magrittr_pipes, "%$%") to_pipe_xpath <- glue(" - ./preceding-sibling::*[1][ + ./preceding-sibling::*[not(self::COMMENT)][1][ self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }] ] diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index f2f62232d8..76dbf9c6bc 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -125,10 +125,14 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { .//expr[ position() = 2 and preceding-sibling::expr/SYMBOL_FUNCTION_CALL - and not(preceding-sibling::*[1][self::EQ_SUB]) + and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]) and not(parent::expr[ preceding-sibling::expr[not(SYMBOL_FUNCTION_CALL)] - or following-sibling::*[not(self::OP-RIGHT-PAREN or self::OP-RIGHT-BRACE)] + or following-sibling::*[not( + self::OP-RIGHT-PAREN + or self::OP-RIGHT-BRACE + or self::COMMENT + )] ]) ]/SYMBOL ] @@ -143,7 +147,12 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { purrr_fun_xpath <- glue(" following-sibling::expr[ OP-TILDE - and expr[OP-LEFT-PAREN/following-sibling::expr[1][not(preceding-sibling::*[2][self::SYMBOL_SUB])]/{purrr_symbol}] + and expr + /OP-LEFT-PAREN + /following-sibling::expr[1][ + not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB]) + ] + /{purrr_symbol} and not(expr/OP-LEFT-PAREN/following-sibling::expr[position() > 1]//{purrr_symbol}) ]") diff --git a/R/unnecessary_placeholder_linter.R b/R/unnecessary_placeholder_linter.R index c032fc5911..d270dfb726 100644 --- a/R/unnecessary_placeholder_linter.R +++ b/R/unnecessary_placeholder_linter.R @@ -45,7 +45,7 @@ unnecessary_placeholder_linter <- function() { ] /expr[2][ SYMBOL[text() = '.'] - and not(preceding-sibling::*[1][self::EQ_SUB]) + and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]) ] ") diff --git a/tests/testthat/test-coalesce_linter.R b/tests/testthat/test-coalesce_linter.R index 434bdd7bd1..e25cb7a52c 100644 --- a/tests/testthat/test-coalesce_linter.R +++ b/tests/testthat/test-coalesce_linter.R @@ -35,6 +35,16 @@ test_that("coalesce_linter blocks simple disallowed usage", { expect_lint("if (!is.null(x[1])) x[1] else y", lint_msg_not, linter) expect_lint("if (!is.null(foo(x))) foo(x) else y", lint_msg_not, linter) + + # adversarial comments + expect_lint( + trim_some(" + if (!is.null(x[1])) x[ # comment + 1] else y + "), + lint_msg_not, + linter + ) }) test_that("coalesce_linter blocks usage with implicit assignment", { diff --git a/tests/testthat/test-conjunct_test_linter.R b/tests/testthat/test-conjunct_test_linter.R index 047d2456d4..d08e46d4f8 100644 --- a/tests/testthat/test-conjunct_test_linter.R +++ b/tests/testthat/test-conjunct_test_linter.R @@ -1,21 +1,25 @@ test_that("conjunct_test_linter skips allowed usages of expect_true", { - expect_lint("expect_true(x)", NULL, conjunct_test_linter()) - expect_lint("testthat::expect_true(x, y, z)", NULL, conjunct_test_linter()) + linter <- conjunct_test_linter() + + expect_no_lint("expect_true(x)", linter) + expect_no_lint("testthat::expect_true(x, y, z)", linter) # more complicated expression - expect_lint("expect_true(x || (y && z))", NULL, conjunct_test_linter()) + expect_no_lint("expect_true(x || (y && z))", linter) # the same by operator precedence, though not obvious a priori - expect_lint("expect_true(x || y && z)", NULL, conjunct_test_linter()) - expect_lint("expect_true(x && y || z)", NULL, conjunct_test_linter()) + expect_no_lint("expect_true(x || y && z)", linter) + expect_no_lint("expect_true(x && y || z)", linter) }) test_that("conjunct_test_linter skips allowed usages of expect_true", { - expect_lint("expect_false(x)", NULL, conjunct_test_linter()) - expect_lint("testthat::expect_false(x, y, z)", NULL, conjunct_test_linter()) + linter <- conjunct_test_linter() + + expect_no_lint("expect_false(x)", linter) + expect_no_lint("testthat::expect_false(x, y, z)", linter) # more complicated expression # (NB: xx && yy || zz and xx || yy && zz both parse with || first) - expect_lint("expect_false(x && (y || z))", NULL, conjunct_test_linter()) + expect_no_lint("expect_false(x && (y || z))", linter) }) test_that("conjunct_test_linter blocks && conditions with expect_true()", { @@ -43,14 +47,14 @@ test_that("conjunct_test_linter blocks || conditions with expect_false()", { test_that("conjunct_test_linter skips allowed stopifnot() and assert_that() usages", { linter <- conjunct_test_linter() - expect_lint("stopifnot(x)", NULL, linter) - expect_lint("assert_that(x, y, z)", NULL, linter) + expect_no_lint("stopifnot(x)", linter) + expect_no_lint("assert_that(x, y, z)", linter) # more complicated expression - expect_lint("stopifnot(x || (y && z))", NULL, linter) + expect_no_lint("stopifnot(x || (y && z))", linter) # the same by operator precedence, though not obvious a priori - expect_lint("stopifnot(x || y && z)", NULL, linter) - expect_lint("assertthat::assert_that(x && y || z)", NULL, linter) + expect_no_lint("stopifnot(x || y && z)", linter) + expect_no_lint("assertthat::assert_that(x && y || z)", linter) }) test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() and assert_that()", { @@ -66,12 +70,23 @@ test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() a }) test_that("conjunct_test_linter's allow_named_stopifnot argument works", { + linter <- conjunct_test_linter() + # allowed by default - expect_lint( + expect_no_lint( "stopifnot('x must be a logical scalar' = length(x) == 1 && is.logical(x) && !is.na(x))", - NULL, - conjunct_test_linter() + linter ) + # including with intervening comment + expect_no_lint( + trim_some(" + stopifnot('x must be a logical scalar' = # comment + length(x) == 1 && is.logical(x) && !is.na(x) + ) + "), + linter + ) + expect_lint( "stopifnot('x is a logical scalar' = length(x) == 1 && is.logical(x) && !is.na(x))", rex::rex("Write multiple conditions like stopifnot(A, B)"), @@ -82,11 +97,11 @@ test_that("conjunct_test_linter's allow_named_stopifnot argument works", { test_that("conjunct_test_linter skips allowed usages", { linter <- conjunct_test_linter() - expect_lint("dplyr::filter(DF, A, B)", NULL, linter) - expect_lint("dplyr::filter(DF, !(A & B))", NULL, linter) + expect_no_lint("dplyr::filter(DF, A, B)", linter) + expect_no_lint("dplyr::filter(DF, !(A & B))", linter) # | is the "top-level" operator here - expect_lint("dplyr::filter(DF, A & B | C)", NULL, linter) - expect_lint("dplyr::filter(DF, A | B & C)", NULL, linter) + expect_no_lint("dplyr::filter(DF, A & B | C)", linter) + expect_no_lint("dplyr::filter(DF, A | B & C)", linter) }) test_that("conjunct_test_linter blocks simple disallowed usages", { @@ -105,22 +120,22 @@ test_that("conjunct_test_linter respects its allow_filter argument", { linter_dplyr <- conjunct_test_linter(allow_filter = "not_dplyr") lint_msg <- rex::rex("Use dplyr::filter(DF, A, B) instead of dplyr::filter(DF, A & B)") - expect_lint("dplyr::filter(DF, A & B)", NULL, linter_always) - expect_lint("dplyr::filter(DF, A & B & C)", NULL, linter_always) - expect_lint("DF %>% dplyr::filter(A & B)", NULL, linter_always) + expect_no_lint("dplyr::filter(DF, A & B)", linter_always) + expect_no_lint("dplyr::filter(DF, A & B & C)", linter_always) + expect_no_lint("DF %>% dplyr::filter(A & B)", linter_always) expect_lint("dplyr::filter(DF, A & B)", lint_msg, linter_dplyr) expect_lint("dplyr::filter(DF, A & B & C)", lint_msg, linter_dplyr) expect_lint("DF %>% dplyr::filter(A & B)", lint_msg, linter_dplyr) - expect_lint("filter(DF, A & B)", NULL, linter_dplyr) - expect_lint("filter(DF, A & B & C)", NULL, linter_dplyr) - expect_lint("DF %>% filter(A & B)", NULL, linter_dplyr) + expect_no_lint("filter(DF, A & B)", linter_dplyr) + expect_no_lint("filter(DF, A & B & C)", linter_dplyr) + expect_no_lint("DF %>% filter(A & B)", linter_dplyr) }) test_that("filter() is assumed to be dplyr::filter() by default, unless o/w specified", { linter <- conjunct_test_linter() - expect_lint("stats::filter(A & B)", NULL, linter) - expect_lint("ns::filter(A & B)", NULL, linter) + expect_no_lint("stats::filter(A & B)", linter) + expect_no_lint("ns::filter(A & B)", linter) expect_lint( "DF %>% filter(A & B)", rex::rex("Use dplyr::filter(DF, A, B) instead of dplyr::filter(DF, A & B)"), diff --git a/tests/testthat/test-expect_comparison_linter.R b/tests/testthat/test-expect_comparison_linter.R index cf1a349aa0..adcab53e1b 100644 --- a/tests/testthat/test-expect_comparison_linter.R +++ b/tests/testthat/test-expect_comparison_linter.R @@ -2,18 +2,18 @@ test_that("expect_comparison_linter skips allowed usages", { linter <- expect_comparison_linter() # there's no expect_ne() for this operator - expect_lint("expect_true(x != y)", NULL, linter) + expect_no_lint("expect_true(x != y)", linter) # NB: also applies to tinytest, but it's sufficient to test testthat - expect_lint("testthat::expect_true(x != y)", NULL, linter) + expect_no_lint("testthat::expect_true(x != y)", linter) # multiple comparisons are OK - expect_lint("expect_true(x > y || x > z)", NULL, linter) + expect_no_lint("expect_true(x > y || x > z)", linter) # expect_gt() and friends don't have an info= argument - expect_lint("expect_true(x > y, info = 'x is bigger than y yo')", NULL, linter) + expect_no_lint("expect_true(x > y, info = 'x is bigger than y yo')", linter) # expect_true() used incorrectly, and as executed the first argument is not a lint - expect_lint("expect_true(is.count(n_draws), n_draws > 1)", NULL, linter) + expect_no_lint("expect_true(is.count(n_draws), n_draws > 1)", linter) }) test_that("expect_comparison_linter blocks simple disallowed usages", { @@ -49,6 +49,15 @@ test_that("expect_comparison_linter blocks simple disallowed usages", { rex::rex("expect_identical(x, y) is better than expect_true(x == y)."), linter ) + + expect_lint( + trim_some(" + expect_true(x # comment + == (y == 2)) + "), + rex::rex("expect_identical(x, y) is better than expect_true(x == y)."), + expect_comparison_linter() + ) }) test_that("lints vectorize", { diff --git a/tests/testthat/test-fixed_regex_linter.R b/tests/testthat/test-fixed_regex_linter.R index e0dcae72ec..5ce25a2dd3 100644 --- a/tests/testthat/test-fixed_regex_linter.R +++ b/tests/testthat/test-fixed_regex_linter.R @@ -352,13 +352,13 @@ test_that("'unescaped' regex can optionally be skipped", { }) local({ + linter <- fixed_regex_linter() + lint_msg <- "This regular expression is static" pipes <- pipes(exclude = c("%$%", "%T>%")) + patrick::with_parameters_test_that( "linter is pipe-aware", { - linter <- fixed_regex_linter() - lint_msg <- "This regular expression is static" - expect_lint(paste("x", pipe, "grepl(pattern = 'a')"), lint_msg, linter) expect_no_lint(paste("x", pipe, "grepl(pattern = '^a')"), linter) expect_no_lint(paste("x", pipe, "grepl(pattern = 'a', fixed = TRUE)"), linter) @@ -377,3 +377,14 @@ local({ .test_name = names(pipes) ) }) + +test_that("pipe-aware lint logic survives adversarial comments", { + expect_lint( + trim_some(" + x %>% grepl(pattern = # comment + 'a') + "), + "This regular expression is static", + fixed_regex_linter() + ) +}) diff --git a/tests/testthat/test-if_switch_linter.R b/tests/testthat/test-if_switch_linter.R index e6b3e5fe57..8674734139 100644 --- a/tests/testthat/test-if_switch_linter.R +++ b/tests/testthat/test-if_switch_linter.R @@ -2,23 +2,23 @@ test_that("if_switch_linter skips allowed usages", { linter <- if_switch_linter() # don't apply to simple if/else statements - expect_lint("if (x == 'a') 1 else 2", NULL, linter) + expect_no_lint("if (x == 'a') 1 else 2", linter) # don't apply to non-character conditions # (NB: switch _could_ be used for integral input, but this # interface is IMO a bit clunky / opaque) - expect_lint("if (x == 1) 1 else 2", NULL, linter) + expect_no_lint("if (x == 1) 1 else 2", linter) # this also has a switch equivalent, but we don't both handling such # complicated cases - expect_lint("if (x == 'a') 1 else if (x != 'b') 2 else 3", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (x != 'b') 2 else 3", linter) # multiple variables involved --> no clean change - expect_lint("if (x == 'a') 1 else if (y == 'b') 2 else 3", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (y == 'b') 2 else 3", linter) # multiple conditions --> no clean change - expect_lint("if (is.character(x) && x == 'a') 1 else if (x == 'b') 2 else 3", NULL, linter) + expect_no_lint("if (is.character(x) && x == 'a') 1 else if (x == 'b') 2 else 3", linter) # simple cases with two conditions might be more natural # without switch(); require at least three branches to trigger a lint - expect_lint("if (x == 'a') 1 else if (x == 'b') 2", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2", linter) # still no third if() clause - expect_lint("if (x == 'a') 1 else if (x == 'b') 2 else 3", NULL, linter) + expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2 else 3", linter) }) test_that("if_switch_linter blocks simple disallowed usages", { @@ -29,6 +29,15 @@ test_that("if_switch_linter blocks simple disallowed usages", { expect_lint("if (x == 'a') 1 else if (x == 'b') 2 else if (x == 'c') 3", lint_msg, linter) # expressions are also OK expect_lint("if (foo(x) == 'a') 1 else if (foo(x) == 'b') 2 else if (foo(x) == 'c') 3", lint_msg, linter) + # including when comments are present + expect_lint( + trim_some(" + if (foo(x) == 'a') 1 else if (foo(x # comment + ) == 'b') 2 else if (foo(x) == 'c') 3 + "), + lint_msg, + linter + ) }) test_that("if_switch_linter handles further nested if/else correctly", { @@ -43,9 +52,8 @@ test_that("if_switch_linter handles further nested if/else correctly", { # related to previous test -- if the first condition is non-`==`, the # whole if/else chain is "tainted" / non-switch()-recommended. # (technically, switch can work here, but the semantics are opaque) - expect_lint( + expect_no_lint( "if (x %in% c('a', 'e', 'f')) 1 else if (x == 'b') 2 else if (x == 'c') 3 else if (x == 'd') 4", - NULL, linter ) }) @@ -78,7 +86,7 @@ test_that("multiple lints have right metadata", { ) }) -test_that("max_branch_lines= and max_branch_expressions= arguments work", { +test_that("max_branch_lines= and max_branch_expressions= arguments work", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_lines4_linter <- if_switch_linter(max_branch_lines = 4L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) @@ -131,9 +139,9 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { 9 } ") - expect_lint(three_per_branch_lines, NULL, max_lines2_linter) + expect_no_lint(three_per_branch_lines, max_lines2_linter) expect_lint(three_per_branch_lines, lint_msg, max_lines4_linter) - expect_lint(three_per_branch_lines, NULL, max_expr2_linter) + expect_no_lint(three_per_branch_lines, max_expr2_linter) expect_lint(three_per_branch_lines, lint_msg, max_expr4_linter) five_per_branch_lines <- trim_some(" @@ -157,10 +165,10 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { 15 } ") - expect_lint(five_per_branch_lines, NULL, max_lines2_linter) - expect_lint(five_per_branch_lines, NULL, max_lines4_linter) - expect_lint(five_per_branch_lines, NULL, max_expr2_linter) - expect_lint(five_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(five_per_branch_lines, max_lines2_linter) + expect_no_lint(five_per_branch_lines, max_lines4_linter) + expect_no_lint(five_per_branch_lines, max_expr2_linter) + expect_no_lint(five_per_branch_lines, max_expr4_linter) five_lines_three_expr_lines <- trim_some(" if (x == 'a') { @@ -183,9 +191,9 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { ) } ") - expect_lint(five_lines_three_expr_lines, NULL, max_lines2_linter) - expect_lint(five_lines_three_expr_lines, NULL, max_lines4_linter) - expect_lint(five_lines_three_expr_lines, NULL, max_expr2_linter) + expect_no_lint(five_lines_three_expr_lines, max_lines2_linter) + expect_no_lint(five_lines_three_expr_lines, max_lines4_linter) + expect_no_lint(five_lines_three_expr_lines, max_expr2_linter) expect_lint( five_lines_three_expr_lines, list(lint_msg, line_number = 1L), @@ -207,17 +215,17 @@ test_that("max_branch_lines= and max_branch_expressions= arguments work", { 13; 14; 15 } ") - expect_lint(five_expr_three_lines_lines, NULL, max_lines2_linter) + expect_no_lint(five_expr_three_lines_lines, max_lines2_linter) expect_lint( five_expr_three_lines_lines, list(lint_msg, line_number = 1L), max_lines4_linter ) - expect_lint(five_expr_three_lines_lines, NULL, max_expr2_linter) - expect_lint(five_expr_three_lines_lines, NULL, max_expr4_linter) + expect_no_lint(five_expr_three_lines_lines, max_expr2_linter) + expect_no_lint(five_expr_three_lines_lines, max_expr4_linter) }) -test_that("max_branch_lines= and max_branch_expressions= block over-complex switch() too", { +test_that("max_branch_lines= and max_branch_expressions= block over-complex switch() too", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_lines4_linter <- if_switch_linter(max_branch_lines = 4L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) @@ -237,10 +245,10 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit } ) ") - expect_lint(one_per_branch_lines, NULL, max_lines2_linter) - expect_lint(one_per_branch_lines, NULL, max_lines4_linter) - expect_lint(one_per_branch_lines, NULL, max_expr2_linter) - expect_lint(one_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(one_per_branch_lines, max_lines2_linter) + expect_no_lint(one_per_branch_lines, max_lines4_linter) + expect_no_lint(one_per_branch_lines, max_expr2_linter) + expect_no_lint(one_per_branch_lines, max_expr4_linter) two_per_branch_lines <- trim_some(" switch(x, @@ -258,10 +266,10 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit } ) ") - expect_lint(two_per_branch_lines, NULL, max_lines2_linter) - expect_lint(two_per_branch_lines, NULL, max_lines4_linter) - expect_lint(two_per_branch_lines, NULL, max_expr2_linter) - expect_lint(two_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(two_per_branch_lines, max_lines2_linter) + expect_no_lint(two_per_branch_lines, max_lines4_linter) + expect_no_lint(two_per_branch_lines, max_expr2_linter) + expect_no_lint(two_per_branch_lines, max_expr4_linter) three_per_branch_lines <- trim_some(" switch(x, @@ -287,13 +295,13 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit list(lint_msg, line_number = 1L), max_lines2_linter ) - expect_lint(three_per_branch_lines, NULL, max_lines4_linter) + expect_no_lint(three_per_branch_lines, max_lines4_linter) expect_lint( three_per_branch_lines, list(lint_msg, line_number = 1L), max_expr2_linter ) - expect_lint(three_per_branch_lines, NULL, max_expr4_linter) + expect_no_lint(three_per_branch_lines, max_expr4_linter) five_per_branch_lines <- trim_some(" switch(x, @@ -353,7 +361,7 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit expect_lint(five_lines_three_expr_lines, lint_msg, max_lines2_linter) expect_lint(five_lines_three_expr_lines, lint_msg, max_lines4_linter) expect_lint(five_lines_three_expr_lines, lint_msg, max_expr2_linter) - expect_lint(five_lines_three_expr_lines, NULL, max_expr4_linter) + expect_no_lint(five_lines_three_expr_lines, max_expr4_linter) five_expr_three_lines_lines <- trim_some(" switch(x, @@ -375,12 +383,12 @@ test_that("max_branch_lines= and max_branch_expressions= block over-complex swit ) ") expect_lint(five_expr_three_lines_lines, lint_msg, max_lines2_linter) - expect_lint(five_expr_three_lines_lines, NULL, max_lines4_linter) + expect_no_lint(five_expr_three_lines_lines, max_lines4_linter) expect_lint(five_expr_three_lines_lines, lint_msg, max_expr2_linter) expect_lint(five_expr_three_lines_lines, lint_msg, max_expr4_linter) }) -test_that("max_branch_lines= and max_branch_expressions= interact correctly", { +test_that("max_branch_lines= and max_branch_expressions= interact correctly", { # nofuzz linter <- if_switch_linter(max_branch_lines = 5L, max_branch_expressions = 3L) lint_msg <- rex::rex("Prefer switch() statements over repeated if/else equality tests") @@ -398,7 +406,7 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { linter ) - expect_lint( + expect_no_lint( trim_some(" if (x == 'a') { foo( @@ -413,11 +421,10 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { 3 } "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" if (x == 'a') { 1; 2; 3; 4 @@ -427,12 +434,11 @@ test_that("max_branch_lines= and max_branch_expressions= interact correctly", { 6 } "), - NULL, linter ) }) -test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'else' branch", { +test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'else' branch", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) lint_msg <- rex::rex("Prefer repeated if/else statements over overly-complicated switch() statements.") @@ -450,8 +456,8 @@ test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'el 6 } ") - expect_lint(else_long_lines, NULL, max_lines2_linter) - expect_lint(else_long_lines, NULL, max_expr2_linter) + expect_no_lint(else_long_lines, max_lines2_linter) + expect_no_lint(else_long_lines, max_expr2_linter) default_long_lines <- trim_some(" switch(x, @@ -475,7 +481,7 @@ test_that("max_branch_lines= and max_branch_expressions= work for a terminal 'el expect_lint(default_long_lines, lint_msg, max_expr2_linter) }) -test_that("max_branch_lines= and max_branch_expressions= are guided by the most complex branch", { +test_that("max_branch_lines= and max_branch_expressions= are guided by the most complex branch", { # nofuzz max_lines2_linter <- if_switch_linter(max_branch_lines = 2L) max_expr2_linter <- if_switch_linter(max_branch_expressions = 2L) lint_msg <- rex::rex("Prefer repeated if/else statements over overly-complicated switch() statements.") @@ -492,8 +498,8 @@ test_that("max_branch_lines= and max_branch_expressions= are guided by the most 5 } ") - expect_lint(if_else_one_branch_lines, NULL, max_lines2_linter) - expect_lint(if_else_one_branch_lines, NULL, max_expr2_linter) + expect_no_lint(if_else_one_branch_lines, max_lines2_linter) + expect_no_lint(if_else_one_branch_lines, max_expr2_linter) # lint if _any_ branch is too complex switch_one_branch_lines <- trim_some(" diff --git a/tests/testthat/test-implicit_assignment_linter.R b/tests/testthat/test-implicit_assignment_linter.R index 01b5c21074..c9c4a0f3b9 100644 --- a/tests/testthat/test-implicit_assignment_linter.R +++ b/tests/testthat/test-implicit_assignment_linter.R @@ -214,6 +214,22 @@ test_that("implicit_assignment_linter blocks disallowed usages in simple conditi expect_lint("while (0L -> x) FALSE", lint_message, linter) expect_lint("for (x in y <- 1:10) print(x)", lint_message, linter) expect_lint("for (x in 1:10 -> y) print(x)", lint_message, linter) + + # adversarial commenting + expect_lint( + trim_some(" + while # comment + (x <- 0L) FALSE + + while ( # comment + x <- 0L) FALSE + "), + list( + list(lint_message, line_number = 2L), + list(lint_message, line_number = 5L) + ), + linter + ) }) test_that("implicit_assignment_linter blocks disallowed usages in nested conditional statements", { @@ -419,6 +435,17 @@ test_that("allow_scoped skips scoped assignments", { # outside of branching, doesn't matter expect_lint("foo(idx <- bar()); baz()", lint_message, linter) expect_lint("foo(x, idx <- bar()); baz()", lint_message, linter) + + # adversarial comments + expect_no_lint( + trim_some(" + if # comment + (any(idx <- x < 0)) { + stop('negative elements: ', toString(which(idx))) + } + "), + linter + ) }) test_that("interaction of allow_lazy and allow_scoped", { diff --git a/tests/testthat/test-length_test_linter.R b/tests/testthat/test-length_test_linter.R index b60557c12d..f71e13e667 100644 --- a/tests/testthat/test-length_test_linter.R +++ b/tests/testthat/test-length_test_linter.R @@ -1,8 +1,8 @@ test_that("skips allowed usages", { linter <- length_test_linter() - expect_lint("length(x) > 0", NULL, linter) - expect_lint("length(DF[key == val, cols])", NULL, linter) + expect_no_lint("length(x) > 0", linter) + expect_no_lint("length(DF[key == val, cols])", linter) }) test_that("blocks simple disallowed usages", { @@ -12,6 +12,16 @@ test_that("blocks simple disallowed usages", { expect_lint("length(x == 0)", rex::rex(lint_msg_stub, "`length(x) == 0`?"), linter) expect_lint("length(x == y)", rex::rex(lint_msg_stub, "`length(x) == y`?"), linter) expect_lint("length(x + y == 2)", rex::rex(lint_msg_stub, "`length(x+y) == 2`?"), linter) + + # adversarial comments + expect_lint( + trim_some(" + length(x + # + y == 2) + "), + rex::rex(lint_msg_stub, "`length(x+y) == 2`?"), + linter + ) }) local({ @@ -32,6 +42,8 @@ local({ }) test_that("lints vectorize", { + linter <- length_test_linter() + expect_lint( trim_some("{ length(x == y) @@ -41,6 +53,26 @@ test_that("lints vectorize", { list(rex::rex("length(x) == y"), line_number = 2L), list(rex::rex("length(y) == z"), line_number = 3L) ), - length_test_linter() + linter + ) + + expect_lint( + trim_some("{ + length( # comment + x # comment + == # comment + y # comment + ) # comment + length( # comment + y # comment + == # comment + z # comment + ) + }"), + list( + list(rex::rex("length(x) == y"), line_number = 2L), + list(rex::rex("length(y) == z"), line_number = 7L) + ), + linter ) }) diff --git a/tests/testthat/test-object_length_linter.R b/tests/testthat/test-object_length_linter.R index 240c861923..051c6bf2f1 100644 --- a/tests/testthat/test-object_length_linter.R +++ b/tests/testthat/test-object_length_linter.R @@ -104,4 +104,14 @@ test_that("literals in assign() and setGeneric() are checked", { expect_lint("assign(x = 'badBadBadBadName', 2, env)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', 'badBadBadBadName', 2)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', x = 'badBadBadBadName', 2)", lint_msg, linter) + + # adversarial comments + expect_lint( + trim_some(" + assign(envir = # comment + 'good_env_name', 'badBadBadBadName', 2) + "), + lint_msg, + linter + ) }) diff --git a/tests/testthat/test-object_name_linter.R b/tests/testthat/test-object_name_linter.R index cdf6591c84..ad09b06c7b 100644 --- a/tests/testthat/test-object_name_linter.R +++ b/tests/testthat/test-object_name_linter.R @@ -345,6 +345,16 @@ test_that("literals in assign() and setGeneric() are checked", { expect_lint("assign(x = 'badName', 2, env)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', 'badName', 2)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', x = 'badName', 2)", lint_msg, linter) + + # adversarial comments + expect_lint( + trim_some(" + assign(envir = # comment + 'good_env_name', 'badName', 2) + "), + lint_msg, + linter + ) }) test_that("generics assigned with '=' or <<- are registered", { diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R index 7efc4025b5..4283e16d60 100644 --- a/tests/testthat/test-object_usage_linter.R +++ b/tests/testthat/test-object_usage_linter.R @@ -753,6 +753,21 @@ test_that("symbols in formulas aren't treated as 'undefined global'", { ), linter ) + + # native lambda requires being in an expression to support a comment immediately after + expect_lint( + trim_some(" + foo <- \\ # comment + (x) { + lm( + y(w) ~ z, + data = x[!is.na(y)] + ) + } + "), + "no visible", + linter + ) }) test_that("NSE-ish symbols after $/@ are ignored as sources for lints", { diff --git a/tests/testthat/test-outer_negation_linter.R b/tests/testthat/test-outer_negation_linter.R index 0601aa4ee0..aa18761f1a 100644 --- a/tests/testthat/test-outer_negation_linter.R +++ b/tests/testthat/test-outer_negation_linter.R @@ -1,20 +1,20 @@ test_that("outer_negation_linter skips allowed usages", { linter <- outer_negation_linter() - expect_lint("x <- any(y)", NULL, linter) - expect_lint("y <- all(z)", NULL, linter) + expect_no_lint("x <- any(y)", linter) + expect_no_lint("y <- all(z)", linter) # extended usage of any is not covered - expect_lint("any(!a & b)", NULL, linter) - expect_lint("all(a | !b)", NULL, linter) - - expect_lint("any(a, b)", NULL, linter) - expect_lint("all(b, c)", NULL, linter) - expect_lint("any(!a, b)", NULL, linter) - expect_lint("all(a, !b)", NULL, linter) - expect_lint("any(a, !b, na.rm = TRUE)", NULL, linter) + expect_no_lint("any(!a & b)", linter) + expect_no_lint("all(a | !b)", linter) + + expect_no_lint("any(a, b)", linter) + expect_no_lint("all(b, c)", linter) + expect_no_lint("any(!a, b)", linter) + expect_no_lint("all(a, !b)", linter) + expect_no_lint("any(a, !b, na.rm = TRUE)", linter) # ditto when na.rm is passed quoted - expect_lint("any(a, !b, 'na.rm' = TRUE)", NULL, linter) + expect_no_lint("any(a, !b, 'na.rm' = TRUE)", linter) }) test_that("outer_negation_linter blocks simple disallowed usages", { @@ -31,15 +31,25 @@ test_that("outer_negation_linter blocks simple disallowed usages", { # catch when all inputs are negated expect_lint("any(!x, !y)", not_all_msg, linter) expect_lint("all(!x, !y, na.rm = TRUE)", not_any_msg, linter) + + # adversarial comment + expect_lint( + trim_some(" + any(!x, na.rm = # comment + TRUE) + "), + not_all_msg, + linter + ) }) test_that("outer_negation_linter doesn't trigger on empty calls", { linter <- outer_negation_linter() # minimal version of issue - expect_lint("any()", NULL, linter) + expect_no_lint("any()", linter) # closer to what was is practically relevant, as another regression test - expect_lint("x %>% any()", NULL, linter) + expect_no_lint("x %>% any()", linter) }) test_that("lints vectorize", { diff --git a/tests/testthat/test-redundant_equals_linter.R b/tests/testthat/test-redundant_equals_linter.R index 541237f837..8bd829b6a5 100644 --- a/tests/testthat/test-redundant_equals_linter.R +++ b/tests/testthat/test-redundant_equals_linter.R @@ -1,8 +1,10 @@ test_that("redundant_equals_linter skips allowed usages", { + linter <- redundant_equals_linter() + # comparisons to non-logical constants - expect_lint("x == 1", NULL, redundant_equals_linter()) + expect_no_lint("x == 1", linter) # comparison to TRUE as a string - expect_lint("x != 'TRUE'", NULL, redundant_equals_linter()) + expect_no_lint("x != 'TRUE'", linter) }) test_that("multiple lints return correct custom messages", { @@ -40,3 +42,14 @@ patrick::with_parameters_test_that( "!=, FALSE", "!=", "FALSE" ) ) + +test_that("logic survives adversarial comments", { + expect_lint( + trim_some(" + list(x # + == TRUE) + "), + "==", + redundant_equals_linter() + ) +}) diff --git a/tests/testthat/test-regex_subset_linter.R b/tests/testthat/test-regex_subset_linter.R index 0c3e0c6e96..5375b662cb 100644 --- a/tests/testthat/test-regex_subset_linter.R +++ b/tests/testthat/test-regex_subset_linter.R @@ -1,6 +1,8 @@ test_that("regex_subset_linter skips allowed usages", { - expect_lint("y[grepl(ptn, x)]", NULL, regex_subset_linter()) - expect_lint("x[grepl(ptn, foo(x))]", NULL, regex_subset_linter()) + linter <- regex_subset_linter() + + expect_no_lint("y[grepl(ptn, x)]", linter) + expect_no_lint("x[grepl(ptn, foo(x))]", linter) }) test_that("regex_subset_linter blocks simple disallowed usages", { @@ -10,24 +12,42 @@ test_that("regex_subset_linter blocks simple disallowed usages", { expect_lint("x[grep(ptn, x)]", lint_msg, linter) expect_lint("names(y)[grepl(ptn, names(y), perl = TRUE)]", lint_msg, linter) expect_lint("names(foo(y))[grepl(ptn, names(foo(y)), fixed = TRUE)]", lint_msg, linter) + + # adversarial commenting + expect_lint( + trim_some(" + names(y #comment + )[grepl(ptn, names(y), perl = TRUE)] + "), + lint_msg, + linter + ) }) test_that("regex_subset_linter skips grep/grepl subassignment", { linter <- regex_subset_linter() - expect_lint("x[grep(ptn, x)] <- ''", NULL, linter) - expect_lint("x[grepl(ptn, x)] <- ''", NULL, linter) - expect_lint("x[grep(ptn, x, perl = TRUE)] = ''", NULL, linter) - expect_lint("'' -> x[grep(ptn, x, ignore.case = TRUE)] = ''", NULL, linter) + expect_no_lint("x[grep(ptn, x)] <- ''", linter) + expect_no_lint("x[grepl(ptn, x)] <- ''", linter) + expect_no_lint("x[grep(ptn, x, perl = TRUE)] = ''", linter) + expect_no_lint("'' -> x[grep(ptn, x, ignore.case = TRUE)] = ''", linter) + + expect_no_lint( + trim_some(" + x[grepl(ptn, x) # comment + ] <- '' + "), + linter + ) }) test_that("regex_subset_linter skips allowed usages for stringr equivalents", { linter <- regex_subset_linter() - expect_lint("y[str_detect(x, ptn)]", NULL, linter) - expect_lint("x[str_detect(foo(x), ptn)]", NULL, linter) - expect_lint("x[str_detect(x, ptn)] <- ''", NULL, linter) - expect_lint("x[str_detect(x, ptn)] <- ''", NULL, linter) + expect_no_lint("y[str_detect(x, ptn)]", linter) + expect_no_lint("x[str_detect(foo(x), ptn)]", linter) + expect_no_lint("x[str_detect(x, ptn)] <- ''", linter) + expect_no_lint("x[str_detect(x, ptn)] <- ''", linter) }) test_that("regex_subset_linter blocks disallowed usages for stringr equivalents", { diff --git a/tests/testthat/test-seq_linter.R b/tests/testthat/test-seq_linter.R index 9424d394fc..295e496ef5 100644 --- a/tests/testthat/test-seq_linter.R +++ b/tests/testthat/test-seq_linter.R @@ -96,6 +96,15 @@ test_that("finds 1:length(...) expressions", { linter ) + expect_lint( + trim_some(" + mutate(x, .id = 1:n( # comment + )) + "), + lint_msg("seq_len(n())", "1:n(),"), + linter + ) + expect_lint( "x[, .id := 1:.N]", lint_msg("seq_len(.N)", "1:.N,"), diff --git a/tests/testthat/test-sort_linter.R b/tests/testthat/test-sort_linter.R index 15d8ab209e..aa0e578049 100644 --- a/tests/testthat/test-sort_linter.R +++ b/tests/testthat/test-sort_linter.R @@ -1,21 +1,21 @@ test_that("sort_linter skips allowed usages", { linter <- sort_linter() - expect_lint("order(y)", NULL, linter) + expect_no_lint("order(y)", linter) - expect_lint("y[order(x)]", NULL, linter) + expect_no_lint("y[order(x)]", linter) # If another function is intercalated, don't fail - expect_lint("x[c(order(x))]", NULL, linter) + expect_no_lint("x[c(order(x))]", linter) - expect_lint("x[order(y, x)]", NULL, linter) - expect_lint("x[order(x, y)]", NULL, linter) + expect_no_lint("x[order(y, x)]", linter) + expect_no_lint("x[order(x, y)]", linter) # pretty sure this never makes sense, but test anyway - expect_lint("x[order(y, na.last = x)]", NULL, linter) + expect_no_lint("x[order(y, na.last = x)]", linter) }) -test_that("sort_linter blocks simple disallowed usages", { +test_that("sort_linter blocks simple disallowed usages for x[order(x)] cases", { linter <- sort_linter() lint_message <- rex::rex("sort(", anything, ") is better than") @@ -62,6 +62,32 @@ test_that("sort_linter produces customized warning message", { rex::rex("sort(f(), na.last = TRUE) is better than f()[order(f())]"), linter ) + + # comment torture + expect_lint( + trim_some(" + x[ # comment + order( # comment + x # comment + , # comment + na.last # comment + = # comment + FALSE # comment + ) # comment + ] + "), + rex::rex("sort(x, na.last = FALSE)"), + linter + ) + + expect_lint( + trim_some(" + f( # comment + )[order(f())] + "), + rex::rex("sort(f(), na.last = TRUE) is better than f()[order(f())]"), + linter + ) }) test_that("sort_linter works with multiple lints in a single expression", { @@ -89,20 +115,20 @@ test_that("sort_linter skips usages calling sort arguments", { linter <- sort_linter() # any arguments to sort --> not compatible - expect_lint("sort(x, decreasing = TRUE) == x", NULL, linter) - expect_lint("sort(x, na.last = TRUE) != x", NULL, linter) - expect_lint("sort(x, method_arg = TRUE) == x", NULL, linter) + expect_no_lint("sort(x, decreasing = TRUE) == x", linter) + expect_no_lint("sort(x, na.last = TRUE) != x", linter) + expect_no_lint("sort(x, method_arg = TRUE) == x", linter) }) test_that("sort_linter skips when inputs don't match", { linter <- sort_linter() - expect_lint("sort(x) == y", NULL, linter) - expect_lint("sort(x) == foo(x)", NULL, linter) - expect_lint("sort(foo(x)) == x", NULL, linter) + expect_no_lint("sort(x) == y", linter) + expect_no_lint("sort(x) == foo(x)", linter) + expect_no_lint("sort(foo(x)) == x", linter) }) -test_that("sort_linter blocks simple disallowed usages", { +test_that("sort_linter blocks simple disallowed usages for is.sorted cases", { linter <- sort_linter() unsorted_msg <- rex::rex("Use is.unsorted(x) to test the unsortedness of a vector.") sorted_msg <- rex::rex("Use !is.unsorted(x) to test the sortedness of a vector.") @@ -117,6 +143,14 @@ test_that("sort_linter blocks simple disallowed usages", { # expression matching expect_lint("sort(foo(x)) == foo(x)", sorted_msg, linter) + expect_lint( + trim_some(" + sort(foo(x # comment + )) == foo(x) + "), + sorted_msg, + linter + ) }) test_that("lints vectorize", { diff --git a/tests/testthat/test-sprintf_linter.R b/tests/testthat/test-sprintf_linter.R index e0626a974d..7fc6fa27d3 100644 --- a/tests/testthat/test-sprintf_linter.R +++ b/tests/testthat/test-sprintf_linter.R @@ -4,14 +4,14 @@ patrick::with_parameters_test_that( linter <- sprintf_linter() # NB: using paste0, not sprintf, to avoid escaping '%d' in sprint fmt= - expect_lint(paste0(call_name, "('hello')"), NULL, linter) - expect_lint(paste0(call_name, "('hello %d', 1)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %d', x)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %d', x + 1)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %d', f(x))"), NULL, linter) - expect_lint(paste0(call_name, "('hello %1$s %1$s', x)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), NULL, linter) - expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), NULL, linter) + expect_no_lint(paste0(call_name, "('hello')"), linter) + expect_no_lint(paste0(call_name, "('hello %d', 1)"), linter) + expect_no_lint(paste0(call_name, "('hello %d', x)"), linter) + expect_no_lint(paste0(call_name, "('hello %d', x + 1)"), linter) + expect_no_lint(paste0(call_name, "('hello %d', f(x))"), linter) + expect_no_lint(paste0(call_name, "('hello %1$s %1$s', x)"), linter) + expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), linter) + expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), linter) }, .test_name = c("sprintf", "gettextf"), call_name = c("sprintf", "gettextf") @@ -66,24 +66,23 @@ test_that("edge cases are detected correctly", { linter <- sprintf_linter() # works with multi-line sprintf and comments - expect_lint( + expect_no_lint( trim_some(" sprintf( 'test fmt %s', # this is a comment 2 ) "), - NULL, linter ) # dots - expect_lint("sprintf('%d %d, %d', id, ...)", NULL, linter) + expect_no_lint("sprintf('%d %d, %d', id, ...)", linter) # TODO(#1265) extend ... detection to at least test for too many arguments. # named argument fmt - expect_lint("sprintf(x, fmt = 'hello %1$s %1$s')", NULL, linter) + expect_no_lint("sprintf(x, fmt = 'hello %1$s %1$s')", linter) expect_lint( "sprintf(x, fmt = 'hello %1$s %1$s %3$d', y)", @@ -92,7 +91,7 @@ test_that("edge cases are detected correctly", { ) # #2131: xml2lang stripped necessary whitespace - expect_lint("sprintf('%s', if (A) '' else y)", NULL, linter) + expect_no_lint("sprintf('%s', if (A) '' else y)", linter) }) local({ @@ -103,13 +102,13 @@ local({ patrick::with_parameters_test_that( "piping into sprintf works", { - expect_lint(paste("x", pipe, "sprintf(fmt = '%s')"), NULL, linter) + expect_no_lint(paste("x", pipe, "sprintf(fmt = '%s')"), linter) # no fmt= specified -> this is just 'sprintf("%s", "%s%s")', which won't lint - expect_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), NULL, linter) + expect_no_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), linter) expect_lint(paste("x", pipe, "sprintf(fmt = '%s%s')"), unused_fmt_msg, linter) # Cannot evaluate statically --> skip - expect_lint(paste("x", pipe, 'sprintf("a")'), NULL, linter) + expect_no_lint(paste("x", pipe, 'sprintf("a")'), linter) # Nested pipes expect_lint( paste("'%%sb'", pipe, "sprintf('%s')", pipe, "sprintf('a')"), @@ -132,6 +131,26 @@ local({ ) }) +test_that("pipe logic survives adversarial comments", { + linter <- sprintf_linter() + + expect_no_lint( + trim_some(" + x |> # comment + sprintf(fmt = '%s') + "), + linter + ) + + expect_no_lint( + trim_some(' + "%s" %>% # comment + sprintf("%s%s") + '), + linter + ) +}) + test_that("lints vectorize", { skip_if_not_r_version("4.1.0") diff --git a/tests/testthat/test-string_boundary_linter.R b/tests/testthat/test-string_boundary_linter.R index 54f915ae72..7e02c658d2 100644 --- a/tests/testthat/test-string_boundary_linter.R +++ b/tests/testthat/test-string_boundary_linter.R @@ -102,6 +102,16 @@ test_that("string_boundary_linter blocks disallowed substr()/substring() usage", expect_lint("substring(x, start, nchar(x)) == 'abcde'", ends_message, linter) # more complicated expressions expect_lint("substring(colnames(x), start, nchar(colnames(x))) == 'abc'", ends_message, linter) + + # adversarial comments + expect_lint( + trim_some(" + substring(colnames(x), start, nchar(colnames( # comment + x))) == 'abc' + "), + ends_message, + linter + ) }) test_that("plain ^ or $ are skipped", { diff --git a/tests/testthat/test-strings_as_factors_linter.R b/tests/testthat/test-strings_as_factors_linter.R index a45624b808..52c5705105 100644 --- a/tests/testthat/test-strings_as_factors_linter.R +++ b/tests/testthat/test-strings_as_factors_linter.R @@ -1,22 +1,34 @@ test_that("strings_as_factors_linter skips allowed usages", { linter <- strings_as_factors_linter() - expect_lint("data.frame(1:3)", NULL, linter) - expect_lint("data.frame(x = 1:3)", NULL, linter) + expect_no_lint("data.frame(1:3)", linter) + expect_no_lint("data.frame(x = 1:3)", linter) - expect_lint("data.frame(x = 'a', stringsAsFactors = TRUE)", NULL, linter) - expect_lint("data.frame(x = 'a', stringsAsFactors = FALSE)", NULL, linter) - expect_lint("data.frame(x = c('a', 'b'), stringsAsFactors = FALSE)", NULL, linter) + expect_no_lint("data.frame(x = 'a', stringsAsFactors = TRUE)", linter) + expect_no_lint("data.frame(x = 'a', stringsAsFactors = FALSE)", linter) + expect_no_lint("data.frame(x = c('a', 'b'), stringsAsFactors = FALSE)", linter) # strings in argument names to c() don't get linted - expect_lint("data.frame(x = c('a b' = 1L, 'b c' = 2L))", NULL, linter) + expect_no_lint("data.frame(x = c('a b' = 1L, 'b c' = 2L))", linter) # characters supplied to row.names are not affected - expect_lint("data.frame(x = 1:3, row.names = c('a', 'b', 'c'))", NULL, linter) + expect_no_lint("data.frame(x = 1:3, row.names = c('a', 'b', 'c'))", linter) # ambiguous cases passes - expect_lint("data.frame(x = c(xx, 'a'))", NULL, linter) - expect_lint("data.frame(x = c(foo(y), 'a'))", NULL, linter) + expect_no_lint("data.frame(x = c(xx, 'a'))", linter) + expect_no_lint("data.frame(x = c(foo(y), 'a'))", linter) + + # adversarial comments + expect_no_lint( + trim_some(" + data.frame( + x = 1:3, + row.names # comment + = c('a', 'b', 'c') + ) + "), + linter + ) }) test_that("strings_as_factors_linter blocks simple disallowed usages", { @@ -44,8 +56,8 @@ test_that("strings_as_factors_linters catches rep(char) usages", { expect_lint("data.frame(rep(c('a', 'b'), 10L))", lint_msg, linter) # literal char, not mixed or non-char - expect_lint("data.frame(rep(1L, 10L))", NULL, linter) - expect_lint("data.frame(rep(c(x, 'a'), 10L))", NULL, linter) + expect_no_lint("data.frame(rep(1L, 10L))", linter) + expect_no_lint("data.frame(rep(c(x, 'a'), 10L))", linter) # however, type promotion of literals is caught expect_lint("data.frame(rep(c(TRUE, 'a'), 10L))", lint_msg, linter) }) @@ -59,7 +71,7 @@ test_that("strings_as_factors_linter catches character(), as.character() usages" expect_lint("data.frame(a = as.character(x))", lint_msg, linter) # but not for row.names - expect_lint("data.frame(a = 1:10, row.names = as.character(1:10))", NULL, linter) + expect_no_lint("data.frame(a = 1:10, row.names = as.character(1:10))", linter) }) test_that("strings_as_factors_linter catches more functions with string output", { @@ -74,7 +86,7 @@ test_that("strings_as_factors_linter catches more functions with string output", expect_lint("data.frame(a = toString(x))", lint_msg, linter) expect_lint("data.frame(a = encodeString(x))", lint_msg, linter) # but not for row.names - expect_lint("data.frame(a = 1:10, row.names = paste(1:10))", NULL, linter) + expect_no_lint("data.frame(a = 1:10, row.names = paste(1:10))", linter) }) test_that("lints vectorize", { diff --git a/tests/testthat/test-unnecessary_concatenation_linter.R b/tests/testthat/test-unnecessary_concatenation_linter.R index 55abd21b04..1800f3490c 100644 --- a/tests/testthat/test-unnecessary_concatenation_linter.R +++ b/tests/testthat/test-unnecessary_concatenation_linter.R @@ -1,13 +1,13 @@ test_that("unnecessary_concatenation_linter skips allowed usages", { linter <- unnecessary_concatenation_linter() - expect_lint("c(x)", NULL, linter) - expect_lint("c(1, 2)", NULL, linter) - expect_lint("c(x, recursive = TRUE)", NULL, linter) - expect_lint("c(1, recursive = FALSE)", NULL, linter) - expect_lint("lapply(1, c)", NULL, linter) - expect_lint("c(a = 1)", NULL, linter) - expect_lint("c('a' = 1)", NULL, linter) + expect_no_lint("c(x)", linter) + expect_no_lint("c(1, 2)", linter) + expect_no_lint("c(x, recursive = TRUE)", linter) + expect_no_lint("c(1, recursive = FALSE)", linter) + expect_no_lint("lapply(1, c)", linter) + expect_no_lint("c(a = 1)", linter) + expect_no_lint("c('a' = 1)", linter) }) test_that("unnecessary_concatenation_linter blocks disallowed usages", { @@ -54,7 +54,7 @@ local({ patrick::with_parameters_test_that( "Correctly handles concatenation within magrittr pipes", { - expect_lint(sprintf('"a" %s c("b")', pipe), NULL, linter) + expect_no_lint(sprintf('"a" %s c("b")', pipe), linter) expect_lint(sprintf('"a" %s c()', pipe), const_msg, linter) expect_lint(sprintf('"a" %s list("b", c())', pipe), no_arg_msg, linter) }, @@ -63,14 +63,24 @@ local({ ) }) +test_that("logic survives adversarial comments", { + expect_no_lint( + trim_some(' + "a" %T>% # comment + c("b") + '), + unnecessary_concatenation_linter() + ) +}) + test_that("symbolic expressions are allowed, except by request", { linter <- unnecessary_concatenation_linter() linter_strict <- unnecessary_concatenation_linter(allow_single_expression = FALSE) lint_msg <- rex::rex("Remove unnecessary c() of a constant expression.") - expect_lint("c(alpha / 2)", NULL, linter) - expect_lint("c(paste0('.', 1:2))", NULL, linter) - expect_lint("c(DF[cond > 1, col])", NULL, linter) + expect_no_lint("c(alpha / 2)", linter) + expect_no_lint("c(paste0('.', 1:2))", linter) + expect_no_lint("c(DF[cond > 1, col])", linter) # allow_single_expression = FALSE turns both into lints expect_lint("c(alpha / 2)", lint_msg, linter_strict) @@ -89,24 +99,24 @@ test_that("sequences with : are linted whenever a constant is involved", { # this is slightly different if a,b are factors, in which case : does # something like interaction - expect_lint("c(a:b)", NULL, linter) + expect_no_lint("c(a:b)", linter) expect_lint("c(a:b)", expr_msg, linter_strict) - expect_lint("c(a:foo(b))", NULL, linter) + expect_no_lint("c(a:foo(b))", linter) expect_lint("c(a:foo(b))", expr_msg, linter_strict) }) test_that("c(...) does not lint under !allow_single_expression", { - expect_lint("c(...)", NULL, unnecessary_concatenation_linter(allow_single_expression = FALSE)) + expect_no_lint("c(...)", unnecessary_concatenation_linter(allow_single_expression = FALSE)) }) test_that("invalid allow_single_expression argument produce informative error messages", { expect_error( - expect_lint("c()", NULL, unnecessary_concatenation_linter(allow_single_expression = 1.0)), + expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = 1.0)), rex::rex("is.logical(allow_single_expression) is not TRUE") ) expect_error( - expect_lint("c()", NULL, unnecessary_concatenation_linter(allow_single_expression = c(TRUE, FALSE))), + expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = c(TRUE, FALSE))), rex::rex("length(allow_single_expression) == 1L is not TRUE") ) }) diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index 44655b44b7..f3228058b0 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -161,6 +161,15 @@ test_that("unnecessary_lambda_linter doesn't apply to keyword args", { expect_no_lint("lapply(x, function(xi) data.frame(nm = xi))", linter) expect_no_lint("lapply(x, function(xi) return(data.frame(nm = xi)))", linter) + + # adversarially commented + expect_no_lint( + trim_some(" + lapply(x, function(xi) data.frame(nm = # comment + xi)) + "), + linter + ) }) test_that("purrr-style anonymous functions are also caught", { @@ -185,6 +194,15 @@ test_that("purrr-style anonymous functions are also caught", { rex::rex("Pass foo directly as a symbol to map_vec()"), linter ) + + # adversarial comment + expect_no_lint( + trim_some(" + map_dbl(x, ~foo(bar = # comment + .x)) + "), + linter + ) }) test_that("cases with braces are caught", { @@ -246,6 +264,16 @@ test_that("cases with braces are caught", { # false positives like #2231, #2247 are avoided with braces too expect_no_lint("lapply(x, function(xi) { foo(xi)$bar })", linter) expect_no_lint("lapply(x, function(xi) { foo(xi) - 1 })", linter) + + expect_lint( + trim_some(" + lapply(y, function(yi) { + print(yi) # comment + }) + "), + lint_msg, + linter + ) }) test_that("function shorthand is handled", { diff --git a/tests/testthat/test-unnecessary_placeholder_linter.R b/tests/testthat/test-unnecessary_placeholder_linter.R index 8ee413a4b9..d69cbf3ed8 100644 --- a/tests/testthat/test-unnecessary_placeholder_linter.R +++ b/tests/testthat/test-unnecessary_placeholder_linter.R @@ -53,3 +53,13 @@ test_that("lints vectorize", { # nofuzz unnecessary_placeholder_linter() ) }) + +test_that("logic survives adversarial commenting", { + expect_no_lint( + trim_some(" + x %T>% foo(arg = # comment + .) + "), + unnecessary_placeholder_linter() + ) +}) From 30fcdf7e09f993bae0926d904525f243bddb83c7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 21:21:14 +0000 Subject: [PATCH 2/8] remove those under #2827 --- R/fixed_regex_linter.R | 2 +- R/outer_negation_linter.R | 2 +- R/sprintf_linter.R | 9 ++-- R/unnecessary_concatenation_linter.R | 2 +- R/unnecessary_lambda_linter.R | 15 ++---- tests/testthat/test-fixed_regex_linter.R | 17 ++----- tests/testthat/test-object_length_linter.R | 10 ---- tests/testthat/test-object_name_linter.R | 10 ---- tests/testthat/test-outer_negation_linter.R | 36 +++++-------- tests/testthat/test-sprintf_linter.R | 51 ++++++------------- .../test-unnecessary_concatenation_linter.R | 42 ++++++--------- .../testthat/test-unnecessary_lambda_linter.R | 28 ---------- 12 files changed, 57 insertions(+), 167 deletions(-) diff --git a/R/fixed_regex_linter.R b/R/fixed_regex_linter.R index 6655cda0ce..5ab8680d5c 100644 --- a/R/fixed_regex_linter.R +++ b/R/fixed_regex_linter.R @@ -120,7 +120,7 @@ fixed_regex_linter <- function(allow_unescaped = FALSE) { and not({ in_pipe_cond }) ) or ( STR_CONST - and preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB/text() = 'pattern'] + and preceding-sibling::*[2][self::SYMBOL_SUB/text() = 'pattern'] ) ] ") diff --git a/R/outer_negation_linter.R b/R/outer_negation_linter.R index 584573fd67..6a5ce6e180 100644 --- a/R/outer_negation_linter.R +++ b/R/outer_negation_linter.R @@ -44,7 +44,7 @@ outer_negation_linter <- function() { not(expr[ position() > 1 and not(OP-EXCLAMATION) - and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]) + and not(preceding-sibling::*[1][self::EQ_SUB]) ]) ] " diff --git a/R/sprintf_linter.R b/R/sprintf_linter.R index fb06af1732..1eb3b345d2 100644 --- a/R/sprintf_linter.R +++ b/R/sprintf_linter.R @@ -38,12 +38,9 @@ sprintf_linter <- function() { pipes <- setdiff(magrittr_pipes, "%$%") in_pipe_xpath <- glue("self::expr[ - preceding-sibling::*[not(self::COMMENT)][1][ - self::PIPE - or self::SPECIAL[{ xp_text_in_table(pipes) } - ]] + preceding-sibling::*[1][self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }]] and ( - preceding-sibling::*[not(self::COMMENT)][2]/STR_CONST + preceding-sibling::*[2]/STR_CONST or SYMBOL_SUB[text() = 'fmt']/following-sibling::expr[1]/STR_CONST ) ]") @@ -92,7 +89,7 @@ sprintf_linter <- function() { arg_idx <- 2L:length(parsed_expr) parsed_expr[arg_idx + 1L] <- parsed_expr[arg_idx] names(parsed_expr)[arg_idx + 1L] <- arg_names[arg_idx] - parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[not(self::COMMENT)][2]")) + parsed_expr[[2L]] <- xml2lang(xml_find_first(xml, "preceding-sibling::*[2]")) names(parsed_expr)[2L] <- "" } parsed_expr <- zap_extra_args(parsed_expr) diff --git a/R/unnecessary_concatenation_linter.R b/R/unnecessary_concatenation_linter.R index 519662a910..271d2ece6a 100644 --- a/R/unnecessary_concatenation_linter.R +++ b/R/unnecessary_concatenation_linter.R @@ -66,7 +66,7 @@ unnecessary_concatenation_linter <- function(allow_single_expression = TRUE) { # pipes <- setdiff(magrittr_pipes, "%$%") to_pipe_xpath <- glue(" - ./preceding-sibling::*[not(self::COMMENT)][1][ + ./preceding-sibling::*[1][ self::PIPE or self::SPECIAL[{ xp_text_in_table(pipes) }] ] diff --git a/R/unnecessary_lambda_linter.R b/R/unnecessary_lambda_linter.R index 76dbf9c6bc..f2f62232d8 100644 --- a/R/unnecessary_lambda_linter.R +++ b/R/unnecessary_lambda_linter.R @@ -125,14 +125,10 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { .//expr[ position() = 2 and preceding-sibling::expr/SYMBOL_FUNCTION_CALL - and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]) + and not(preceding-sibling::*[1][self::EQ_SUB]) and not(parent::expr[ preceding-sibling::expr[not(SYMBOL_FUNCTION_CALL)] - or following-sibling::*[not( - self::OP-RIGHT-PAREN - or self::OP-RIGHT-BRACE - or self::COMMENT - )] + or following-sibling::*[not(self::OP-RIGHT-PAREN or self::OP-RIGHT-BRACE)] ]) ]/SYMBOL ] @@ -147,12 +143,7 @@ unnecessary_lambda_linter <- function(allow_comparison = FALSE) { purrr_fun_xpath <- glue(" following-sibling::expr[ OP-TILDE - and expr - /OP-LEFT-PAREN - /following-sibling::expr[1][ - not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB]) - ] - /{purrr_symbol} + and expr[OP-LEFT-PAREN/following-sibling::expr[1][not(preceding-sibling::*[2][self::SYMBOL_SUB])]/{purrr_symbol}] and not(expr/OP-LEFT-PAREN/following-sibling::expr[position() > 1]//{purrr_symbol}) ]") diff --git a/tests/testthat/test-fixed_regex_linter.R b/tests/testthat/test-fixed_regex_linter.R index 5ce25a2dd3..e0dcae72ec 100644 --- a/tests/testthat/test-fixed_regex_linter.R +++ b/tests/testthat/test-fixed_regex_linter.R @@ -352,13 +352,13 @@ test_that("'unescaped' regex can optionally be skipped", { }) local({ - linter <- fixed_regex_linter() - lint_msg <- "This regular expression is static" pipes <- pipes(exclude = c("%$%", "%T>%")) - patrick::with_parameters_test_that( "linter is pipe-aware", { + linter <- fixed_regex_linter() + lint_msg <- "This regular expression is static" + expect_lint(paste("x", pipe, "grepl(pattern = 'a')"), lint_msg, linter) expect_no_lint(paste("x", pipe, "grepl(pattern = '^a')"), linter) expect_no_lint(paste("x", pipe, "grepl(pattern = 'a', fixed = TRUE)"), linter) @@ -377,14 +377,3 @@ local({ .test_name = names(pipes) ) }) - -test_that("pipe-aware lint logic survives adversarial comments", { - expect_lint( - trim_some(" - x %>% grepl(pattern = # comment - 'a') - "), - "This regular expression is static", - fixed_regex_linter() - ) -}) diff --git a/tests/testthat/test-object_length_linter.R b/tests/testthat/test-object_length_linter.R index 051c6bf2f1..240c861923 100644 --- a/tests/testthat/test-object_length_linter.R +++ b/tests/testthat/test-object_length_linter.R @@ -104,14 +104,4 @@ test_that("literals in assign() and setGeneric() are checked", { expect_lint("assign(x = 'badBadBadBadName', 2, env)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', 'badBadBadBadName', 2)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', x = 'badBadBadBadName', 2)", lint_msg, linter) - - # adversarial comments - expect_lint( - trim_some(" - assign(envir = # comment - 'good_env_name', 'badBadBadBadName', 2) - "), - lint_msg, - linter - ) }) diff --git a/tests/testthat/test-object_name_linter.R b/tests/testthat/test-object_name_linter.R index ad09b06c7b..cdf6591c84 100644 --- a/tests/testthat/test-object_name_linter.R +++ b/tests/testthat/test-object_name_linter.R @@ -345,16 +345,6 @@ test_that("literals in assign() and setGeneric() are checked", { expect_lint("assign(x = 'badName', 2, env)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', 'badName', 2)", lint_msg, linter) expect_lint("assign(envir = 'good_env_name', x = 'badName', 2)", lint_msg, linter) - - # adversarial comments - expect_lint( - trim_some(" - assign(envir = # comment - 'good_env_name', 'badName', 2) - "), - lint_msg, - linter - ) }) test_that("generics assigned with '=' or <<- are registered", { diff --git a/tests/testthat/test-outer_negation_linter.R b/tests/testthat/test-outer_negation_linter.R index aa18761f1a..0601aa4ee0 100644 --- a/tests/testthat/test-outer_negation_linter.R +++ b/tests/testthat/test-outer_negation_linter.R @@ -1,20 +1,20 @@ test_that("outer_negation_linter skips allowed usages", { linter <- outer_negation_linter() - expect_no_lint("x <- any(y)", linter) - expect_no_lint("y <- all(z)", linter) + expect_lint("x <- any(y)", NULL, linter) + expect_lint("y <- all(z)", NULL, linter) # extended usage of any is not covered - expect_no_lint("any(!a & b)", linter) - expect_no_lint("all(a | !b)", linter) - - expect_no_lint("any(a, b)", linter) - expect_no_lint("all(b, c)", linter) - expect_no_lint("any(!a, b)", linter) - expect_no_lint("all(a, !b)", linter) - expect_no_lint("any(a, !b, na.rm = TRUE)", linter) + expect_lint("any(!a & b)", NULL, linter) + expect_lint("all(a | !b)", NULL, linter) + + expect_lint("any(a, b)", NULL, linter) + expect_lint("all(b, c)", NULL, linter) + expect_lint("any(!a, b)", NULL, linter) + expect_lint("all(a, !b)", NULL, linter) + expect_lint("any(a, !b, na.rm = TRUE)", NULL, linter) # ditto when na.rm is passed quoted - expect_no_lint("any(a, !b, 'na.rm' = TRUE)", linter) + expect_lint("any(a, !b, 'na.rm' = TRUE)", NULL, linter) }) test_that("outer_negation_linter blocks simple disallowed usages", { @@ -31,25 +31,15 @@ test_that("outer_negation_linter blocks simple disallowed usages", { # catch when all inputs are negated expect_lint("any(!x, !y)", not_all_msg, linter) expect_lint("all(!x, !y, na.rm = TRUE)", not_any_msg, linter) - - # adversarial comment - expect_lint( - trim_some(" - any(!x, na.rm = # comment - TRUE) - "), - not_all_msg, - linter - ) }) test_that("outer_negation_linter doesn't trigger on empty calls", { linter <- outer_negation_linter() # minimal version of issue - expect_no_lint("any()", linter) + expect_lint("any()", NULL, linter) # closer to what was is practically relevant, as another regression test - expect_no_lint("x %>% any()", linter) + expect_lint("x %>% any()", NULL, linter) }) test_that("lints vectorize", { diff --git a/tests/testthat/test-sprintf_linter.R b/tests/testthat/test-sprintf_linter.R index 7fc6fa27d3..e0626a974d 100644 --- a/tests/testthat/test-sprintf_linter.R +++ b/tests/testthat/test-sprintf_linter.R @@ -4,14 +4,14 @@ patrick::with_parameters_test_that( linter <- sprintf_linter() # NB: using paste0, not sprintf, to avoid escaping '%d' in sprint fmt= - expect_no_lint(paste0(call_name, "('hello')"), linter) - expect_no_lint(paste0(call_name, "('hello %d', 1)"), linter) - expect_no_lint(paste0(call_name, "('hello %d', x)"), linter) - expect_no_lint(paste0(call_name, "('hello %d', x + 1)"), linter) - expect_no_lint(paste0(call_name, "('hello %d', f(x))"), linter) - expect_no_lint(paste0(call_name, "('hello %1$s %1$s', x)"), linter) - expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), linter) - expect_no_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), linter) + expect_lint(paste0(call_name, "('hello')"), NULL, linter) + expect_lint(paste0(call_name, "('hello %d', 1)"), NULL, linter) + expect_lint(paste0(call_name, "('hello %d', x)"), NULL, linter) + expect_lint(paste0(call_name, "('hello %d', x + 1)"), NULL, linter) + expect_lint(paste0(call_name, "('hello %d', f(x))"), NULL, linter) + expect_lint(paste0(call_name, "('hello %1$s %1$s', x)"), NULL, linter) + expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d', x, y)"), NULL, linter) + expect_lint(paste0(call_name, "('hello %1$s %1$s %2$d %3$s', x, y, 1.5)"), NULL, linter) }, .test_name = c("sprintf", "gettextf"), call_name = c("sprintf", "gettextf") @@ -66,23 +66,24 @@ test_that("edge cases are detected correctly", { linter <- sprintf_linter() # works with multi-line sprintf and comments - expect_no_lint( + expect_lint( trim_some(" sprintf( 'test fmt %s', # this is a comment 2 ) "), + NULL, linter ) # dots - expect_no_lint("sprintf('%d %d, %d', id, ...)", linter) + expect_lint("sprintf('%d %d, %d', id, ...)", NULL, linter) # TODO(#1265) extend ... detection to at least test for too many arguments. # named argument fmt - expect_no_lint("sprintf(x, fmt = 'hello %1$s %1$s')", linter) + expect_lint("sprintf(x, fmt = 'hello %1$s %1$s')", NULL, linter) expect_lint( "sprintf(x, fmt = 'hello %1$s %1$s %3$d', y)", @@ -91,7 +92,7 @@ test_that("edge cases are detected correctly", { ) # #2131: xml2lang stripped necessary whitespace - expect_no_lint("sprintf('%s', if (A) '' else y)", linter) + expect_lint("sprintf('%s', if (A) '' else y)", NULL, linter) }) local({ @@ -102,13 +103,13 @@ local({ patrick::with_parameters_test_that( "piping into sprintf works", { - expect_no_lint(paste("x", pipe, "sprintf(fmt = '%s')"), linter) + expect_lint(paste("x", pipe, "sprintf(fmt = '%s')"), NULL, linter) # no fmt= specified -> this is just 'sprintf("%s", "%s%s")', which won't lint - expect_no_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), linter) + expect_lint(paste('"%s"', pipe, 'sprintf("%s%s")'), NULL, linter) expect_lint(paste("x", pipe, "sprintf(fmt = '%s%s')"), unused_fmt_msg, linter) # Cannot evaluate statically --> skip - expect_no_lint(paste("x", pipe, 'sprintf("a")'), linter) + expect_lint(paste("x", pipe, 'sprintf("a")'), NULL, linter) # Nested pipes expect_lint( paste("'%%sb'", pipe, "sprintf('%s')", pipe, "sprintf('a')"), @@ -131,26 +132,6 @@ local({ ) }) -test_that("pipe logic survives adversarial comments", { - linter <- sprintf_linter() - - expect_no_lint( - trim_some(" - x |> # comment - sprintf(fmt = '%s') - "), - linter - ) - - expect_no_lint( - trim_some(' - "%s" %>% # comment - sprintf("%s%s") - '), - linter - ) -}) - test_that("lints vectorize", { skip_if_not_r_version("4.1.0") diff --git a/tests/testthat/test-unnecessary_concatenation_linter.R b/tests/testthat/test-unnecessary_concatenation_linter.R index 1800f3490c..55abd21b04 100644 --- a/tests/testthat/test-unnecessary_concatenation_linter.R +++ b/tests/testthat/test-unnecessary_concatenation_linter.R @@ -1,13 +1,13 @@ test_that("unnecessary_concatenation_linter skips allowed usages", { linter <- unnecessary_concatenation_linter() - expect_no_lint("c(x)", linter) - expect_no_lint("c(1, 2)", linter) - expect_no_lint("c(x, recursive = TRUE)", linter) - expect_no_lint("c(1, recursive = FALSE)", linter) - expect_no_lint("lapply(1, c)", linter) - expect_no_lint("c(a = 1)", linter) - expect_no_lint("c('a' = 1)", linter) + expect_lint("c(x)", NULL, linter) + expect_lint("c(1, 2)", NULL, linter) + expect_lint("c(x, recursive = TRUE)", NULL, linter) + expect_lint("c(1, recursive = FALSE)", NULL, linter) + expect_lint("lapply(1, c)", NULL, linter) + expect_lint("c(a = 1)", NULL, linter) + expect_lint("c('a' = 1)", NULL, linter) }) test_that("unnecessary_concatenation_linter blocks disallowed usages", { @@ -54,7 +54,7 @@ local({ patrick::with_parameters_test_that( "Correctly handles concatenation within magrittr pipes", { - expect_no_lint(sprintf('"a" %s c("b")', pipe), linter) + expect_lint(sprintf('"a" %s c("b")', pipe), NULL, linter) expect_lint(sprintf('"a" %s c()', pipe), const_msg, linter) expect_lint(sprintf('"a" %s list("b", c())', pipe), no_arg_msg, linter) }, @@ -63,24 +63,14 @@ local({ ) }) -test_that("logic survives adversarial comments", { - expect_no_lint( - trim_some(' - "a" %T>% # comment - c("b") - '), - unnecessary_concatenation_linter() - ) -}) - test_that("symbolic expressions are allowed, except by request", { linter <- unnecessary_concatenation_linter() linter_strict <- unnecessary_concatenation_linter(allow_single_expression = FALSE) lint_msg <- rex::rex("Remove unnecessary c() of a constant expression.") - expect_no_lint("c(alpha / 2)", linter) - expect_no_lint("c(paste0('.', 1:2))", linter) - expect_no_lint("c(DF[cond > 1, col])", linter) + expect_lint("c(alpha / 2)", NULL, linter) + expect_lint("c(paste0('.', 1:2))", NULL, linter) + expect_lint("c(DF[cond > 1, col])", NULL, linter) # allow_single_expression = FALSE turns both into lints expect_lint("c(alpha / 2)", lint_msg, linter_strict) @@ -99,24 +89,24 @@ test_that("sequences with : are linted whenever a constant is involved", { # this is slightly different if a,b are factors, in which case : does # something like interaction - expect_no_lint("c(a:b)", linter) + expect_lint("c(a:b)", NULL, linter) expect_lint("c(a:b)", expr_msg, linter_strict) - expect_no_lint("c(a:foo(b))", linter) + expect_lint("c(a:foo(b))", NULL, linter) expect_lint("c(a:foo(b))", expr_msg, linter_strict) }) test_that("c(...) does not lint under !allow_single_expression", { - expect_no_lint("c(...)", unnecessary_concatenation_linter(allow_single_expression = FALSE)) + expect_lint("c(...)", NULL, unnecessary_concatenation_linter(allow_single_expression = FALSE)) }) test_that("invalid allow_single_expression argument produce informative error messages", { expect_error( - expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = 1.0)), + expect_lint("c()", NULL, unnecessary_concatenation_linter(allow_single_expression = 1.0)), rex::rex("is.logical(allow_single_expression) is not TRUE") ) expect_error( - expect_no_lint("c()", unnecessary_concatenation_linter(allow_single_expression = c(TRUE, FALSE))), + expect_lint("c()", NULL, unnecessary_concatenation_linter(allow_single_expression = c(TRUE, FALSE))), rex::rex("length(allow_single_expression) == 1L is not TRUE") ) }) diff --git a/tests/testthat/test-unnecessary_lambda_linter.R b/tests/testthat/test-unnecessary_lambda_linter.R index f3228058b0..44655b44b7 100644 --- a/tests/testthat/test-unnecessary_lambda_linter.R +++ b/tests/testthat/test-unnecessary_lambda_linter.R @@ -161,15 +161,6 @@ test_that("unnecessary_lambda_linter doesn't apply to keyword args", { expect_no_lint("lapply(x, function(xi) data.frame(nm = xi))", linter) expect_no_lint("lapply(x, function(xi) return(data.frame(nm = xi)))", linter) - - # adversarially commented - expect_no_lint( - trim_some(" - lapply(x, function(xi) data.frame(nm = # comment - xi)) - "), - linter - ) }) test_that("purrr-style anonymous functions are also caught", { @@ -194,15 +185,6 @@ test_that("purrr-style anonymous functions are also caught", { rex::rex("Pass foo directly as a symbol to map_vec()"), linter ) - - # adversarial comment - expect_no_lint( - trim_some(" - map_dbl(x, ~foo(bar = # comment - .x)) - "), - linter - ) }) test_that("cases with braces are caught", { @@ -264,16 +246,6 @@ test_that("cases with braces are caught", { # false positives like #2231, #2247 are avoided with braces too expect_no_lint("lapply(x, function(xi) { foo(xi)$bar })", linter) expect_no_lint("lapply(x, function(xi) { foo(xi) - 1 })", linter) - - expect_lint( - trim_some(" - lapply(y, function(yi) { - print(yi) # comment - }) - "), - lint_msg, - linter - ) }) test_that("function shorthand is handled", { From 1e828168d95f0e050a94c52eb1d325b4b7e72c7b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 21:25:05 +0000 Subject: [PATCH 3/8] more in sync with #2827 in/out rule --- R/brace_linter.R | 2 +- R/conjunct_test_linter.R | 3 +- R/empty_assignment_linter.R | 2 +- tests/testthat/test-brace_linter.R | 18 +++++ tests/testthat/test-conjunct_test_linter.R | 71 ++++++++----------- tests/testthat/test-empty_assignment_linter.R | 9 ++- 6 files changed, 55 insertions(+), 50 deletions(-) diff --git a/R/brace_linter.R b/R/brace_linter.R index e20f974f8d..7d2c1a8921 100644 --- a/R/brace_linter.R +++ b/R/brace_linter.R @@ -134,7 +134,7 @@ brace_linter <- function(allow_single_line = FALSE, { xp_cond_closed } and ( (@line1 = preceding-sibling::*[1][not(self::OP-LEFT-BRACE)]/@line2) - or (@line1 = parent::expr/following-sibling::*[1][not(self::ELSE)]/@line1) + or (@line1 = parent::expr/following-sibling::*[not(self::COMMENT)][1][not(self::ELSE)]/@line1) ) ]") diff --git a/R/conjunct_test_linter.R b/R/conjunct_test_linter.R index 8fd825b4a8..95eee51507 100644 --- a/R/conjunct_test_linter.R +++ b/R/conjunct_test_linter.R @@ -82,8 +82,7 @@ conjunct_test_linter <- function(allow_named_stopifnot = TRUE, following-sibling::expr[1][AND2] /parent::expr " - named_stopifnot_condition <- - if (allow_named_stopifnot) "and not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])" else "" + named_stopifnot_condition <- if (allow_named_stopifnot) "and not(preceding-sibling::*[1][self::EQ_SUB])" else "" stopifnot_xpath <- glue(" following-sibling::expr[1][AND2 {named_stopifnot_condition}] /parent::expr diff --git a/R/empty_assignment_linter.R b/R/empty_assignment_linter.R index 2ea6027636..e5bd8aecff 100644 --- a/R/empty_assignment_linter.R +++ b/R/empty_assignment_linter.R @@ -33,7 +33,7 @@ empty_assignment_linter <- make_linter_from_xpath( # for some reason, the parent in the `=` case is , not , hence parent::expr xpath = " - //OP-LEFT-BRACE[following-sibling::*[1][self::OP-RIGHT-BRACE]] + //OP-LEFT-BRACE[following-sibling::*[not(self::COMMENT)][1][self::OP-RIGHT-BRACE]] /parent::expr[ preceding-sibling::LEFT_ASSIGN or preceding-sibling::EQ_ASSIGN diff --git a/tests/testthat/test-brace_linter.R b/tests/testthat/test-brace_linter.R index 9d2052f925..b645f240b6 100644 --- a/tests/testthat/test-brace_linter.R +++ b/tests/testthat/test-brace_linter.R @@ -1,3 +1,4 @@ +# nofuzz start test_that("brace_linter lints braces correctly", { open_curly_msg <- rex::rex( "Opening curly braces should never go on their own line" @@ -119,6 +120,22 @@ test_that("brace_linter lints braces correctly", { linter ) + # a comment after '}' is allowed + expect_no_lint( + trim_some(" + switch( + x, + 'a' = do_something(x), + 'b' = do_another(x), + { + do_first(x) + do_second(x) + } # comment + ) + "), + brace_linter() + ) + expect_no_lint( trim_some(" fun( @@ -650,3 +667,4 @@ test_that("test_that(code=) requires braces", { linter ) }) +# nofuzz end diff --git a/tests/testthat/test-conjunct_test_linter.R b/tests/testthat/test-conjunct_test_linter.R index d08e46d4f8..047d2456d4 100644 --- a/tests/testthat/test-conjunct_test_linter.R +++ b/tests/testthat/test-conjunct_test_linter.R @@ -1,25 +1,21 @@ test_that("conjunct_test_linter skips allowed usages of expect_true", { - linter <- conjunct_test_linter() - - expect_no_lint("expect_true(x)", linter) - expect_no_lint("testthat::expect_true(x, y, z)", linter) + expect_lint("expect_true(x)", NULL, conjunct_test_linter()) + expect_lint("testthat::expect_true(x, y, z)", NULL, conjunct_test_linter()) # more complicated expression - expect_no_lint("expect_true(x || (y && z))", linter) + expect_lint("expect_true(x || (y && z))", NULL, conjunct_test_linter()) # the same by operator precedence, though not obvious a priori - expect_no_lint("expect_true(x || y && z)", linter) - expect_no_lint("expect_true(x && y || z)", linter) + expect_lint("expect_true(x || y && z)", NULL, conjunct_test_linter()) + expect_lint("expect_true(x && y || z)", NULL, conjunct_test_linter()) }) test_that("conjunct_test_linter skips allowed usages of expect_true", { - linter <- conjunct_test_linter() - - expect_no_lint("expect_false(x)", linter) - expect_no_lint("testthat::expect_false(x, y, z)", linter) + expect_lint("expect_false(x)", NULL, conjunct_test_linter()) + expect_lint("testthat::expect_false(x, y, z)", NULL, conjunct_test_linter()) # more complicated expression # (NB: xx && yy || zz and xx || yy && zz both parse with || first) - expect_no_lint("expect_false(x && (y || z))", linter) + expect_lint("expect_false(x && (y || z))", NULL, conjunct_test_linter()) }) test_that("conjunct_test_linter blocks && conditions with expect_true()", { @@ -47,14 +43,14 @@ test_that("conjunct_test_linter blocks || conditions with expect_false()", { test_that("conjunct_test_linter skips allowed stopifnot() and assert_that() usages", { linter <- conjunct_test_linter() - expect_no_lint("stopifnot(x)", linter) - expect_no_lint("assert_that(x, y, z)", linter) + expect_lint("stopifnot(x)", NULL, linter) + expect_lint("assert_that(x, y, z)", NULL, linter) # more complicated expression - expect_no_lint("stopifnot(x || (y && z))", linter) + expect_lint("stopifnot(x || (y && z))", NULL, linter) # the same by operator precedence, though not obvious a priori - expect_no_lint("stopifnot(x || y && z)", linter) - expect_no_lint("assertthat::assert_that(x && y || z)", linter) + expect_lint("stopifnot(x || y && z)", NULL, linter) + expect_lint("assertthat::assert_that(x && y || z)", NULL, linter) }) test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() and assert_that()", { @@ -70,23 +66,12 @@ test_that("conjunct_test_linter blocks simple disallowed usages of stopifnot() a }) test_that("conjunct_test_linter's allow_named_stopifnot argument works", { - linter <- conjunct_test_linter() - # allowed by default - expect_no_lint( + expect_lint( "stopifnot('x must be a logical scalar' = length(x) == 1 && is.logical(x) && !is.na(x))", - linter - ) - # including with intervening comment - expect_no_lint( - trim_some(" - stopifnot('x must be a logical scalar' = # comment - length(x) == 1 && is.logical(x) && !is.na(x) - ) - "), - linter + NULL, + conjunct_test_linter() ) - expect_lint( "stopifnot('x is a logical scalar' = length(x) == 1 && is.logical(x) && !is.na(x))", rex::rex("Write multiple conditions like stopifnot(A, B)"), @@ -97,11 +82,11 @@ test_that("conjunct_test_linter's allow_named_stopifnot argument works", { test_that("conjunct_test_linter skips allowed usages", { linter <- conjunct_test_linter() - expect_no_lint("dplyr::filter(DF, A, B)", linter) - expect_no_lint("dplyr::filter(DF, !(A & B))", linter) + expect_lint("dplyr::filter(DF, A, B)", NULL, linter) + expect_lint("dplyr::filter(DF, !(A & B))", NULL, linter) # | is the "top-level" operator here - expect_no_lint("dplyr::filter(DF, A & B | C)", linter) - expect_no_lint("dplyr::filter(DF, A | B & C)", linter) + expect_lint("dplyr::filter(DF, A & B | C)", NULL, linter) + expect_lint("dplyr::filter(DF, A | B & C)", NULL, linter) }) test_that("conjunct_test_linter blocks simple disallowed usages", { @@ -120,22 +105,22 @@ test_that("conjunct_test_linter respects its allow_filter argument", { linter_dplyr <- conjunct_test_linter(allow_filter = "not_dplyr") lint_msg <- rex::rex("Use dplyr::filter(DF, A, B) instead of dplyr::filter(DF, A & B)") - expect_no_lint("dplyr::filter(DF, A & B)", linter_always) - expect_no_lint("dplyr::filter(DF, A & B & C)", linter_always) - expect_no_lint("DF %>% dplyr::filter(A & B)", linter_always) + expect_lint("dplyr::filter(DF, A & B)", NULL, linter_always) + expect_lint("dplyr::filter(DF, A & B & C)", NULL, linter_always) + expect_lint("DF %>% dplyr::filter(A & B)", NULL, linter_always) expect_lint("dplyr::filter(DF, A & B)", lint_msg, linter_dplyr) expect_lint("dplyr::filter(DF, A & B & C)", lint_msg, linter_dplyr) expect_lint("DF %>% dplyr::filter(A & B)", lint_msg, linter_dplyr) - expect_no_lint("filter(DF, A & B)", linter_dplyr) - expect_no_lint("filter(DF, A & B & C)", linter_dplyr) - expect_no_lint("DF %>% filter(A & B)", linter_dplyr) + expect_lint("filter(DF, A & B)", NULL, linter_dplyr) + expect_lint("filter(DF, A & B & C)", NULL, linter_dplyr) + expect_lint("DF %>% filter(A & B)", NULL, linter_dplyr) }) test_that("filter() is assumed to be dplyr::filter() by default, unless o/w specified", { linter <- conjunct_test_linter() - expect_no_lint("stats::filter(A & B)", linter) - expect_no_lint("ns::filter(A & B)", linter) + expect_lint("stats::filter(A & B)", NULL, linter) + expect_lint("ns::filter(A & B)", NULL, linter) expect_lint( "DF %>% filter(A & B)", rex::rex("Use dplyr::filter(DF, A, B) instead of dplyr::filter(DF, A & B)"), diff --git a/tests/testthat/test-empty_assignment_linter.R b/tests/testthat/test-empty_assignment_linter.R index 8bf39b34ae..a2b7e50f6d 100644 --- a/tests/testthat/test-empty_assignment_linter.R +++ b/tests/testthat/test-empty_assignment_linter.R @@ -1,9 +1,11 @@ test_that("empty_assignment_linter skips valid usage", { - expect_lint("x <- { 3 + 4 }", NULL, empty_assignment_linter()) - expect_lint("x <- if (x > 1) { 3 + 4 }", NULL, empty_assignment_linter()) + linter <- empty_assignment_linter() + + expect_no_lint("x <- { 3 + 4 }", linter) + expect_no_lint("x <- if (x > 1) { 3 + 4 }", linter) # also triggers assignment_linter - expect_lint("x = { 3 + 4 }", NULL, empty_assignment_linter()) + expect_no_lint("x = { 3 + 4 }", linter) }) test_that("empty_assignment_linter blocks disallowed usages", { @@ -24,6 +26,7 @@ test_that("empty_assignment_linter blocks disallowed usages", { # newlines also don't matter expect_lint("x <- {\n}", lint_msg, linter) + expect_lint("x <- { # comment\n}", lint_msg, linter) # LHS of assignment doesn't matter expect_lint("env$obj <- {}", lint_msg, linter) From 0884c3a118f278a95434ee5c5ca56008e3a0b183 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 21:29:18 +0000 Subject: [PATCH 4/8] need known_safe --- R/utils.R | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/R/utils.R b/R/utils.R index 09c97152bf..51f36a9d66 100644 --- a/R/utils.R +++ b/R/utils.R @@ -85,20 +85,20 @@ names2 <- function(x) { names(x) %||% rep("", length(x)) } -get_content <- function(lines, info) { +get_content <- function(lines, info, known_safe = TRUE) { lines[is.na(lines)] <- "" if (!missing(info)) { + # put in data.frame-like format if (is_node(info)) { - info <- lapply(stats::setNames(nm = c("col1", "col2", "line1", "line2")), function(attr) { - as.integer(xml_attr(info, attr)) - }) + info <- lapply(xml2::xml_attrs(info), as.integer) } lines <- lines[seq(info$line1, info$line2)] lines[length(lines)] <- substr(lines[length(lines)], 1L, info$col2) lines[1L] <- substr(lines[1L], info$col1, nchar(lines[1L])) } + if (!known_safe) lines <- c("{", lines, "}") paste(lines, collapse = "\n") } From 6f1e6060b125fe626505df6aa81bd39770ad6ff9 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 22:03:39 +0000 Subject: [PATCH 5/8] delint --- R/if_switch_linter.R | 1 - R/string_boundary_linter.R | 4 +--- 2 files changed, 1 insertion(+), 4 deletions(-) diff --git a/R/if_switch_linter.R b/R/if_switch_linter.R index 3cd4e6653b..815236de0b 100644 --- a/R/if_switch_linter.R +++ b/R/if_switch_linter.R @@ -206,7 +206,6 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L) ") # not(. != .): don't match if there are _any_ expr which _don't_ match the top expr - # do this as a second step to equality_test_cond <- glue("self::*[ .//expr/IF/following-sibling::{equal_str_cond}/expr[not(STR_CONST)] != expr[1][EQ]/expr[not(STR_CONST)] diff --git a/R/string_boundary_linter.R b/R/string_boundary_linter.R index 536556085d..3356dc1a29 100644 --- a/R/string_boundary_linter.R +++ b/R/string_boundary_linter.R @@ -1,4 +1,4 @@ -#' Require usage of `startsWith()` and `endsWith()` over `grepl()`/`substr()` versions + #' Require usage of `startsWith()` and `endsWith()` over `grepl()`/`substr()` versions #' #' [startsWith()] is used to detect fixed initial substrings; it is more #' readable and more efficient than equivalents using [grepl()] or [substr()]. @@ -132,8 +132,6 @@ 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) { - xml <- source_expression$xml_parsed_content - lints <- list() str_detect_lint_data <- get_regex_lint_data( From 270638a510a6be5204bbf5d647c507bf6ed693dd Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 22:11:55 +0000 Subject: [PATCH 6/8] add a comment --- R/object_usage_linter.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index e707fd482c..63ce3f3563 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -74,7 +74,8 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c( # foo <- \ #comment # (x) x # is technically valid, but won't parse unless the lambda is in a bigger expression (here '<-'). - # the same doesn't apply to 'function'. + # the same doesn't apply to 'function'. I have suggested this could stop parsing which would + # make our lives easier, eventually: https://bugs.r-project.org/show_bug.cgi?id=18924 xpath_unsafe_lambda <- "OP-LAMBDA[@line1 = following-sibling::*[1][self::COMMENT]/@line1]" # not all instances of linted symbols are potential sources for the observed violations -- see #1914 From bb858c69cf273297a135918e6cd9e12edc0c3684 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 22:13:13 +0000 Subject: [PATCH 7/8] spurious ws --- R/string_boundary_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/string_boundary_linter.R b/R/string_boundary_linter.R index 3356dc1a29..14eaad5fd6 100644 --- a/R/string_boundary_linter.R +++ b/R/string_boundary_linter.R @@ -1,4 +1,4 @@ - #' Require usage of `startsWith()` and `endsWith()` over `grepl()`/`substr()` versions +#' Require usage of `startsWith()` and `endsWith()` over `grepl()`/`substr()` versions #' #' [startsWith()] is used to detect fixed initial substrings; it is more #' readable and more efficient than equivalents using [grepl()] or [substr()]. From e779fb4c700aa32a964f98dfeddd86b3fb16a763 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 27 Jul 2025 22:29:29 -0700 Subject: [PATCH 8/8] review feedback --- R/object_usage_linter.R | 6 +++--- R/utils.R | 4 ++-- 2 files changed, 5 insertions(+), 5 deletions(-) diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index 63ce3f3563..4e55e70a15 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -70,7 +70,7 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c( | //SYMBOL_FUNCTION_CALL[text() = 'setMethod']/parent::expr/following-sibling::expr[3][{fun_node}] ") - # code like:content + # code like: # foo <- \ #comment # (x) x # is technically valid, but won't parse unless the lambda is in a bigger expression (here '<-'). @@ -110,8 +110,8 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c( lapply(fun_assignments, function(fun_assignment) { # this will mess with the source line numbers. but I don't think anybody cares. - known_safe <- is.na(xml_find_first(fun_assignment, xpath_unsafe_lambda)) - code <- get_content(lines = source_expression$content, fun_assignment, known_safe = known_safe) + needs_braces <- !is.na(xml_find_first(fun_assignment, xpath_unsafe_lambda)) + code <- get_content(lines = source_expression$content, fun_assignment, needs_braces = needs_braces) fun <- try_silently(eval( envir = env, parse( diff --git a/R/utils.R b/R/utils.R index 51f36a9d66..1f29c54b3a 100644 --- a/R/utils.R +++ b/R/utils.R @@ -85,7 +85,7 @@ names2 <- function(x) { names(x) %||% rep("", length(x)) } -get_content <- function(lines, info, known_safe = TRUE) { +get_content <- function(lines, info, needs_braces = FALSE) { lines[is.na(lines)] <- "" if (!missing(info)) { @@ -98,7 +98,7 @@ get_content <- function(lines, info, known_safe = TRUE) { lines[length(lines)] <- substr(lines[length(lines)], 1L, info$col2) lines[1L] <- substr(lines[1L], info$col1, nchar(lines[1L])) } - if (!known_safe) lines <- c("{", lines, "}") + if (needs_braces) lines <- c("{", lines, "}") paste(lines, collapse = "\n") }