Linter for explicit/implicit returns (#2271)

* feat: Add `return_linter`

* feat: Dont lint deterministically returning control statements

* test: Accept false negatives

* feat: Do not lint stop

* feat: Refined lint of `switch`

* test: Add line tests

* doc: Mark as configurable

* mnt: Add terminal new lines

* incorporate new test cases, improve lint message, begin work to reconcile lint logics

* drop in the other XPath

* catch OP-LAMBDA, typos, fix lint metadata

* remove vestigial, clean up repeated var usage

* progress on rectifying disagreements

* more progress, simplifying XPath

* more test+logic adjustments, now passing tests

* simplify implicit XPath

* test code style

* add simple examples

* set as a default linter

* test-defaults

* style guide ref in doc

* finish TODOs

* NEWS entry

* fix merge

* feat: Add parameters for exceptions

* feat: Add parameter for Runit

* feat: Lint `warning`, `message`, and `stopifnot`

* mnt: Add terminal newline to tests

* doc: Fix doc of `additional_side_effect_func`

* drop runit support for now

* style

* rename parameter to accept "implicit"/"explicit"

* rename other parameters

* corresponding changes to tests

* dont link R4.0+ tryInvokeRestart, which is in linked page already anyway

* review and fixes

* remove incorrect comment in default_linter_testcode.R
* fix NEWS entry (argument is called `return_style`)
* reuse `special_funs` constant
* convert all tests from lines <- c(...) to trim_some()

* document()

---------

Co-authored-by: Michael Chirico <[email protected]>
Co-authored-by: Alexander Rosenstock <[email protected]>

DESCRIPTION

@@ -166,6 +166,7 @@ Collate:
     'regex_subset_linter.R'
     'rep_len_linter.R'
     'repeat_linter.R'
+    'return_linter.R'
     'routine_registration_linter.R'
     'sample_int_linter.R'
     'scalar_in_linter.R'

NAMESPACE

@@ -129,6 +129,7 @@ export(redundant_ifelse_linter)
 export(regex_subset_linter)
 export(rep_len_linter)
 export(repeat_linter)
+export(return_linter)
 export(routine_registration_linter)
 export(sample_int_linter)
 export(sarif_output)

NEWS.md

@@ -16,12 +16,17 @@
 
 * `object_name_linter()` no longer errors when user-supplied `regexes=` have capture groups (#2188, @MichaelChirico).
 
+## Changes to default linters
+
+* New default linter `return_linter()` for the style guide rule that terminal returns should be left implicit (#1100, @MEO265).
+
 ## New and improved features
 
 * More helpful errors for invalid configs (#2253, @MichaelChirico).
 * `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).
 * `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

@@ -0,0 +1,176 @@
+#' Return linter
+#'
+#' This linter checks functions' [return()] expressions.
+#'
+#' @param return_style Character string naming the return style. `"implicit"`,
+#'   the default, enforeces the Tidyverse guide recommendation to leave terminal
+#'   returns implicit. `"explicit"` style requires that `return()` always be
+#'   explicitly supplied.
+#' @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()],
+#'   `tryInvokeRestart()`, [UseMethod()], [NextMethod()], [standardGeneric()],
+#'   [callNextMethod()], [.C()], [.Call()], [.External()], and [.Fortran()].
+#' @param except 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()`.
+#'
+#' @examples
+#' # will produce lints
+#' code <- "function(x) {\n  return(x + 1)\n}"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = return_linter()
+#' )
+#'
+#' code <- "function(x) {\n  x + 1\n}"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = return_linter(return_style = "explicit")
+#' )
+#'
+#' # okay
+#' code <- "function(x) {\n  x + 1\n}"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = return_linter()
+#' )
+#'
+#' code <- "function(x) {\n  return(x + 1)\n}"
+#' writeLines(code)
+#' lint(
+#'   text = code,
+#'   linters = return_linter(return_style = "explicit")
+#' )
+#'
+#'
+#' @evalRd rd_tags("return_linter")
+#' @seealso
+#'  - [linters] for a complete list of linters available in lintr.
+#'  - <https://style.tidyverse.org/functions.html?q=return#return>
+#' @export
+return_linter <- function(
+    return_style = c("implicit", "explicit"),
+    return_functions = NULL,
+    except = NULL) {
+  return_style <- match.arg(return_style)
+
+  if (return_style == "implicit") {
+    xpath <- "
+      (//FUNCTION | //OP-LAMBDA)
+      /following-sibling::expr[1][*[1][self::OP-LEFT-BRACE]]
+      /expr[last()][
+        expr[1][
+          not(OP-DOLLAR or OP-AT)
+          and SYMBOL_FUNCTION_CALL[text() = '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",
+      "invokeRestart", "tryInvokeRestart",
+
+      # Functions related to S3 methods
+      "UseMethod", "NextMethod",
+
+      # Functions related to S4 methods
+      "standardGeneric", "callNextMethod",
+
+      # Functions related to C interfaces
+      ".C", ".Call", ".External", ".Fortran"
+    )
+
+    return_functions <- union(base_return_functions, return_functions)
+
+    control_calls <- c("IF", "FOR", "WHILE", "REPEAT")
+
+    # from top, look for a FUNCTION definition that uses { (one-line
+    #   function definitions are excepted), then look for failure to find
+    #   return() on the last() expr of the function definition.
+    # exempt .onLoad which shows up in the tree like
+    #   <expr><expr><SYMBOL>.onLoad</></><LEFT_ASSIGN></><expr><FUNCTION>...
+    # simple final expression (no control flow) must be
+    # <expr><expr> CALL( <expr> ) </expr></expr>
+    # NB: if this syntax _isn't_ used, the node may not be <expr>, hence
+    #   the use of /*[...] below and self::expr here. position() = 1 is
+    #   needed to guard against a few other cases.
+    #   We also need to make sure that this expression isn't followed by a pipe
+    #   symbol, which would indicate that we need to also check the last
+    #   expression.
+    # pipe expressions are like
+    #   ...
+    #   <SPECIAL>%&gt;%</SPECIAL>
+    #   <expr><expr><SYMBOL_FUNCTION_CALL>return</SYMBOL_FUNCTION_CALL>
+    #   </expr></expr>
+    # Unlike the following case, the return should be the last expression in
+    # the sequence.
+    # conditional expressions are like
+    #   <expr><IF> ( <expr> ) <expr> [ <ELSE> <expr>] </expr>
+    # we require _any_ call to return() in either of the latter two <expr>, i.e.,
+    #   we don't apply recursive logic to check every branch, only that the
+    #   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("
+    (//FUNCTION | //OP-LAMBDA)[parent::expr[not(
+      preceding-sibling::expr[SYMBOL[{ xp_text_in_table(except) }]]
+    )]]
+      /following-sibling::expr[OP-LEFT-BRACE and expr[last()]/@line1 != @line1]
+      /expr[last()]
+      /*[
+        (
+          position() = 1
+          and (
+            (
+              { xp_or(paste0('self::', setdiff(control_calls, 'IF'))) }
+            ) or (
+              not({ xp_or(paste0('self::', control_calls)) })
+              and not(
+                following-sibling::PIPE
+                or following-sibling::SPECIAL[text() = '%>%']
+              )
+              and not(self::expr/SYMBOL_FUNCTION_CALL[
+                { xp_text_in_table(return_functions) }
+              ])
+            )
+          )
+        ) or (
+          preceding-sibling::IF
+          and self::expr
+          and position() > 4
+          and not(.//SYMBOL_FUNCTION_CALL[{ xp_text_in_table(return_functions) }])
+        )
+      ]
+    ")
+    msg <- "All functions must have an explicit return()."
+  }
+
+  Linter(function(source_expression) {
+    if (!is_lint_level(source_expression, "expression")) {
+      return(list())
+    }
+
+    xml <- source_expression$xml_parsed_content
+
+    xml_nodes <- xml_find_all(xml, xpath)
+
+    xml_nodes_to_lints(
+      xml_nodes,
+      source_expression = source_expression,
+      lint_message = msg,
+      type = "style"
+    )
+  })
+}

R/zzz.R

@@ -29,6 +29,7 @@ default_linters <- modify_defaults(
   paren_body_linter(),
   pipe_continuation_linter(),
   quotes_linter(),
+  return_linter(),
   semicolon_linter(),
   seq_linter(),
   spaces_inside_linter(),

inst/lintr/linters.csv

@@ -86,6 +86,7 @@ redundant_ifelse_linter,best_practices efficiency consistency configurable
 regex_subset_linter,best_practices efficiency regex
 rep_len_linter,readability consistency best_practices
 repeat_linter,style readability
+return_linter,style configurable default
 routine_registration_linter,best_practices efficiency robustness
 sample_int_linter,efficiency readability robustness
 scalar_in_linter,readability consistency best_practices efficiency

tests/testthat/default_linter_testcode.R

@@ -7,6 +7,11 @@
 # paren_brace
 f = function (x,y = 1){}
 
+# return_linter
+g <- function(x) {
+  return(x + 1)
+}
+
 # commented_code
 # some <- commented("out code")