diff --git a/NEWS.md b/NEWS.md index 9210f6829..e6e5d3046 100644 --- a/NEWS.md +++ b/NEWS.md @@ -49,7 +49,9 @@ * `seq_linter()` recommends `rev()` in the lint message for lints like `nrow(x):1` (#1542, @MichaelChirico). * `function_argument_linter()` detects usage of `missing()` for the linted argument (#1546, @MichaelChirico). The simplest fix for `function_argument_linter()` lints is typically to set that argument to `NULL` by default, in which case it's usually preferable to update function logic checking `missing()` to check `is.null()` instead. * `commas_linter()` gains an option `allow_trailing` (default `FALSE`) to allow trailing commas while indexing. (#2104, @MEO265) -* `unreachable_code_linter()` checks for code inside `if (FALSE)` and other conditional loops with deterministically false conditions (#1428, @ME0265). +* `unreachable_code_linter()` + + checks for code inside `if (FALSE)` and other conditional loops with deterministically false conditions (#1428, @ME0265). + + checks for unreachable code inside `if`, `else`, `for`, `while`, and `repeat` blocks, including combinations with `break` and `next` statements. (#2105, @ME0265). * `implicit_assignment_linter()` gains an argument `allow_lazy` (default `FALSE`) that allows optionally skipping lazy assignments like `A && (B <- foo(A))` (#2016, @MichaelChirico). * `unused_import_linter()` gains an argument `interpret_glue` (default `TRUE`) paralleling that in `object_usage_linter()` to toggle whether `glue::glue()` expressions should be inspected for exported object usage (#2042, @MichaelChirico). * `default_undesirable_functions` is updated to also include `Sys.unsetenv()` and `structure()` (#2192 and #2228, @IndrajeetPatil and @MichaelChirico). diff --git a/R/unreachable_code_linter.R b/R/unreachable_code_linter.R index ba6850063..498ada071 100644 --- a/R/unreachable_code_linter.R +++ b/R/unreachable_code_linter.R @@ -1,6 +1,6 @@ #' Block unreachable code and comments following return statements #' -#' Code after a top-level [return()] or [stop()] +#' Code after e.g. a [return()] or [stop()] #' or in deterministically false conditional loops like `if (FALSE)` can't be reached; #' typically this is vestigial code left after refactoring or sandboxing code, which #' is fine for exploration, but shouldn't ultimately be checked in. Comments @@ -55,18 +55,38 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export unreachable_code_linter <- function() { + expr_after_control <- " + (//REPEAT | //ELSE | //FOR)/following-sibling::expr[1] + | (//IF | //WHILE)/following-sibling::expr[2] + " # NB: use not(OP-DOLLAR) to prevent matching process$stop(), #1051 - xpath_return_stop <- " - (//FUNCTION | //OP-LAMBDA) - /following-sibling::expr - /expr[expr[1][not(OP-DOLLAR or OP-AT) and SYMBOL_FUNCTION_CALL[text() = 'return' or text() = 'stop']]] + xpath_return_stop <- glue(" + ( + {expr_after_control} + | (//FUNCTION | //OP-LAMBDA)/following-sibling::expr + ) + /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(" + ({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] + ") + xpath_if_while <- " - (//WHILE | //IF)[following-sibling::expr[1]/NUM_CONST[text() = 'FALSE']]/following-sibling::expr[2] + (//WHILE | //IF) + /following-sibling::expr[1][NUM_CONST[text() = 'FALSE']] + /following-sibling::expr[1] " xpath_else <- " @@ -88,6 +108,13 @@ unreachable_code_linter <- function() { expr[vapply(expr, xml2::xml_length, integer(1L)) != 0L] } + # exclude comments that start with a nolint directive + drop_nolint_end_comment <- function(expr) { + is_nolint_end_comment <- xml2::xml_name(expr) == "COMMENT" & + re_matches(xml_text(expr), settings$exclude_end) + expr[!is_nolint_end_comment] + } + Linter(function(source_expression) { if (!is_lint_level(source_expression, "expression")) { return(list()) @@ -97,14 +124,19 @@ unreachable_code_linter <- function() { expr_return_stop <- xml_find_all(xml, xpath_return_stop) - # exclude comments that start with a nolint directive - is_nolint_end_comment <- xml2::xml_name(expr_return_stop) == "COMMENT" & - re_matches(xml_text(expr_return_stop), settings$exclude_end) - lints_return_stop <- xml_nodes_to_lints( - expr_return_stop[!is_nolint_end_comment], + drop_nolint_end_comment(expr_return_stop), + source_expression = source_expression, + lint_message = "Code and comments coming after a return() or stop() should be removed.", + type = "warning" + ) + + expr_next_break <- xml_find_all(xml, xpath_next_break) + + lints_next_break <- xml_nodes_to_lints( + drop_nolint_end_comment(expr_next_break), source_expression = source_expression, - lint_message = "Code and comments coming after a top-level return() or stop() should be removed.", + lint_message = "Code and comments coming after a `next` or `break` should be removed.", type = "warning" ) @@ -126,6 +158,6 @@ unreachable_code_linter <- function() { type = "warning" ) - c(lints_return_stop, lints_if_while, lints_else) + c(lints_return_stop, lints_next_break, lints_if_while, lints_else) }) } diff --git a/man/unreachable_code_linter.Rd b/man/unreachable_code_linter.Rd index 34dabf257..4e91e5cf8 100644 --- a/man/unreachable_code_linter.Rd +++ b/man/unreachable_code_linter.Rd @@ -7,7 +7,7 @@ unreachable_code_linter() } \description{ -Code after a top-level \code{\link[=return]{return()}} or \code{\link[=stop]{stop()}} +Code after e.g. a \code{\link[=return]{return()}} or \code{\link[=stop]{stop()}} or in deterministically false conditional loops like \verb{if (FALSE)} can't be reached; typically this is vestigial code left after refactoring or sandboxing code, which is fine for exploration, but shouldn't ultimately be checked in. Comments diff --git a/tests/testthat/test-unreachable_code_linter.R b/tests/testthat/test-unreachable_code_linter.R index 523cdd56f..281662b38 100644 --- a/tests/testthat/test-unreachable_code_linter.R +++ b/tests/testthat/test-unreachable_code_linter.R @@ -7,6 +7,196 @@ test_that("unreachable_code_linter works in simple function", { expect_lint(lines, NULL, unreachable_code_linter()) }) +test_that("unreachable_code_linter works in sub expressions", { + linter <- unreachable_code_linter() + msg <- rex::rex("Code and comments coming after a return() or stop()") + + lines <- trim_some(" + foo <- function(bar) { + if (bar) { + return(bar) + # Test comment + while (bar) { + return(bar) + 5 + 3 + repeat { + return(bar) + # Test comment + } + } + } else if (bla) { + # test + return(5) + # Test 2 + } else { + return(bar) + # Test comment + for(i in 1:3) { + return(bar) + 5 + 4 + } + } + return(bar) + 5 + 1 + } + ") + + expect_lint( + lines, + list( + list(line_number = 4L, message = msg), + list(line_number = 7L, message = msg), + list(line_number = 10L, message = msg), + list(line_number = 16L, message = msg), + list(line_number = 19L, message = msg), + list(line_number = 22L, message = msg), + list(line_number = 26L, message = msg) + ), + 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) + + 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), + list(line_number = 8L, message = msg), + list(line_number = 11L, message = msg), + list(line_number = 14L, message = msg) + ), + linter + ) +}) + +test_that("unreachable_code_linter works with next and break in sub expressions", { + linter <- unreachable_code_linter() + msg <- rex::rex("Code and comments coming after a `next` or `break`") + + lines <- trim_some(" + foo <- function(bar) { + if (bar) { + next + # Test comment + while (bar) { + break + 5 + 3 + repeat { + next + # Test comment + } + } + } else { + next + # test + for(i in 1:3) { + break + 5 + 4 + } + } + } + ") + + expect_lint( + lines, + list( + list(line_number = 4L, message = msg), + list(line_number = 7L, message = msg), + list(line_number = 10L, message = msg), + list(line_number = 15L, message = msg), + list(line_number = 18L, message = msg) + ), + 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_lint( + lines, + list( + list(line_number = 3L, message = msg), + list(line_number = 5L, message = msg), + list(line_number = 8L, message = msg), + list(line_number = 11L, message = msg), + list(line_number = 14L, message = msg) + ), + linter + ) +}) + test_that("unreachable_code_linter ignores expressions that aren't functions", { expect_lint("x + 1", NULL, unreachable_code_linter()) }) @@ -57,7 +247,7 @@ test_that("unreachable_code_linter identifies simple unreachable code", { lines, list( line_number = 3L, - message = rex::rex("Code and comments coming after a top-level return() or stop()") + message = rex::rex("Code and comments coming after a return() or stop()") ), unreachable_code_linter() ) @@ -73,13 +263,13 @@ test_that("unreachable_code_linter finds unreachable comments", { ") expect_lint( lines, - rex::rex("Code and comments coming after a top-level return() or stop()"), + rex::rex("Code and comments coming after a return() or stop()"), unreachable_code_linter() ) }) test_that("unreachable_code_linter finds expressions in the same line", { - msg <- rex::rex("Code and comments coming after a top-level return() or stop()") + msg <- rex::rex("Code and comments coming after a return() or stop()") linter <- unreachable_code_linter() lines <- trim_some(" @@ -107,7 +297,7 @@ test_that("unreachable_code_linter finds expressions in the same line", { }) test_that("unreachable_code_linter finds expressions and comments after comment in return line", { - msg <- rex::rex("Code and comments coming after a top-level return() or stop()") + msg <- rex::rex("Code and comments coming after a return() or stop()") linter <- unreachable_code_linter() lines <- trim_some(" @@ -136,7 +326,7 @@ test_that("unreachable_code_linter finds a double return", { ") expect_lint( lines, - rex::rex("Code and comments coming after a top-level return() or stop()"), + rex::rex("Code and comments coming after a return() or stop()"), unreachable_code_linter() ) }) @@ -151,7 +341,7 @@ test_that("unreachable_code_linter finds code after stop()", { ") expect_lint( lines, - rex::rex("Code and comments coming after a top-level return() or stop()"), + rex::rex("Code and comments coming after a return() or stop()"), unreachable_code_linter() ) }) @@ -199,6 +389,20 @@ test_that("unreachable_code_linter ignores terminal nolint end comments", { NULL, list(unreachable_code_linter(), one_linter = assignment_linter()) ) + + expect_lint( + trim_some(" + foo <- function() { + do_something + # nolint start: one_linter. + a = 42 + next + # nolint end + } + "), + NULL, + unreachable_code_linter() + ) }) test_that("unreachable_code_linter identifies unreachable code in conditional loops", { @@ -353,7 +557,7 @@ test_that("unreachable_code_linter identifies unreachable code in mixed conditio ), list( line_number = 13L, - message = rex::rex("Code and comments coming after a top-level return() or stop()") + message = rex::rex("Code and comments coming after a return() or stop()") ) ), linter @@ -387,7 +591,7 @@ test_that("function shorthand is handled", { "), list( line_number = 3L, - message = rex::rex("Code and comments coming after a top-level return() or stop()") + message = rex::rex("Code and comments coming after a return() or stop()") ), unreachable_code_linter() ) @@ -411,17 +615,11 @@ test_that("function shorthand is handled", { # ") # expect_lint( # unreachable_inside_switch_lines, -# rex::rex("Code and comments coming after a top-level return() or stop()"), +# rex::rex("Code and comments coming after a return() or stop()"), # unreachable_code_linter() # ) # }) # nolint end: commented_code_linter. -# TODO(michaelchirico): the logic could be extended to terminal if statements -# or control flows (for/while). There shouldn't really be such a thing as -# a terminal for/while (owing to ExplicitReturnLinter forcing these to -# be followed by return(invisible()) or similar), but could be included to -# catch comments for completeness / robustness as a standalone function. -# Terminal if statements are a bit messy, but would have some payoff. -# TODO(michaelchirico): again similarly, this could also apply to cases without +# TODO(michaelchirico): This could also apply to cases without # explicit returns (where it can only apply to comments)