New unreachable_code_linter

DESCRIPTION

@@ -124,6 +124,7 @@ Collate:
     'undesirable_function_linter.R'
     'undesirable_operator_linter.R'
     'unneeded_concatenation_linter.R'
+    'unreachable_code_linter.R'
     'vector_logic_linter.R'
     'with_id.R'
     'xp_utils.R'

NAMESPACE

@@ -87,6 +87,7 @@ export(trailing_whitespace_linter)
 export(undesirable_function_linter)
 export(undesirable_operator_linter)
 export(unneeded_concatenation_linter)
+export(unreachable_code_linter)
 export(vector_logic_linter)
 export(with_defaults)
 export(with_id)

NEWS.md

@@ -106,6 +106,7 @@ function calls. (#850, #851, @renkun-ken)
    * `literal_coercion_linter()` Require using correctly-typed literals instead of direct coercion, e.g. `1L` instead of `as.numeric(1)`
    * `paste_sep_linter()` Require usage of `paste0()` over `paste(sep = "")`
    * `nested_ifelse_linter()` Prevent nested calls to `ifelse()` like `ifelse(A, x, ifelse(B, y, z))`, and similar
+   * `unreachable_code_linter()` Prevent code after `return()` and `stop()` statements that will never be reached
 * `assignment_linter()` now lints right assignment (`->` and `->>`) and gains two arguments. `allow_cascading_assign` (`TRUE` by default) toggles whether to lint `<<-` and `->>`; `allow_right_assign` toggles whether to lint `->` and `->>` (#915, @michaelchirico)
 * `infix_spaces_linter()` gains argument `exclude_operators` to disable lints on selected infix operators. By default, all "low-precedence" operators throw lints; see `?infix_spaces_linter` for an enumeration of these. (#914 @michaelchirico)
 * `infix_spaces_linter()` now throws a lint on `a~b` and `function(a=1) {}` (#930, @michaelchirico)

R/unreachable_code_linter.R

@@ -0,0 +1,46 @@
+#' Block unreachable code and comments following return statements
+#'
+#' Code after a top-level [return()] or [stop()] 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
+#'   meant for posterity should be placed *before* the final `return()`.
+#'
+#' @evalRd rd_tags("unreachable_code_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+unreachable_code_linter <- function() {
+  Linter(function(source_file) {
+    if (length(source_file$xml_parsed_content) == 0L) {
+      return(list())
+    }
+
+    xml <- source_file$xml_parsed_content
+
+    # NB:
+    #  - * returns all children, including the terminal }, so the position
+    #    is not last(), but last()-1. If there's no }, this linter doesn't apply.
+    #    this is also why we need /* and not /expr -- position() must include all nodes
+    #  - land on the culprit expression
+    xpath <- "
+    //FUNCTION
+    /following-sibling::expr
+    /*[
+      self::expr
+      and expr[SYMBOL_FUNCTION_CALL[text() = 'return' or text() = 'stop']]
+      and (position() != last() - 1 or not(following-sibling::OP-RIGHT-BRACE))
+      and @line2 < following-sibling::*[1]/@line2
+    ]
+    /following-sibling::*[1]
+    "
+
+    bad_expr <- xml2::xml_find_all(xml, xpath)
+
+    return(lapply(
+      bad_expr,
+      xml_nodes_to_lint,
+      source_file = source_file,
+      lint_message = "Code and comments coming after a top-level return() or stop() should be removed.",
+      type = "warning"
+    ))
+  })
+}

inst/lintr/linters.csv

@@ -61,4 +61,5 @@ trailing_whitespace_linter,style default
 undesirable_function_linter,style efficiency configurable robustness best_practices
 undesirable_operator_linter,style efficiency configurable robustness best_practices
 unneeded_concatenation_linter,style readability efficiency
+unreachable_code_linter,best_practices readability
 vector_logic_linter,default efficiency best_practices

tests/testthat/test-unreachable_code_linter.R

@@ -0,0 +1,141 @@
+test_that("unreachable_code_linter works in simple function", {
+  lines <- trim_some("
+    foo <- function(bar) {
+      return(bar)
+    }
+  ")
+  expect_lint(lines, NULL, unreachable_code_linter())
+})
+
+test_that("unreachable_code_linter ignores expressions that aren't functions", {
+  expect_lint("x + 1", NULL, 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())
+})
+
+test_that("unreachable_code_linter passes on multi-line functions", {
+  lines <- trim_some("
+    oo <- function(x) {
+      y <- x + 1
+      return(y)
+    }
+  ")
+  expect_lint(lines, NULL, 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 line", {
+  lines <- trim_some("
+    foo <- function(x) {
+      return(y^2) # y^3
+    }
+  ")
+  expect_lint(lines, NULL, unreachable_code_linter())
+})
+
+test_that("unreachable_code_linter identifies simple unreachable code", {
+  lines <- trim_some("
+    foo <- function(bar) {
+      return(bar)
+      x + 3
+    }
+  ")
+  # testing the correct expression is linted (the first culprit line)
+  expect_lint(
+    lines,
+    list(
+      line_number = 3L,
+      message = rex::rex("Code and comments coming after a top-level return() or stop()")
+    ),
+    unreachable_code_linter()
+  )
+})
+
+test_that("unreachable_code_linter finds unreachable comments", {
+  lines <- trim_some("
+    foo <- function(x) {
+      y <- x + 1
+      return(y^2)
+      # y^3
+    }
+  ")
+  expect_lint(
+    lines,
+    rex::rex("Code and comments coming after a top-level return() or stop()"),
+    unreachable_code_linter()
+  )
+})
+
+test_that("unreachable_code_linter finds a double return", {
+  lines <- trim_some("
+    foo <- function(x) {
+      return(y^2)
+      return(y^3)
+    }
+  ")
+  expect_lint(
+    lines,
+    rex::rex("Code and comments coming after a top-level return() or stop()"),
+    unreachable_code_linter()
+  )
+})
+
+test_that("unreachable_code_linter finds code after stop()", {
+  lines <- trim_some("
+    foo <- function(x) {
+      y <- x + 1
+      stop(y^2)
+      # y^3
+    }
+  ")
+  expect_lint(
+    lines,
+    rex::rex("Code and comments coming after a top-level return() or stop()"),
+    unreachable_code_linter()
+  )
+})
+
+# TODO(michaelchirico): extend to work on switch() statements
+# test_that("unreachable_code_linter interacts with switch() as expected", {
+#   unreachable_inside_switch_lines <- trim_some("
+#     foo <- function(x) {
+#       switch(x,
+#         a = {
+#           return(x)
+#           x + 1
+#         },
+#         b = {
+#           return(x + 1)
+#         }
+#       )
+#     }
+#   ")
+#   expect_lint(
+#     unreachable_inside_switch_lines,
+#     rex::rex("Code and comments coming after a top-level return() or stop()"),
+#     unreachable_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): similarly, return(x); x+1 should also lint, even though
+#   the styler won't allow this in our current setup.
+# TODO(michaelchirico): again similarly, this could also apply to cases without
+#   explicit returns (where it can only apply to comments)