From 374ed30265993b48d13c019797ab0963f9eebe9c Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 22:20:34 +0000 Subject: [PATCH 1/3] Robust linters for comments in "natural" places --- R/conjunct_test_linter.R | 3 +- 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 +- R/unnecessary_nesting_linter.R | 2 +- R/unreachable_code_linter.R | 52 ++- tests/testthat/test-conjunct_test_linter.R | 71 +++-- 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 ++ .../test-unnecessary_nesting_linter.R | 17 +- tests/testthat/test-unreachable_code_linter.R | 300 +++++++++++------- 18 files changed, 445 insertions(+), 224 deletions(-) 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/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/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/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/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_nesting_linter.R b/R/unnecessary_nesting_linter.R index 3490f9409f..71e7b432ee 100644 --- a/R/unnecessary_nesting_linter.R +++ b/R/unnecessary_nesting_linter.R @@ -234,7 +234,7 @@ unnecessary_nesting_linter <- function( # catch if (cond) { if (other_cond) { ... } } # count(*): only OP-LEFT-BRACE, one , and OP-RIGHT-BRACE. # Note that third node could be . - "following-sibling::expr[OP-LEFT-BRACE and count(*) = 3]/expr[IF and not(ELSE)]" + "following-sibling::expr[OP-LEFT-BRACE and count(*) - count(COMMENT) = 3]/expr[IF and not(ELSE)]" ), collapse = " | " ) diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index f2e9f8d56b..acfdda2d22 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -76,33 +76,55 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclude_end", "# nocov end")) { + # nolint next: object_usage_linter. Used in glue() in statically-difficult fashion to detect. expr_after_control <- " (//REPEAT | //ELSE | //FOR)/following-sibling::expr[1] | (//IF | //WHILE)/following-sibling::expr[2] " + + unreachable_expr_cond_ws <- " + following-sibling::*[ + not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON or self::ELSE or preceding-sibling::ELSE) + and (not(self::COMMENT) or @line2 > preceding-sibling::*[not(self::COMMENT)][1]/@line2) + ][1]" + # when a semicolon is present, the condition is a bit different due to nodes + unreachable_expr_cond_sc <- " + parent::exprlist[OP-SEMICOLON] + /following-sibling::*[ + not(self::OP-RIGHT-BRACE) + and (not(self::COMMENT) or @line1 > preceding-sibling::exprlist/expr/@line2) + ][1] + " + # NB: use not(OP-DOLLAR) to prevent matching process$stop(), #1051 - xpath_return_stop <- glue(" + xpath_return_stop_fmt <- " ( {expr_after_control} - | (//FUNCTION | //OP-LAMBDA)[following-sibling::expr[1]/*[1][self::OP-LEFT-BRACE]]/following-sibling::expr[1] + | + (//FUNCTION | //OP-LAMBDA) + /following-sibling::expr[OP-LEFT-BRACE][last()] ) - /expr[expr[1][ + //expr[expr[1][ not(OP-DOLLAR or OP-AT) and SYMBOL_FUNCTION_CALL[text() = 'return' or text() = 'stop'] ]] - /following-sibling::*[ - not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) - and (not(self::COMMENT) or @line2 > preceding-sibling::*[1]/@line2) - ][1] - ") - xpath_next_break <- glue(" + /{unreachable_expr_cond} + " + xpath_return_stop <- paste( + glue(xpath_return_stop_fmt, unreachable_expr_cond = unreachable_expr_cond_ws), + glue(xpath_return_stop_fmt, unreachable_expr_cond = unreachable_expr_cond_sc), + sep = " | " + ) + xpath_next_break_fmt <- " ({expr_after_control}) - /expr[NEXT or BREAK] - /following-sibling::*[ - not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) - and (not(self::COMMENT) or @line2 > preceding-sibling::*[1]/@line2) - ][1] - ") + //expr[NEXT or BREAK] + /{unreachable_expr_cond} + " + xpath_next_break <- paste( + glue(xpath_next_break_fmt, unreachable_expr_cond = unreachable_expr_cond_ws), + glue(xpath_next_break_fmt, unreachable_expr_cond = unreachable_expr_cond_sc), + sep = " | " + ) xpath_if_while <- " (//WHILE | //IF)[following-sibling::expr[1]/NUM_CONST[text() = 'FALSE']] 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-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-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-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-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-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_nesting_linter.R b/tests/testthat/test-unnecessary_nesting_linter.R index c48383e646..64c09855a3 100644 --- a/tests/testthat/test-unnecessary_nesting_linter.R +++ b/tests/testthat/test-unnecessary_nesting_linter.R @@ -496,6 +496,21 @@ test_that("unnecessary_nesting_linter skips allowed usages", { linter ) + # but comments are irrelevant (they should be moved to another anchor) + expect_lint( + trim_some(" + if (x && a) { + # comment1 + if (y || b) { + 1L + } + # comment2 + } + "), + "Combine this `if` statement with the one found at line 1", + linter + ) + expect_no_lint( trim_some(" if (x) { @@ -758,7 +773,7 @@ patrick::with_parameters_test_that( ) ) -test_that("allow_functions= works", { +test_that("allow_functions= works", { # nofuzz '})' break-up by comment linter_default <- unnecessary_nesting_linter() linter_foo <- unnecessary_nesting_linter(allow_functions = "foo") expect_lint("foo(x, {y}, z)", "Reduce the nesting of this statement", linter_default) diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index b54d3b11e6..2a9cf20d40 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -4,7 +4,7 @@ test_that("unreachable_code_linter works in simple function", { return(bar) } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) test_that("unreachable_code_linter works in sub expressions", { @@ -55,44 +55,43 @@ test_that("unreachable_code_linter works in sub expressions", { linter ) - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - return(bar) # Test comment - } - while (bar) { - return(bar) # 5 + 3 - } - repeat { - return(bar) # Test comment - } - - } - ") - - expect_lint(lines, NULL, linter) + expect_no_lint( # nofuzz + trim_some(" + foo <- function(bar) { + if (bar) { + return(bar) # Test comment + } + while (bar) { + return(bar) # 5 + 3 + } + repeat { + return(bar) # Test comment + } - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - return(bar); x <- 2 - } else { - return(bar); x <- 3 - } - while (bar) { - return(bar); 5 + 3 } - repeat { - return(bar); test() - } - for(i in 1:3) { - return(bar); 5 + 4 - } - } - ") + "), + linter + ) - expect_lint( - lines, + expect_lint( + trim_some(" + foo <- function(bar) { + if (bar) { + return(bar); x <- 2 + } else { + return(bar); x <- 3 + } + while (bar) { + return(bar); 5 + 3 + } + repeat { + return(bar); test() + } + for(i in 1:3) { + return(bar); 5 + 4 + } + } + "), list( list(line_number = 3L, message = msg), list(line_number = 5L, message = msg), @@ -102,6 +101,40 @@ test_that("unreachable_code_linter works in sub expressions", { ), linter ) + + expect_lint( + trim_some(" + foo <- function(bar) { + if (bar) { + return(bar); # comment + x <- 2 + } else { + return(bar); # comment + x <- 3 + } + while (bar) { + return(bar); # comment + 5 + 3 + } + repeat { + return(bar); # comment + test() + } + for(i in 1:3) { + return(bar); # comment + 5 + 4 + } + } + "), + list( + list(line_number = 4L, message = msg), + list(line_number = 7L, message = msg), + list(line_number = 11L, message = msg), + list(line_number = 15L, message = msg), + list(line_number = 19L, message = msg) + ), + linter + ) }) test_that("unreachable_code_linter works with next and break in sub expressions", { @@ -144,48 +177,47 @@ test_that("unreachable_code_linter works with next and break in sub expressions" linter ) - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - break # Test comment - } else { - next # Test comment - } - while (bar) { - next # 5 + 3 - } - repeat { - next # Test comment - } - for(i in 1:3) { - break # 5 + 4 - } - } - ") - - expect_lint(lines, NULL, linter) - - lines <- trim_some(" - foo <- function(bar) { - if (bar) { - next; x <- 2 - } else { - break; x <- 3 - } - while (bar) { - break; 5 + 3 - } - repeat { - next; test() - } - for(i in 1:3) { - break; 5 + 4 + expect_no_lint( # nofuzz + trim_some(" + foo <- function(bar) { + if (bar) { + break # Test comment + } else { + next # Test comment + } + while (bar) { + next # 5 + 3 + } + repeat { + next # Test comment + } + for(i in 1:3) { + break # 5 + 4 + } } - } - ") + "), + linter + ) expect_lint( - lines, + trim_some(" + foo <- function(bar) { + if (bar) { + next; x <- 2 + } else { + break; x <- 3 + } + while (bar) { + break; 5 + 3 + } + repeat { + next; test() + } + for(i in 1:3) { + break; 5 + 4 + } + } + "), list( list(line_number = 3L, message = msg), list(line_number = 5L, message = msg), @@ -195,14 +227,49 @@ test_that("unreachable_code_linter works with next and break in sub expressions" ), linter ) + + # also with comments + expect_lint( + trim_some(" + foo <- function(bar) { + if (bar) { + next; # comment + x <- 2 + } else { + break; # comment + x <- 3 + } + while (bar) { + break; # comment + 5 + 3 + } + repeat { + next; # comment + test() + } + for(i in 1:3) { + break; # comment + 5 + 4 + } + } + "), + list( + list(line_number = 4L, message = msg), + list(line_number = 7L, message = msg), + list(line_number = 11L, message = msg), + list(line_number = 15L, message = msg), + list(line_number = 19L, message = msg) + ), + linter + ) }) test_that("unreachable_code_linter ignores expressions that aren't functions", { - expect_lint("x + 1", NULL, unreachable_code_linter()) + expect_no_lint("x + 1", unreachable_code_linter()) }) test_that("unreachable_code_linter ignores anonymous/inline functions", { - expect_lint("lapply(rnorm(10), function(x) x + 1)", NULL, unreachable_code_linter()) + expect_no_lint("lapply(rnorm(10), function(x) x + 1)", unreachable_code_linter()) }) test_that("unreachable_code_linter passes on multi-line functions", { @@ -212,27 +279,31 @@ test_that("unreachable_code_linter passes on multi-line functions", { return(y) } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) -test_that("unreachable_code_linter ignores comments on the same expression", { - lines <- trim_some(" - foo <- function(x) { - return( - y^2 - ) # y^3 - } - ") - expect_lint(lines, NULL, unreachable_code_linter()) +test_that("unreachable_code_linter ignores comments on the same expression", { # nofuzz + linter <- unreachable_code_linter() + + expect_no_lint( + trim_some(" + foo <- function(x) { + return( + y^2 + ) # y^3 + } + "), + linter + ) }) -test_that("unreachable_code_linter ignores comments on the same line", { +test_that("unreachable_code_linter ignores comments on the same line", { # nofuzz lines <- trim_some(" foo <- function(x) { return(y^2) # y^3 } ") - expect_lint(lines, NULL, unreachable_code_linter()) + expect_no_lint(lines, unreachable_code_linter()) }) test_that("unreachable_code_linter identifies simple unreachable code", { @@ -268,7 +339,7 @@ test_that("unreachable_code_linter finds unreachable comments", { ) }) -test_that("unreachable_code_linter finds expressions in the same line", { +test_that("unreachable_code_linter finds expressions in the same line", { # nofuzz msg <- rex::rex("Remove code and comments coming after return() or stop()") linter <- unreachable_code_linter() @@ -349,7 +420,7 @@ test_that("unreachable_code_linter finds code after stop()", { test_that("unreachable_code_linter ignores code after foo$stop(), which might be stopping a subprocess, for example", { linter <- unreachable_code_linter() - expect_lint( + expect_no_lint( trim_some(" foo <- function(x) { bar <- get_process() @@ -357,10 +428,9 @@ test_that("unreachable_code_linter ignores code after foo$stop(), which might be TRUE } "), - NULL, linter ) - expect_lint( + expect_no_lint( trim_some(" foo <- function(x) { bar <- get_process() @@ -368,7 +438,6 @@ test_that("unreachable_code_linter ignores code after foo$stop(), which might be TRUE } "), - NULL, linter ) }) @@ -381,7 +450,7 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { lintr.exclude_end = "#\\s*TestNoLintEnd" )) - expect_lint( + expect_no_lint( trim_some(" foo <- function() { do_something @@ -391,11 +460,10 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { # TestNoLintEnd } "), - NULL, list(linter, one_linter = assignment_linter()) ) - expect_lint( + expect_no_lint( trim_some(" foo <- function() { do_something @@ -405,7 +473,6 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { # TestNoLintEnd } "), - NULL, linter ) }) @@ -593,14 +660,14 @@ test_that("function shorthand is handled", { test_that("Do not lint inline else after stop", { - expect_lint("if (x > 3L) stop() else x + 3", NULL, unreachable_code_linter()) + expect_no_lint("if (x > 3L) stop() else x + 3", unreachable_code_linter()) }) test_that("Do not lint inline else after stop in inline function", { linter <- unreachable_code_linter() - expect_lint("function(x) if (x > 3L) stop() else x + 3", NULL, linter) - expect_lint("function(x) if (x > 3L) { stop() } else {x + 3}", NULL, linter) + expect_no_lint("function(x) if (x > 3L) stop() else x + 3", linter) + expect_no_lint("function(x) if (x > 3L) { stop() } else {x + 3}", linter) }) test_that("Do not lint inline else after stop in inline lambda function", { @@ -608,8 +675,8 @@ test_that("Do not lint inline else after stop in inline lambda function", { linter <- unreachable_code_linter() - expect_lint("\\(x) if (x > 3L) stop() else x + 3", NULL, linter) - expect_lint("\\(x){ if (x > 3L) stop() else x + 3 }", NULL, linter) + expect_no_lint("\\(x) if (x > 3L) stop() else x + 3", linter) + expect_no_lint("\\(x){ if (x > 3L) stop() else x + 3 }", linter) }) test_that("allow_comment_regex= works", { @@ -619,18 +686,17 @@ test_that("allow_comment_regex= works", { linter_xxxx <- unreachable_code_linter(allow_comment_regex = "#.*xxxx") linter_x1x2 <- unreachable_code_linter(allow_comment_regex = c("#x", "#y")) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) # nocov end } "), - NULL, linter_covr ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -638,22 +704,20 @@ test_that("allow_comment_regex= works", { # nocov end } "), - NULL, linter_covr ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) # ABCDxxxx } "), - NULL, linter_xxxx ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -661,22 +725,20 @@ test_that("allow_comment_regex= works", { # ABCDxxxx } "), - NULL, linter_xxxx ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) #x } "), - NULL, linter_x1x2 ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -684,12 +746,11 @@ test_that("allow_comment_regex= works", { #yDEF } "), - NULL, linter_x1x2 ) # might contain capture groups, #2678 - expect_lint( + expect_no_lint( trim_some(" function() { stop('a') @@ -697,7 +758,6 @@ test_that("allow_comment_regex= works", { # ab } "), - NULL, unreachable_code_linter(allow_comment_regex = "#\\s*(a|ab|abc)") ) }) @@ -710,18 +770,17 @@ test_that("allow_comment_regex= obeys covr's custom exclusion when set", { linter_covr <- unreachable_code_linter() - expect_lint( + expect_no_lint( trim_some(" function() { return(1) # TestNoCovEnd } "), - NULL, linter_covr ) - expect_lint( + expect_no_lint( trim_some(" function() { return(1) @@ -729,7 +788,6 @@ test_that("allow_comment_regex= obeys covr's custom exclusion when set", { # TestNoCovEnd } "), - NULL, linter_covr ) }) From 455f1c92ac838184274f5f7bc2bbd5681896ec2b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 22:25:29 +0000 Subject: [PATCH 2/3] revert whats in #2900 already --- R/unreachable_code_linter.R | 52 +-- tests/testthat/test-unreachable_code_linter.R | 300 +++++++----------- 2 files changed, 136 insertions(+), 216 deletions(-) diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index acfdda2d22..f2e9f8d56b 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -76,55 +76,33 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclude_end", "# nocov end")) { - # nolint next: object_usage_linter. Used in glue() in statically-difficult fashion to detect. expr_after_control <- " (//REPEAT | //ELSE | //FOR)/following-sibling::expr[1] | (//IF | //WHILE)/following-sibling::expr[2] " - - unreachable_expr_cond_ws <- " - following-sibling::*[ - not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON or self::ELSE or preceding-sibling::ELSE) - and (not(self::COMMENT) or @line2 > preceding-sibling::*[not(self::COMMENT)][1]/@line2) - ][1]" - # when a semicolon is present, the condition is a bit different due to nodes - unreachable_expr_cond_sc <- " - parent::exprlist[OP-SEMICOLON] - /following-sibling::*[ - not(self::OP-RIGHT-BRACE) - and (not(self::COMMENT) or @line1 > preceding-sibling::exprlist/expr/@line2) - ][1] - " - # NB: use not(OP-DOLLAR) to prevent matching process$stop(), #1051 - xpath_return_stop_fmt <- " + xpath_return_stop <- glue(" ( {expr_after_control} - | - (//FUNCTION | //OP-LAMBDA) - /following-sibling::expr[OP-LEFT-BRACE][last()] + | (//FUNCTION | //OP-LAMBDA)[following-sibling::expr[1]/*[1][self::OP-LEFT-BRACE]]/following-sibling::expr[1] ) - //expr[expr[1][ + /expr[expr[1][ not(OP-DOLLAR or OP-AT) and SYMBOL_FUNCTION_CALL[text() = 'return' or text() = 'stop'] ]] - /{unreachable_expr_cond} - " - xpath_return_stop <- paste( - glue(xpath_return_stop_fmt, unreachable_expr_cond = unreachable_expr_cond_ws), - glue(xpath_return_stop_fmt, unreachable_expr_cond = unreachable_expr_cond_sc), - sep = " | " - ) - xpath_next_break_fmt <- " + /following-sibling::*[ + not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) + and (not(self::COMMENT) or @line2 > preceding-sibling::*[1]/@line2) + ][1] + ") + xpath_next_break <- glue(" ({expr_after_control}) - //expr[NEXT or BREAK] - /{unreachable_expr_cond} - " - xpath_next_break <- paste( - glue(xpath_next_break_fmt, unreachable_expr_cond = unreachable_expr_cond_ws), - glue(xpath_next_break_fmt, unreachable_expr_cond = unreachable_expr_cond_sc), - sep = " | " - ) + /expr[NEXT or BREAK] + /following-sibling::*[ + not(self::OP-RIGHT-BRACE or self::OP-SEMICOLON) + and (not(self::COMMENT) or @line2 > preceding-sibling::*[1]/@line2) + ][1] + ") xpath_if_while <- " (//WHILE | //IF)[following-sibling::expr[1]/NUM_CONST[text() = 'FALSE']] diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index 2a9cf20d40..b54d3b11e6 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -4,7 +4,7 @@ test_that("unreachable_code_linter works in simple function", { return(bar) } ") - expect_no_lint(lines, unreachable_code_linter()) + expect_lint(lines, NULL, unreachable_code_linter()) }) test_that("unreachable_code_linter works in sub expressions", { @@ -55,43 +55,44 @@ test_that("unreachable_code_linter works in sub expressions", { linter ) - expect_no_lint( # nofuzz - trim_some(" - foo <- function(bar) { - if (bar) { - return(bar) # Test comment - } - while (bar) { - return(bar) # 5 + 3 - } - repeat { - return(bar) # Test comment - } - + lines <- trim_some(" + foo <- function(bar) { + if (bar) { + return(bar) # Test comment + } + while (bar) { + return(bar) # 5 + 3 + } + repeat { + return(bar) # Test comment } - "), - linter - ) - expect_lint( - trim_some(" - foo <- function(bar) { - if (bar) { - return(bar); x <- 2 - } else { - return(bar); x <- 3 - } - while (bar) { - return(bar); 5 + 3 - } - repeat { - return(bar); test() - } - for(i in 1:3) { - return(bar); 5 + 4 - } + } + ") + + expect_lint(lines, NULL, linter) + + lines <- trim_some(" + foo <- function(bar) { + if (bar) { + return(bar); x <- 2 + } else { + return(bar); x <- 3 } - "), + while (bar) { + return(bar); 5 + 3 + } + repeat { + return(bar); test() + } + for(i in 1:3) { + return(bar); 5 + 4 + } + } + ") + + expect_lint( + lines, list( list(line_number = 3L, message = msg), list(line_number = 5L, message = msg), @@ -101,40 +102,6 @@ test_that("unreachable_code_linter works in sub expressions", { ), linter ) - - expect_lint( - trim_some(" - foo <- function(bar) { - if (bar) { - return(bar); # comment - x <- 2 - } else { - return(bar); # comment - x <- 3 - } - while (bar) { - return(bar); # comment - 5 + 3 - } - repeat { - return(bar); # comment - test() - } - for(i in 1:3) { - return(bar); # comment - 5 + 4 - } - } - "), - list( - list(line_number = 4L, message = msg), - list(line_number = 7L, message = msg), - list(line_number = 11L, message = msg), - list(line_number = 15L, message = msg), - list(line_number = 19L, message = msg) - ), - linter - ) }) test_that("unreachable_code_linter works with next and break in sub expressions", { @@ -177,47 +144,48 @@ test_that("unreachable_code_linter works with next and break in sub expressions" linter ) - expect_no_lint( # nofuzz - trim_some(" - foo <- function(bar) { - if (bar) { - break # Test comment - } else { - next # Test comment - } - while (bar) { - next # 5 + 3 - } - repeat { - next # Test comment - } - for(i in 1:3) { - break # 5 + 4 - } + lines <- trim_some(" + foo <- function(bar) { + if (bar) { + break # Test comment + } else { + next # Test comment } - "), - linter - ) + while (bar) { + next # 5 + 3 + } + repeat { + next # Test comment + } + for(i in 1:3) { + break # 5 + 4 + } + } + ") - expect_lint( - trim_some(" - foo <- function(bar) { - if (bar) { - next; x <- 2 - } else { - break; x <- 3 - } - while (bar) { - break; 5 + 3 - } - repeat { - next; test() - } - for(i in 1:3) { - break; 5 + 4 - } + expect_lint(lines, NULL, linter) + + lines <- trim_some(" + foo <- function(bar) { + if (bar) { + next; x <- 2 + } else { + break; x <- 3 } - "), + while (bar) { + break; 5 + 3 + } + repeat { + next; test() + } + for(i in 1:3) { + break; 5 + 4 + } + } + ") + + expect_lint( + lines, list( list(line_number = 3L, message = msg), list(line_number = 5L, message = msg), @@ -227,49 +195,14 @@ test_that("unreachable_code_linter works with next and break in sub expressions" ), linter ) - - # also with comments - expect_lint( - trim_some(" - foo <- function(bar) { - if (bar) { - next; # comment - x <- 2 - } else { - break; # comment - x <- 3 - } - while (bar) { - break; # comment - 5 + 3 - } - repeat { - next; # comment - test() - } - for(i in 1:3) { - break; # comment - 5 + 4 - } - } - "), - list( - list(line_number = 4L, message = msg), - list(line_number = 7L, message = msg), - list(line_number = 11L, message = msg), - list(line_number = 15L, message = msg), - list(line_number = 19L, message = msg) - ), - linter - ) }) test_that("unreachable_code_linter ignores expressions that aren't functions", { - expect_no_lint("x + 1", unreachable_code_linter()) + expect_lint("x + 1", NULL, unreachable_code_linter()) }) test_that("unreachable_code_linter ignores anonymous/inline functions", { - expect_no_lint("lapply(rnorm(10), function(x) x + 1)", unreachable_code_linter()) + expect_lint("lapply(rnorm(10), function(x) x + 1)", NULL, unreachable_code_linter()) }) test_that("unreachable_code_linter passes on multi-line functions", { @@ -279,31 +212,27 @@ test_that("unreachable_code_linter passes on multi-line functions", { return(y) } ") - expect_no_lint(lines, unreachable_code_linter()) + expect_lint(lines, NULL, unreachable_code_linter()) }) -test_that("unreachable_code_linter ignores comments on the same expression", { # nofuzz - linter <- unreachable_code_linter() - - expect_no_lint( - trim_some(" - foo <- function(x) { - return( - y^2 - ) # y^3 - } - "), - linter - ) +test_that("unreachable_code_linter ignores comments on the same expression", { + lines <- trim_some(" + foo <- function(x) { + return( + y^2 + ) # y^3 + } + ") + expect_lint(lines, NULL, unreachable_code_linter()) }) -test_that("unreachable_code_linter ignores comments on the same line", { # nofuzz +test_that("unreachable_code_linter ignores comments on the same line", { lines <- trim_some(" foo <- function(x) { return(y^2) # y^3 } ") - expect_no_lint(lines, unreachable_code_linter()) + expect_lint(lines, NULL, unreachable_code_linter()) }) test_that("unreachable_code_linter identifies simple unreachable code", { @@ -339,7 +268,7 @@ test_that("unreachable_code_linter finds unreachable comments", { ) }) -test_that("unreachable_code_linter finds expressions in the same line", { # nofuzz +test_that("unreachable_code_linter finds expressions in the same line", { msg <- rex::rex("Remove code and comments coming after return() or stop()") linter <- unreachable_code_linter() @@ -420,7 +349,7 @@ test_that("unreachable_code_linter finds code after stop()", { test_that("unreachable_code_linter ignores code after foo$stop(), which might be stopping a subprocess, for example", { linter <- unreachable_code_linter() - expect_no_lint( + expect_lint( trim_some(" foo <- function(x) { bar <- get_process() @@ -428,9 +357,10 @@ test_that("unreachable_code_linter ignores code after foo$stop(), which might be TRUE } "), + NULL, linter ) - expect_no_lint( + expect_lint( trim_some(" foo <- function(x) { bar <- get_process() @@ -438,6 +368,7 @@ test_that("unreachable_code_linter ignores code after foo$stop(), which might be TRUE } "), + NULL, linter ) }) @@ -450,7 +381,7 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { lintr.exclude_end = "#\\s*TestNoLintEnd" )) - expect_no_lint( + expect_lint( trim_some(" foo <- function() { do_something @@ -460,10 +391,11 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { # TestNoLintEnd } "), + NULL, list(linter, one_linter = assignment_linter()) ) - expect_no_lint( + expect_lint( trim_some(" foo <- function() { do_something @@ -473,6 +405,7 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { # TestNoLintEnd } "), + NULL, linter ) }) @@ -660,14 +593,14 @@ test_that("function shorthand is handled", { test_that("Do not lint inline else after stop", { - expect_no_lint("if (x > 3L) stop() else x + 3", unreachable_code_linter()) + expect_lint("if (x > 3L) stop() else x + 3", NULL, unreachable_code_linter()) }) test_that("Do not lint inline else after stop in inline function", { linter <- unreachable_code_linter() - expect_no_lint("function(x) if (x > 3L) stop() else x + 3", linter) - expect_no_lint("function(x) if (x > 3L) { stop() } else {x + 3}", linter) + expect_lint("function(x) if (x > 3L) stop() else x + 3", NULL, linter) + expect_lint("function(x) if (x > 3L) { stop() } else {x + 3}", NULL, linter) }) test_that("Do not lint inline else after stop in inline lambda function", { @@ -675,8 +608,8 @@ test_that("Do not lint inline else after stop in inline lambda function", { linter <- unreachable_code_linter() - expect_no_lint("\\(x) if (x > 3L) stop() else x + 3", linter) - expect_no_lint("\\(x){ if (x > 3L) stop() else x + 3 }", linter) + expect_lint("\\(x) if (x > 3L) stop() else x + 3", NULL, linter) + expect_lint("\\(x){ if (x > 3L) stop() else x + 3 }", NULL, linter) }) test_that("allow_comment_regex= works", { @@ -686,17 +619,18 @@ test_that("allow_comment_regex= works", { linter_xxxx <- unreachable_code_linter(allow_comment_regex = "#.*xxxx") linter_x1x2 <- unreachable_code_linter(allow_comment_regex = c("#x", "#y")) - expect_no_lint( + expect_lint( trim_some(" function() { return(1) # nocov end } "), + NULL, linter_covr ) - expect_no_lint( + expect_lint( trim_some(" function() { return(1) @@ -704,20 +638,22 @@ test_that("allow_comment_regex= works", { # nocov end } "), + NULL, linter_covr ) - expect_no_lint( + expect_lint( trim_some(" function() { return(1) # ABCDxxxx } "), + NULL, linter_xxxx ) - expect_no_lint( + expect_lint( trim_some(" function() { return(1) @@ -725,20 +661,22 @@ test_that("allow_comment_regex= works", { # ABCDxxxx } "), + NULL, linter_xxxx ) - expect_no_lint( + expect_lint( trim_some(" function() { return(1) #x } "), + NULL, linter_x1x2 ) - expect_no_lint( + expect_lint( trim_some(" function() { return(1) @@ -746,11 +684,12 @@ test_that("allow_comment_regex= works", { #yDEF } "), + NULL, linter_x1x2 ) # might contain capture groups, #2678 - expect_no_lint( + expect_lint( trim_some(" function() { stop('a') @@ -758,6 +697,7 @@ test_that("allow_comment_regex= works", { # ab } "), + NULL, unreachable_code_linter(allow_comment_regex = "#\\s*(a|ab|abc)") ) }) @@ -770,17 +710,18 @@ test_that("allow_comment_regex= obeys covr's custom exclusion when set", { linter_covr <- unreachable_code_linter() - expect_no_lint( + expect_lint( trim_some(" function() { return(1) # TestNoCovEnd } "), + NULL, linter_covr ) - expect_no_lint( + expect_lint( trim_some(" function() { return(1) @@ -788,6 +729,7 @@ test_that("allow_comment_regex= obeys covr's custom exclusion when set", { # TestNoCovEnd } "), + NULL, linter_covr ) }) From f67e4769ce0000bd0e90cc2fb0f6b04cd078c564 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Jul 2025 22:30:56 +0000 Subject: [PATCH 3/3] missed file not matching linter names --- R/shared_constants.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/shared_constants.R b/R/shared_constants.R index 20c054c11e..dbad48dcb8 100644 --- a/R/shared_constants.R +++ b/R/shared_constants.R @@ -220,7 +220,7 @@ object_name_xpath <- local({ ]" # either an argument supplied positionally, i.e., not like 'arg = val', or the call - not_kwarg_cond <- "not(preceding-sibling::*[1][self::EQ_SUB])" + not_kwarg_cond <- "not(preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB])" glue(xp_strip_comments(" //SYMBOL[ {sprintf(xp_assignment_target_fmt, 'ancestor', '')} ]