Support pattern-based exclusion in return_linter() (#2433)

Author: MichaelChirico

NEWS.md

@@ -34,6 +34,7 @@
   + `allow_implicit_else` (default `TRUE`) which, when `FALSE`, checks that all terminal `if` statements are paired with a corresponding `else` statement (part of #884, @MichaelChirico).
   + `return_functions` to customize which functions are equivalent to `return()` as "exit" clauses, e.g. `rlang::abort()` can be considered in addition to the default functions like `stop()` and `q()` from base (#2271 and part of #884, @MichaelChirico and @MEO265).
   + `except` to customize which functions are ignored entirely (i.e., whether they have a return of the specified style is not checked; #2271 and part of #884, @MichaelChirico and @MEO265). Namespace hooks like `.onAttach()` and `.onLoad()` are always ignored.
+  + `except_regex`, the same purpose as `except=`, but filters functions by pattern. This is motivated by {RUnit}, where test suites are based on unit test functions matched by pattern, e.g. `^Test`, and where explicit return may be awkward (#2335, @MichaelChirico).
 * `unnecessary_lambda_linter` is extended to encourage vectorized comparisons where possible, e.g. `sapply(x, sum) > 0` instead of `sapply(x, function(x) sum(x) > 0)` (part of #884, @MichaelChirico). Toggle this behavior with argument `allow_comparison`.
 * `backport_linter()` is slightly faster by moving expensive computations outside the linting function (#2339, #2348, @AshesITR and @MichaelChirico).
 * `Linter()` has a new argument `linter_level` (default `NA`). This is used by `lint()` to more efficiently check for expression levels than the idiom `if (!is_lint_level(...)) { return(list()) }` (#2351, @AshesITR).

R/return_linter.R

@@ -14,10 +14,11 @@
 #'   from base that are always allowed: [stop()], [q()], [quit()], [invokeRestart()],
 #'   `tryInvokeRestart()`, [UseMethod()], [NextMethod()], [standardGeneric()],
 #'   [callNextMethod()], [.C()], [.Call()], [.External()], and [.Fortran()].
-#' @param except Character vector of functions that are not checked when
+#' @param except,except_regex Character vector of functions that are not checked when
 #'   `return_style = "explicit"`. These are in addition to namespace hook functions
 #'   that are never checked: `.onLoad()`, `.onUnload()`, `.onAttach()`, `.onDetach()`,
-#'   `.Last.lib()`, `.First()` and `.Last()`.
+#'   `.Last.lib()`, `.First()` and `.Last()`. `except` matches function names exactly,
+#'   while `except_regex` does exclusion by pattern matching with [rex::re_matches()].
 #'
 #' @examples
 #' # will produce lints
@@ -73,16 +74,25 @@ return_linter <- function(
     return_style = c("implicit", "explicit"),
     allow_implicit_else = TRUE,
     return_functions = NULL,
-    except = NULL) {
+    except = NULL,
+    except_regex = NULL) {
   return_style <- match.arg(return_style)
 
-  if (!allow_implicit_else || return_style == "explicit") {
-    except_xpath <- glue("parent::expr[not(
-      preceding-sibling::expr/SYMBOL[{ xp_text_in_table(union(special_funs, except)) }]
-    )]")
+  check_except <- !allow_implicit_else || return_style == "explicit"
+  # We defer building the XPath strings in this case since we can't build the
+  #   pattern-based "except" logic directly into the XPath (because of v1.0)
+  defer_except <- check_except && !is.null(except_regex)
+
+  if (check_except) {
+    except_xpath_fmt <- "parent::expr[not(
+      preceding-sibling::expr/SYMBOL[{ xp_text_in_table(except) }]
+    )]"
+    except <- union(special_funs, except)
+    if (!defer_except) except_xpath <- glue(except_xpath_fmt, except = except)
   }
 
   if (return_style == "implicit") {
+    # nolint next: object_usage. False positive.
     body_xpath <- "(//FUNCTION | //OP-LAMBDA)/following-sibling::expr[1]"
     params <- list(
       implicit = TRUE,
@@ -91,8 +101,6 @@ return_linter <- function(
       lint_message = "Use implicit return behavior; explicit return() is not needed."
     )
   } else {
-    except <- union(special_funs, except)
-
     base_return_functions <- c(
       # Normal calls
       "return", "stop", "q", "quit",
@@ -110,11 +118,17 @@ return_linter <- function(
 
     return_functions <- union(base_return_functions, return_functions)
 
-    body_xpath <- glue("
+    body_xpath_fmt <- "
     (//FUNCTION | //OP-LAMBDA)[{ except_xpath }]
       /following-sibling::expr[OP-LEFT-BRACE and expr[last()]/@line1 != @line1]
       /expr[last()]
-    ")
+    "
+    if (defer_except) {
+      function_name_xpath <- "(//FUNCTION | //OP-LAMBDA)/parent::expr/preceding-sibling::expr/SYMBOL"
+    } else {
+      body_xpath <- glue(body_xpath_fmt, except_xpath = except_xpath)
+    }
+
     params <- list(
       implicit = FALSE,
       type = "warning",
@@ -130,6 +144,12 @@ return_linter <- function(
 
   Linter(linter_level = "expression", function(source_expression) {
     xml <- source_expression$xml_parsed_content
+    if (defer_except) {
+      assigned_functions <- xml_text(xml_find_all(xml, function_name_xpath))
+      except <- union(except, assigned_functions[re_matches(assigned_functions, except_regex)])
+      except_xpath <- glue(except_xpath_fmt, except = except)
+      body_xpath <- glue(body_xpath_fmt, except_xpath = except_xpath)
+    }
 
     body_expr <- xml_find_all(xml, body_xpath)
 

man/return_linter.Rd

@@ -698,6 +698,72 @@ test_that("except= argument works", {
   )
 })
 
+test_that("except_regex= argument works", {
+  linter <- return_linter(return_style = "explicit", except_regex = "^Test")
+
+  expect_lint(
+    trim_some("
+      TestSummary <- function() {
+        context <- foo(72643424)
+        expected <- data.frame(a = 2)
+        checkEquals(expected, bar(context))
+      }
+    "),
+    NULL,
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      TestMyPackage <- function() {
+        checkMyCustomComparator(x, y)
+      }
+    "),
+    NULL,
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      TestOuter <- function() {
+        actual <- lapply(
+          input,
+          function(x) {
+            no_return()
+          }
+        )
+        TestInner <- function() {
+          no_return()
+        }
+        checkEquals(TestInner(), actual)
+      }
+    "),
+    list(rex::rex("All functions must have an explicit return()."), line_number = 5L),
+    linter
+  )
+})
+
+test_that("except= and except_regex= combination works", {
+  expect_lint(
+    trim_some("
+      foo <- function() {
+        no_return()
+      }
+      bar <- function() {
+        no_return()
+      }
+      abaz <- function() {
+        no_return()
+      }
+      bbaz <- function() {
+        no_return()
+      }
+    "),
+    NULL,
+    return_linter(return_style = "explicit", except = c("foo", "bar"), except_regex = "baz$")
+  )
+})
+
 test_that("return_linter skips brace-wrapped inline functions", {
   expect_lint("function(x) { sum(x) }", NULL, return_linter(return_style = "explicit"))
 })