From 30c7d7099f986d083575872e3cd76aea5120cd0a Mon Sep 17 00:00:00 2001 From: MEO265 <99362508+MEO265@users.noreply.github.com> Date: Fri, 24 Nov 2023 02:50:05 +0100 Subject: [PATCH] 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 Co-authored-by: Alexander Rosenstock --- DESCRIPTION | 1 + NAMESPACE | 1 + NEWS.md | 5 + R/return_linter.R | 176 +++++ R/zzz.R | 1 + inst/lintr/linters.csv | 1 + man/configurable_linters.Rd | 1 + man/default_linters.Rd | 3 +- man/linters.Rd | 7 +- man/return_linter.Rd | 74 ++ man/style_linters.Rd | 1 + tests/testthat/default_linter_testcode.R | 5 + tests/testthat/test-return_linter.R | 884 +++++++++++++++++++++++ 13 files changed, 1156 insertions(+), 4 deletions(-) create mode 100644 R/return_linter.R create mode 100644 man/return_linter.Rd create mode 100644 tests/testthat/test-return_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 8bd6bfbcb..fecc8b63e 100644 --- a/DESCRIPTION +++ b/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' diff --git a/NAMESPACE b/NAMESPACE index f6eee7ea1..76ec11454 100644 --- a/NAMESPACE +++ b/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) diff --git a/NEWS.md b/NEWS.md index b44fa857c..761ef4ef2 100644 --- a/NEWS.md +++ b/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 diff --git a/R/return_linter.R b/R/return_linter.R new file mode 100644 index 000000000..e117e6693 --- /dev/null +++ b/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. +#' - +#' @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 + # .onLoad... + # simple final expression (no control flow) must be + # CALL( ) + # NB: if this syntax _isn't_ used, the node may not be , 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 + # ... + # %>% + # return + # + # Unlike the following case, the return should be the last expression in + # the sequence. + # conditional expressions are like + # ( ) [ ] + # we require _any_ call to return() in either of the latter two , 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" + ) + }) +} diff --git a/R/zzz.R b/R/zzz.R index 411c7e462..b0519ac64 100644 --- a/R/zzz.R +++ b/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(), diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index c535da33c..5a32733f9 100644 --- a/inst/lintr/linters.csv +++ b/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 diff --git a/man/configurable_linters.Rd b/man/configurable_linters.Rd index 5de94bd9b..b8dc83c49 100644 --- a/man/configurable_linters.Rd +++ b/man/configurable_linters.Rd @@ -41,6 +41,7 @@ The following linters are tagged with 'configurable': \item{\code{\link{pipe_consistency_linter}}} \item{\code{\link{quotes_linter}}} \item{\code{\link{redundant_ifelse_linter}}} +\item{\code{\link{return_linter}}} \item{\code{\link{semicolon_linter}}} \item{\code{\link{string_boundary_linter}}} \item{\code{\link{todo_comment_linter}}} diff --git a/man/default_linters.Rd b/man/default_linters.Rd index fa1839fcd..f14177a9a 100644 --- a/man/default_linters.Rd +++ b/man/default_linters.Rd @@ -5,7 +5,7 @@ \alias{default_linters} \title{Default linters} \format{ -An object of class \code{list} of length 25. +An object of class \code{list} of length 26. } \usage{ default_linters @@ -41,6 +41,7 @@ The following linters are tagged with 'default': \item{\code{\link{paren_body_linter}}} \item{\code{\link{pipe_continuation_linter}}} \item{\code{\link{quotes_linter}}} +\item{\code{\link{return_linter}}} \item{\code{\link{semicolon_linter}}} \item{\code{\link{seq_linter}}} \item{\code{\link{spaces_inside_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index e882b1c5c..8f5a6307f 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -19,10 +19,10 @@ The following tags exist: \itemize{ \item{\link[=best_practices_linters]{best_practices} (63 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (10 linters)} -\item{\link[=configurable_linters]{configurable} (39 linters)} +\item{\link[=configurable_linters]{configurable} (40 linters)} \item{\link[=consistency_linters]{consistency} (32 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} -\item{\link[=default_linters]{default} (25 linters)} +\item{\link[=default_linters]{default} (26 linters)} \item{\link[=deprecated_linters]{deprecated} (4 linters)} \item{\link[=efficiency_linters]{efficiency} (32 linters)} \item{\link[=executing_linters]{executing} (6 linters)} @@ -31,7 +31,7 @@ The following tags exist: \item{\link[=readability_linters]{readability} (65 linters)} \item{\link[=regex_linters]{regex} (4 linters)} \item{\link[=robustness_linters]{robustness} (17 linters)} -\item{\link[=style_linters]{style} (39 linters)} +\item{\link[=style_linters]{style} (40 linters)} } } \section{Linters}{ @@ -119,6 +119,7 @@ The following linters exist: \item{\code{\link{regex_subset_linter}} (tags: best_practices, efficiency, regex)} \item{\code{\link{rep_len_linter}} (tags: best_practices, consistency, readability)} \item{\code{\link{repeat_linter}} (tags: readability, style)} +\item{\code{\link{return_linter}} (tags: configurable, default, style)} \item{\code{\link{routine_registration_linter}} (tags: best_practices, efficiency, robustness)} \item{\code{\link{sample_int_linter}} (tags: efficiency, readability, robustness)} \item{\code{\link{scalar_in_linter}} (tags: best_practices, consistency, efficiency, readability)} diff --git a/man/return_linter.Rd b/man/return_linter.Rd new file mode 100644 index 000000000..4bcbd175e --- /dev/null +++ b/man/return_linter.Rd @@ -0,0 +1,74 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/return_linter.R +\name{return_linter} +\alias{return_linter} +\title{Return linter} +\usage{ +return_linter( + return_style = c("implicit", "explicit"), + return_functions = NULL, + except = NULL +) +} +\arguments{ +\item{return_style}{Character string naming the return style. \code{"implicit"}, +the default, enforeces the Tidyverse guide recommendation to leave terminal +returns implicit. \code{"explicit"} style requires that \code{return()} always be +explicitly supplied.} + +\item{return_functions}{Character vector of functions that are accepted as terminal calls +when \code{return_style = "explicit"}. These are in addition to exit functions +from base that are always allowed: \code{\link[=stop]{stop()}}, \code{\link[=q]{q()}}, \code{\link[=quit]{quit()}}, \code{\link[=invokeRestart]{invokeRestart()}}, +\code{tryInvokeRestart()}, \code{\link[=UseMethod]{UseMethod()}}, \code{\link[=NextMethod]{NextMethod()}}, \code{\link[=standardGeneric]{standardGeneric()}}, +\code{\link[=callNextMethod]{callNextMethod()}}, \code{\link[=.C]{.C()}}, \code{\link[=.Call]{.Call()}}, \code{\link[=.External]{.External()}}, and \code{\link[=.Fortran]{.Fortran()}}.} + +\item{except}{Character vector of functions that are not checked when +\code{return_style = "explicit"}. These are in addition to namespace hook functions +that are never checked: \code{.onLoad()}, \code{.onUnload()}, \code{.onAttach()}, \code{.onDetach()}, +\code{.Last.lib()}, \code{.First()} and \code{.Last()}.} +} +\description{ +This linter checks functions' \code{\link[=return]{return()}} expressions. +} +\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") +) + + +} +\seealso{ +\itemize{ +\item \link{linters} for a complete list of linters available in lintr. +\item \url{https://style.tidyverse.org/functions.html?q=return#return} +} +} +\section{Tags}{ +\link[=configurable_linters]{configurable}, \link[=default_linters]{default}, \link[=style_linters]{style} +} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index 47c78fc2c..44de2fa03 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -40,6 +40,7 @@ The following linters are tagged with 'style': \item{\code{\link{pipe_continuation_linter}}} \item{\code{\link{quotes_linter}}} \item{\code{\link{repeat_linter}}} +\item{\code{\link{return_linter}}} \item{\code{\link{semicolon_linter}}} \item{\code{\link{spaces_inside_linter}}} \item{\code{\link{spaces_left_parentheses_linter}}} diff --git a/tests/testthat/default_linter_testcode.R b/tests/testthat/default_linter_testcode.R index 4bcce2e61..1f9f060d6 100644 --- a/tests/testthat/default_linter_testcode.R +++ b/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") diff --git a/tests/testthat/test-return_linter.R b/tests/testthat/test-return_linter.R new file mode 100644 index 000000000..d412820bf --- /dev/null +++ b/tests/testthat/test-return_linter.R @@ -0,0 +1,884 @@ +test_that("Lint return on end of function", { + expect_lint( + trim_some(" + function() { + return(1) + # Test + 3 + 4 + } + "), + list( + line_number = 4L, + message = rex::rex("All functions must have an explicit return().") + ), + return_linter(return_style = "explicit") + ) + + expect_lint( + trim_some(" + function() { + return(1) + } + "), + list( + line_number = 2L, + message = rex::rex("Use implicit return behavior; explicit return() is not needed.") + ), + return_linter() + ) +}) + +test_that("Lint return on end of lambda function", { + skip_if_not_r_version("4.1.0") + + expect_lint( + trim_some(" + \\(bar) { + 5L + 3L + } + "), + list( + line_number = 2L, + message = rex::rex("All functions must have an explicit return().") + ), + return_linter(return_style = "explicit") + ) + + expect_lint( + trim_some(" + \\(bar) { + 5L + 3L + return(1) + } + "), + list( + line_number = 3L, + message = rex::rex("Use implicit return behavior; explicit return() is not needed.") + ), + return_linter() + ) +}) + +test_that("Do not lint if/else statements (with return) on end of function", { + linter <- return_linter(return_style = "explicit") + + expect_lint( + trim_some(" + function() { + if (x) { + return(4) + } else if (y) { + return(5) + } else { + return(6) + } + } + "), + NULL, + linter + ) +}) + +test_that("Lint control statements (without return) on end of function", { + linter <- return_linter(return_style = "explicit") + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + function() { + while (x > 4) { + cat(4) + if (x < 4) { + return(x) + } + } + } + "), + list(lint_msg, line_number = 2L), + linter + ) + + expect_lint( + trim_some(" + function() { + repeat { + cat(4) + } + } + "), + list(lint_msg, line_number = 2L), + linter + ) + + expect_lint( + trim_some(" + function() { + for (i in 1:10) { + cat(4) + if (i > 11) { + return(x) + } + } + } + "), + list(lint_msg, line_number = 2L), + linter + ) + + expect_lint( + trim_some(" + function() { + if (x == 2L){ + return(e) + } else if (x == 3L) { + cat(f) + } + } + "), + list(lint_msg, line_number = 4L), + linter + ) +}) + +test_that("Do not lint stop on end of function", { + expect_lint( + trim_some(" + function() { + # Test + 3 + 4 + stop(1) + } + "), + NULL, + return_linter(return_style = "explicit") + ) + + expect_lint( + trim_some(" + function() { + stop(1) + } + "), + NULL, + return_linter() + ) +}) + +test_that("Do not lint stop on end of function", { + linter <- return_linter(return_style = "explicit") + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + function(x) { + switch(x, a = 1, 'b' = 2, '3' = 3, 4) + } + "), + list(lint_msg, line_number = 2L), + linter + ) + + expect_lint( + trim_some(" + function(x) { + switch(x, a = return(1), 'b' = stop(2), '3' = return(3), 4) + } + "), + list(lint_msg, line_number = 2L), + linter + ) + + expect_lint( + trim_some(" + function() { + switch( + x, + a = return(1), + 'b' = stop(2), + '3' = return(3) + ) + } + "), + list(lint_msg, line_number = 2L), + linter + ) + + expect_lint( + trim_some(" + function(x) { + switch(x, a = return(1), 'b' = stop(2), '3' = return(3), stop('End')) + } + "), + list(lint_msg, line_number = 2L), + linter + ) +}) + +test_that("return_linter works in simple function", { + expect_lint( + trim_some(" + foo <- function(bar) { + return(bar) + } + "), + NULL, + return_linter(return_style = "explicit") + ) +}) + +test_that("return_linter works for using stop() instead of returning", { + linter <- return_linter(return_style = "explicit") + + expect_lint( + trim_some(" + foo <- function(bar) { + stop('bad') + } + "), + NULL, + linter + ) +}) + +test_that("return_linter ignores expressions that aren't functions", { + expect_lint("x + 1", NULL, return_linter(return_style = "explicit")) +}) + +test_that("return_linter ignores anonymous/inline functions", { + expect_lint("lapply(rnorm(10), function(x) x + 1)", NULL, return_linter(return_style = "explicit")) +}) + +test_that("return_linter ignores if statements outside of functions", { + expect_lint( + trim_some(" + if (TRUE) { + TRUE + } else { + FALSE + } + "), + NULL, + return_linter(return_style = "explicit") + ) +}) + +test_that("return_linter passes on multi-line functions", { + expect_lint( + trim_some(" + foo <- function(x) { + y <- x + 1 + return(y) + } + "), + NULL, + return_linter(return_style = "explicit") + ) +}) + + +test_that("return_linter identifies a simple missing return", { + expect_lint( + trim_some(" + foo <- function(bar) { + bar + } + "), + rex::rex("All functions must have an explicit return()."), + return_linter(return_style = "explicit") + ) +}) + + +test_that("return_linter finds a missing return in a 2+ line function", { + expect_lint( + trim_some(" + foo <- function(x) { + y <- x + 1 + y^2 + } + "), + rex::rex("All functions must have an explicit return()."), + return_linter(return_style = "explicit") + ) +}) + +test_that("return_linter finds a missing return despite early returns", { + expect_lint( + trim_some(" + foo <- function(x) { + if (TRUE) return(TRUE) + x <- 1 + 1 + x + } + "), + rex::rex("All functions must have an explicit return()."), + return_linter(return_style = "explicit") + ) +}) + + +test_that("return_linter finds multiple missing returns in branches", { + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + foo <- function() { + if (TRUE) { + TRUE + } else { + FALSE + } + } + "), + list( + list(lint_msg, line_number = 2L), + list(lint_msg, line_number = 4L) + ), + return_linter(return_style = "explicit") + ) +}) + +test_that("return_linter works regardless of braces in final if case", { + linter <- return_linter(return_style = "explicit") + + expect_lint( + trim_some(" + foo <- function() { + if (TRUE) TRUE + } + "), + rex::rex("All functions must have an explicit return()."), + linter + ) + expect_lint( + trim_some(" + foo <- function() { + if (TRUE) return(TRUE) + } + "), + NULL, + linter + ) +}) + +test_that("return_linter finds missing return in one branch of an if", { + linter <- return_linter(return_style = "explicit") + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + foo <- function() { + if (TRUE) { + return(TRUE) + } else { + FALSE + } + } + "), + lint_msg, + linter + ) + + expect_lint( + trim_some(" + foo <- function() { + if (TRUE) { + TRUE + } else { + return(FALSE) + } + } + "), + lint_msg, + linter + ) +}) + +test_that("return_linter works in nested if statements", { + linter <- return_linter(return_style = "explicit") + + expect_lint( + trim_some(" + foo <- function() { + if (TRUE) { + return(TRUE) + } else if (nzchar('a')) { + return(TRUE) + } else { + return(FALSE) + } + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + foo <- function() { + if (TRUE) { + if (nzchar('a')) { + TRUE + } + } else { + return(FALSE) + } + } + "), + rex::rex("All functions must have an explicit return()."), + linter + ) +}) + +test_that("return_linter works in multi-line nested if statements", { + linter <- return_linter(return_style = "explicit") + + expect_lint( + trim_some(" + foo <- function() { + if (TRUE) { + if (nzchar('a')) { + y <- 1 + 1 + y + } + } else { + return(FALSE) + } + } + "), + rex::rex("All functions must have an explicit return()."), + linter + ) + + expect_lint( + trim_some(" + foo <- function() { + if (TRUE) { + if (nzchar('a')) { + y <- 1 + 1 + return(y) + } + } else { + return(FALSE) + } + } + "), + NULL, + linter + ) +}) + +test_that("return_linter works for final for loops as well", { + linter <- return_linter(return_style = "explicit") + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + foo <- function() { + for (i in seq_len(10)) { + if (i %% 2 == 0) { + y <- 1 + 1 + return(y) + } + } + } + "), + lint_msg, + linter + ) + + expect_lint( + trim_some(" + foo <- function() { + for (i in seq_len(10)) { + if (i %% 2 == 0) { + y <- 1 + 1 + } + } + } + "), + lint_msg, + linter + ) +}) + +test_that("return_linter works for function factories", { + linter <- return_linter(return_style = "explicit") + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + foo <- function(x) { + function () { + return(x + 1) + } + } + "), + lint_msg, + linter + ) + + expect_lint( + trim_some(" + foo <- function(x) { + function () { + x + 1 + } + } + "), + list(lint_msg, lint_msg), + linter + ) +}) + +test_that("return_linter allows return()-less Rcpp wrappers", { + expect_lint( + trim_some(" + ReadCapacitorAsList <- function(file) { + .Call(R_ReadCapacitorAsList, file) + } + "), + NULL, + return_linter(return_style = "explicit") + ) +}) + +test_that("return_linter allows return()-less namespace hook calls", { + expect_lint( + trim_some(" + .onLoad <- function(libname, pkgname) { + do_setup() + } + "), + NULL, + return_linter(return_style = "explicit") + ) +}) + +test_that("return_linter correctly handles pipes", { + linter <- return_linter(return_style = "explicit") + + expect_lint( + trim_some(" + foo <- function(x) { + x %>% + return() + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + foo <- function(x) { + x %>% + mean() %>% + return() + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + foo <- function(x) { + y <- rnorm(length(x)) + + x %>% + cbind(y) %>% + return() + } + "), + NULL, + linter + ) +}) + +test_that("return_linter handles pipes in control flow", { + linter <- return_linter(return_style = "explicit") + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + foo <- function(x) { + if (TRUE) { + return(invisible()) + } else { + x %>% + return() + } + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + foo <- function(x) { + for (i in seq_len(10)) { + x %>% + mean() + } + } + "), + lint_msg, + linter + ) + + expect_lint( + trim_some(" + foo <- function(x) { + if (TRUE) { + x %>% + mean() + } else { + return(TRUE) + } + } + "), + lint_msg, + linter + ) +}) + +test_that("return_linter passes on q() or quit() calls", { + expect_lint( + trim_some(" + foo <- function(x) { + if (TRUE) { + q('n') + } else { + quit('n') + } + } + "), + NULL, + return_linter(return_style = "explicit") + ) +}) + +test_that("return_functions= argument works", { + linter <- return_linter(return_style = "explicit", return_functions = "LOG") + + expect_lint( + trim_some(" + foo <- function(bar) { + LOG('INFO', 'bad') + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + foo <- function(bar) { + logging::LOG('INFO', 'bad') + } + "), + NULL, + linter + ) +}) + +test_that("except= argument works", { + expect_lint( + trim_some(" + foo <- function(bar) { + 5 + 3 + } + "), + NULL, + return_linter(return_style = "explicit", except = "foo") + ) +}) + +test_that("return_linter skips brace-wrapped inline functions", { + expect_lint("function(x) { sum(x) }", NULL, return_linter(return_style = "explicit")) +}) + +test_that("return_linter skips common S4 method functions", { + linter <- return_linter(return_style = "explicit") + + expect_lint( + trim_some(" + setGeneric( + 'ReadCircuitsPBAsDataTable', + function(pbMessageList) { + standardGeneric('ReadCircuitsPBAsDataTable') + } + ) + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + setMethod('initialize', 'CircuitsTopology', function(.Object, ...) { + callNextMethod(.Object, ...) + }) + "), + NULL, + linter + ) +}) + +test_that("return_functions= is not affected by namespace qualification", { + linter <- return_linter(return_style = "explicit", return_functions = "abort") + + expect_lint( + trim_some(" + foo <- function(bar) { + abort('bad') + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + foo <- function(bar) { + rlang::abort('bad') + } + "), + NULL, + linter + ) +}) + +test_that("return_linter skips invokeRestart(), tryInvokeRestart()", { + linter <- return_linter(return_style = "explicit") + + expect_lint( + trim_some(" + warning = function(w) { + warn <<- append(warn, conditionMessage(w)) + invokeRestart('muffleWarning') + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + custom_warning = function(w) { + warn <<- append(warn, conditionMessage(w)) + tryInvokeRestart('muffleCustom_warning') + } + "), + NULL, + linter + ) +}) + +# NB: x |> return() is blocked by the parser, so no need to test that. +test_that("Native pipes are handled correctly", { + skip_if_not_r_version("4.1.0") + + linter <- return_linter(return_style = "explicit") + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + foo <- function(x) { + for (i in seq_len(10)) { + x |> + mean() + } + } + "), + lint_msg, + linter + ) + + expect_lint( + trim_some(" + foo <- function(x) { + if (TRUE) { + x |> + mean() + } else { + return(TRUE) + } + } + "), + lint_msg, + linter + ) +}) + +test_that("return_linter works for final while/repeat loops as well", { + linter <- return_linter(return_style = "explicit") + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + foo <- function(x) { + while (x > 0) { + if (x %% 2 == 0) { + return(x) + } + x <- x + sample(10, 1) + } + } + "), + lint_msg, + linter + ) + + expect_lint( + trim_some(" + foo <- function(x) { + repeat { + if (x == 0) { + return(x) + } + x <- x - sign(x) + } + } + "), + lint_msg, + linter + ) +}) + +test_that("return_linter lints `message`, `warning` and `stopifnot`", { + linter <- return_linter(return_style = "explicit") + lint_msg <- rex::rex("All functions must have an explicit return().") + + expect_lint( + trim_some(" + foo <- function(bar) { + stopifnot(bar == 'd') + } + "), + lint_msg, + linter + ) + + expect_lint( + trim_some(" + foo <- function(bar) { + message('test') + } + "), + lint_msg, + linter + ) + + expect_lint( + trim_some(" + foo <- function(bar) { + warning(test) + } + "), + lint_msg, + linter + ) +})