Unreachable loops

NEWS.md

@@ -44,6 +44,7 @@
 * `unreachable_code_linter()`
   + finds unreachable code even in the presence of a comment or semicolon after `return()` or `stop()` (#2127, @MEO265).
   + 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()` finds assignments in call arguments besides the first one (#2136, @MichaelChirico).
 * `inner_combine_linter()` no longer throws on length-1 calls to `c()` like `c(exp(2))` or `c(log(3))` (#2017, @MichaelChirico). Such usage is discouraged by `unnecessary_concatenation_linter()`, but `inner_combine_linter()` _per se_ does not apply.
 * `condition_message_linter()` ignores usages of extracted calls like `env$stop(paste(a, b))` (#1455, @MichaelChirico).

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
@@ -57,14 +57,22 @@
 unreachable_code_linter <- function() {
   # NB: use not(OP-DOLLAR) to prevent matching process$stop(), #1051
   xpath_return_stop <- "
-  //FUNCTION
-    /following-sibling::expr
+  ((//FUNCTION | //REPEAT | //ELSE | //FOR)/following-sibling::expr | (//IF | //WHILE)/following-sibling::expr[2])
     /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 <- "
+  ((//REPEAT | //ELSE | //FOR)/following-sibling::expr | (//IF | //WHILE)/following-sibling::expr[2])
+    /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]
   "
@@ -104,7 +112,19 @@ unreachable_code_linter <- function() {
     lints_return_stop <- xml_nodes_to_lints(
       expr_return_stop[!is_nolint_end_comment],
       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 return() or stop() should be removed.",
+      type = "warning"
+    )
+
+    expr_next_break <- xml_find_all(xml, xpath_next_break)
+
+    is_nolint_end_comment <- xml2::xml_name(expr_next_break) == "COMMENT" &
+      re_matches(xml_text(expr_next_break), settings$exclude_end)
+
+    lints_next_break <- xml_nodes_to_lints(
+      expr_next_break[!is_nolint_end_comment],
+      source_expression = source_expression,
+      lint_message = "Code and comments coming after a `next` or `break` should be removed.",
       type = "warning"
     )
 
@@ -126,6 +146,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)
   })
 }

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()
   )
 })
@@ -195,6 +385,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", {
@@ -349,7 +553,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
@@ -389,7 +593,7 @@ test_that("unreachable_code_linter identifies unreachable code in mixed conditio
 #   ")
 #   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()
 #   )
 # })