Add repeat_linter for infinite loops

DESCRIPTION

@@ -149,6 +149,7 @@ Collate:
     'redundant_equals_linter.R'
     'redundant_ifelse_linter.R'
     'regex_subset_linter.R'
+    'repeat_linter.R'
     'routine_registration_linter.R'
     'scalar_in_linter.R'
     'semicolon_linter.R'

NAMESPACE

@@ -113,6 +113,7 @@ export(quotes_linter)
 export(redundant_equals_linter)
 export(redundant_ifelse_linter)
 export(regex_subset_linter)
+export(repeat_linter)
 export(routine_registration_linter)
 export(sarif_output)
 export(scalar_in_linter)

NEWS.md

@@ -34,6 +34,7 @@
 * `seq_linter()` recommends `rev()` in the lint message for lints like `nrow(x):1` (#1542, @MichaelChirico).
 * New `xp_call_name()` helper to facilitate writing custom linters (#2023, @MichaelChirico). This helper converts a matched XPath to the R function to which it corresponds. This is useful for including the "offending" function in the lint's message.
 * `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)
 
 ### New linters
 
@@ -42,7 +43,7 @@
 * `length_levels_linter()` for using the specific function `nlevels()` instead of checking `length(levels(x))` (part of #884, @MichaelChirico).
 * `scalar_in_linter()` for discouraging `%in%` when the right-hand side is a scalar, e.g. `x %in% 1` (part of #884, @MichaelChirico).
 * `if_not_else_linter()` for encouraging `if` statements to be structured as `if (A) x else y` instead of `if (!A) y else x` (part of #884, @MichaelChirico).
-* `commas_linter()` gains an option `allow_trailing` (default `FALSE`) to allow trailing commas while indexing. (#2104, @MEO265)
+* `repeat_linter()` for encouraging `repeat` for infinite loops instead of `while (TRUE)` (#2106, @MEO265).
 
 ## Changes to defaults
 

R/repeat_linter.R

@@ -0,0 +1,41 @@
+#' Repeat linter
+#'
+#' Check that `while (TRUE)` is not used for infinite loops.
+#'
+#' @examples
+#' # will produce lints
+#' lint(
+#'   text = "while (TRUE) { }",
+#'   linters = repeat_linter()
+#' )
+#'
+#'
+#' # okay
+#' lint(
+#'   text = "repeat { }",
+#'   linters = repeat_linter()
+#' )
+#'
+#'
+#' @evalRd rd_tags("repeat_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+repeat_linter <- function() {
+  xpath <- "//WHILE[following-sibling::expr[1]/NUM_CONST[text() = 'TRUE']]"
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+    xml <- source_expression$xml_parsed_content
+    lints <- xml_find_all(xml, xpath)
+
+    xml_nodes_to_lints(
+      lints,
+      source_expression = source_expression,
+      lint_message = "Use 'repeat' instead of 'while (TRUE)' for infinite loops.",
+      range_start_xpath = "number(./@col1)",
+      range_end_xpath = "number(./following-sibling::*[3]/@col2)"
+    )
+  })
+}

inst/lintr/linters.csv

@@ -71,6 +71,7 @@ quotes_linter,style consistency readability default configurable
 redundant_equals_linter,best_practices readability efficiency common_mistakes
 redundant_ifelse_linter,best_practices efficiency consistency configurable
 regex_subset_linter,best_practices efficiency
+repeat_linter,style readability
 routine_registration_linter,best_practices efficiency robustness
 scalar_in_linter,readability consistency best_practices efficiency
 semicolon_linter,style readability default configurable

tests/testthat/test-repeat_linter.R

@@ -0,0 +1,27 @@
+test_that("test repeat_linter", {
+  linter <- repeat_linter()
+  msg <- rex::rex("Use 'repeat' instead of 'while (TRUE)' for infinite loops.")
+
+  expect_lint("repeat { }", NULL, linter)
+  expect_lint("while (FALSE) { }", NULL, linter)
+  expect_lint("while (i < 5) { }", NULL, linter)
+  expect_lint("while (j < 5) TRUE", NULL, linter)
+  expect_lint("while (TRUE && j < 5) { ... }", NULL, linter)
+
+  expect_lint("while (TRUE) { }", msg, linter)
+  expect_lint("for (i in 1:10) { while (TRUE) { if (i == 5) { break } } }", msg, linter)
+  expect_lint("while (TRUE) { while (TRUE) { } }", list(msg, msg), linter)
+  expect_lint(
+    trim_some("{
+      while (TRUE) {
+      }
+      while (TRUE) {
+      }
+    }"),
+    list(
+      list(message = msg, line_number = 2L, column_number = 1L, ranges = list(c(1L, 12L))),
+      list(message = msg, line_number = 4L, column_number = 1L, ranges = list(c(1L, 12L)))
+    ),
+    linter
+  )
+})