New allow_implicit_else argument for return_linter

NEWS.md

@@ -26,7 +26,11 @@
 * `library_call_linter()` is extended
   + to encourage all packages to be attached with `library(symbol)`, not `library("symbol", character.only = TRUE)` or "vectorized" approaches looping over package names (part of #884, @MichaelChirico).
   + to discourage many consecutive calls to `suppressMessages()` or `suppressPackageStartupMessages()` (part of #884, @MichaelChirico).
-* `return_linter()` also has an argument `return_style` (`"implicit"` by default) which checks that all functions confirm to the specified return style of `"implicit"` or `"explicit"` (part of #884, @MichaelChirico, @AshesITR and @MEO265).
+* `return_linter()` also has arguments for fine-tuning which functions get linted:
+  + `return_style` (`"implicit"` by default) which checks that all functions confirm to the specified return style of `"implicit"` or `"explicit"` (#2271 and part of #884, @MichaelChirico, @AshesITR and @MEO265).
+  + `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.
 * `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`.
 
 ### New linters

R/return_linter.R

@@ -6,6 +6,9 @@
 #'   the default, enforeces the Tidyverse guide recommendation to leave terminal
 #'   returns implicit. `"explicit"` style requires that `return()` always be
 #'   explicitly supplied.
+#' @param allow_implicit_else Logical, default `TRUE`. If `FALSE`, functions with a terminal
+#'   `if` clause must always have an `else` clause, making the `NULL` alternative explicit
+#'   if necessary.
 #' @param return_functions Character vector of functions that are accepted as terminal calls
 #'   when `return_style = "explicit"`. These are in addition to exit functions
 #'   from base that are always allowed: [stop()], [q()], [quit()], [invokeRestart()],
@@ -32,6 +35,13 @@
 #'   linters = return_linter(return_style = "explicit")
 #' )
 #'
+#' code <- "function(x) {\n  if (x > 0) 2\n}"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = return_linter(allow_implicit_else = FALSE)
+#' )
+#'
 #' # okay
 #' code <- "function(x) {\n  x + 1\n}"
 #' writeLines(code)
@@ -47,6 +57,12 @@
 #'   linters = return_linter(return_style = "explicit")
 #' )
 #'
+#' code <- "function(x) {\n  if (x > 0) 2 else NULL\n}"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = return_linter(allow_implicit_else = FALSE)
+#' )
 #'
 #' @evalRd rd_tags("return_linter")
 #' @seealso
@@ -55,12 +71,19 @@
 #' @export
 return_linter <- function(
     return_style = c("implicit", "explicit"),
+    allow_implicit_else = TRUE,
     return_functions = NULL,
     except = NULL) {
   return_style <- match.arg(return_style)
 
+  if (!allow_implicit_else || return_style == "explicit") {
+    # See `?.onAttach`; these functions are all exclusively used for their
+    #   side-effects, so implicit return is generally acceptable
+    except <- union(special_funs, except)
+  }
+
   if (return_style == "implicit") {
-    xpath <- "
+    return_xpath <- "
       (//FUNCTION | //OP-LAMBDA)
       /following-sibling::expr[1][*[1][self::OP-LEFT-BRACE]]
       /expr[last()][
@@ -70,13 +93,8 @@ return_linter <- function(
         ]
       ]
     "
-    msg <- "Use implicit return behavior; explicit return() is not needed."
+    return_msg <- "Use implicit return behavior; explicit return() is not needed."
   } else {
-    # See `?.onAttach`; these functions are all exclusively used for their
-    #   side-effects, so implicit return is generally acceptable
-
-    except <- union(special_funs, except)
-
     base_return_functions <- c(
       # Normal calls
       "return", "stop", "q", "quit",
@@ -123,7 +141,7 @@ return_linter <- function(
     #   two top level branches have at least two return()s
     # because of special 'in' syntax for 'for' loops, the condition is
     #   tagged differently than for 'if'/'while' conditions (simple PAREN)
-    xpath <- glue("
+    return_xpath <- glue("
     (//FUNCTION | //OP-LAMBDA)[parent::expr[not(
       preceding-sibling::expr[SYMBOL[{ xp_text_in_table(except) }]]
     )]]
@@ -154,7 +172,24 @@ return_linter <- function(
         )
       ]
     ")
-    msg <- "All functions must have an explicit return()."
+    return_msg <- "All functions must have an explicit return()."
+  }
+
+  if (!allow_implicit_else) {
+    # for inline functions, terminal <expr> is a sibling of <FUNCTION>, otherwise
+    #   it's a descendant of the <expr> following <FUNCTION>
+    implicit_else_xpath <- glue("
+    //FUNCTION[not(
+      parent::expr/preceding-sibling::expr/SYMBOL[{ xp_text_in_table(except) }]
+    )]
+      /following-sibling::expr[
+        (position() = last() and IF and not(ELSE))
+        or expr[position() = last() and IF and not(ELSE)]
+      ]
+    ")
+
+    implicit_else_msg <-
+      "All functions with terminal if statements must have a corresponding terminal else clause"
   }
 
   Linter(function(source_expression) {
@@ -164,13 +199,26 @@ return_linter <- function(
 
     xml <- source_expression$xml_parsed_content
 
-    xml_nodes <- xml_find_all(xml, xpath)
+    return_expr <- xml_find_all(xml, return_xpath)
 
-    xml_nodes_to_lints(
-      xml_nodes,
+    lints <- xml_nodes_to_lints(
+      return_expr,
       source_expression = source_expression,
-      lint_message = msg,
+      lint_message = return_msg,
       type = "style"
     )
+
+    if (!allow_implicit_else) {
+      implicit_else_expr <- xml_find_all(xml, implicit_else_xpath)
+
+      lints <- c(lints, xml_nodes_to_lints(
+        implicit_else_expr,
+        source_expression = source_expression,
+        lint_message = implicit_else_msg,
+        type = "warning"
+      ))
+    }
+
+    lints
   })
 }

R/shared_constants.R

@@ -309,3 +309,14 @@ purrr_mappers <- c(
   "map_raw", "map_lgl", "map_int", "map_dbl", "map_chr", "map_vec",
   "map_df", "map_dfr", "map_dfc"
 )
+
+# Shared between returns_linter and implicit_else_return_inter
+# See `?.onAttach`; these functions are all exclusively used for their
+#   side-effects, so implicit return is generally acceptable
+return_not_needed_funs <- c(
+  # namespace hooks
+  ".onLoad", ".onUnload", ".onAttach", ".onDetach", ".Last.lib",
+
+  # from RUnit
+  ".setUp", ".tearDown"
+)

tests/testthat/test-return_linter.R

@@ -882,3 +882,117 @@ test_that("return_linter lints `message`, `warning` and `stopifnot`", {
     linter
   )
 })
+
+test_that("non-if returns are skipped under allow_implicit_else = FALSE", {
+  expect_lint(
+    trim_some("
+      foo <- function(bar) {
+        bar
+      }
+    "),
+    NULL,
+    return_linter(allow_implicit_else = FALSE)
+  )
+})
+
+test_that("if/else don't throw a lint under allow_implicit_else = FALSE", {
+  expect_lint(
+    trim_some("
+      foo <- function(bar) {
+        if (TRUE) {
+          return(bar)
+        } else {
+          return(NULL)
+        }
+      }
+    "),
+    NULL,
+    return_linter(allow_implicit_else = FALSE)
+  )
+})
+
+test_that("implicit else outside a function doesn't lint under allow_implicit_else = FALSE", {
+  expect_lint("if(TRUE) TRUE", NULL, return_linter(allow_implicit_else = FALSE))
+})
+
+test_that("allow_implicit_else = FALSE identifies a simple implicit else", {
+  expect_lint(
+    trim_some("
+      foo <- function(bar) {
+        if (TRUE) {
+          bar
+        }
+      }
+    "),
+    rex::rex("All functions with terminal if statements must"),
+    return_linter(allow_implicit_else = FALSE)
+  )
+})
+
+test_that("allow_implicit_else = FALSE finds implicit else with nested if+else", {
+  lint_msg <- rex::rex("All functions with terminal if statements must have a corresponding terminal else clause")
+
+  expect_lint(
+    trim_some("
+      foo <- function() {
+        if (TRUE) {
+          if (TRUE) {
+            FALSE
+          } else {
+            TRUE
+          }
+        }
+      }
+    "),
+    lint_msg,
+    return_linter(allow_implicit_else = FALSE)
+  )
+
+  expect_lint(
+    trim_some("
+      foo <- function() {
+        if (TRUE) {
+          if (TRUE) {
+            return(FALSE)
+          } else {
+            return(TRUE)
+          }
+        }
+      }
+    "),
+    lint_msg,
+    return_linter(return_style = "explicit", allow_implicit_else = FALSE)
+  )
+})
+
+test_that("allow_implicit_else = FALSE works on anonymous/inline functions", {
+  expect_lint(
+    "lapply(rnorm(10), function(x) if (TRUE) x + 1)",
+    rex::rex("All functions with terminal if statements must"),
+    return_linter(allow_implicit_else = FALSE)
+  )
+})
+
+test_that("allow_implicit_else = FALSE skips side-effect functions like .onLoad", {
+  expect_lint(
+    trim_some("
+      .onAttach <- function(libname, pkgname) {
+        if (TRUE) foo()
+      }
+    "),
+    NULL,
+    return_linter(allow_implicit_else = FALSE)
+  )
+})
+
+test_that("allow_implicit_else = FALSE + explicit returns skips side-effect functions like .onLoad", {
+  expect_lint(
+    trim_some("
+      .onAttach <- function(libname, pkgname) {
+        if (TRUE) return(foo())
+      }
+    "),
+    NULL,
+    return_linter(return_style = "explicit", allow_implicit_else = FALSE)
+  )
+})