From 995c3aa734e6113dbdf8cee00776b9093b5dc804 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 13 Dec 2023 15:58:33 +0000 Subject: [PATCH 1/8] support pattern-based exclusion in return_linter --- NEWS.md | 1 + R/return_linter.R | 33 ++++++++++++++++++++++------- tests/testthat/test-return_linter.R | 26 +++++++++++++++++++++++ 3 files changed, 52 insertions(+), 8 deletions(-) diff --git a/NEWS.md b/NEWS.md index acbaf6c90..f9617c926 100644 --- a/NEWS.md +++ b/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). diff --git a/R/return_linter.R b/R/return_linter.R index 4094ca755..444fa4a53 100644 --- a/R/return_linter.R +++ b/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,13 +74,17 @@ 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( + check_except <- !allow_implicit_else || return_style == "explicit" + + if (check_except) { + except_xpath_fmt <- "parent::expr[not( preceding-sibling::expr/SYMBOL[{ xp_text_in_table(union(special_funs, except)) }] - )]") + )]" + if (is.null(except_regex)) except_xpath <- glue(except_xpath_fmt) } if (return_style == "implicit") { @@ -110,11 +115,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 (is.null(except_regex)) { + body_xpath <- glue(body_xpath_fmt) + } else { + function_name_xpath <- "(//FUNCTION | //OP-LAMBDA)/parent::expr/preceding-sibling::expr/SYMBOL" + } + params <- list( implicit = FALSE, type = "warning", @@ -130,6 +141,12 @@ return_linter <- function( Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content + if (check_except && !is.null(except_regex)) { + 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) + body_xpath <- glue(body_xpath_fmt) + } body_expr <- xml_find_all(xml, body_xpath) diff --git a/tests/testthat/test-return_linter.R b/tests/testthat/test-return_linter.R index f017b0e08..c88692101 100644 --- a/tests/testthat/test-return_linter.R +++ b/tests/testthat/test-return_linter.R @@ -698,6 +698,32 @@ 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 + ) +}) + test_that("return_linter skips brace-wrapped inline functions", { expect_lint("function(x) { sum(x) }", NULL, return_linter(return_style = "explicit")) }) From 583e7892744e4be7ba3a58560b7eaaf55e02bcb3 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 13 Dec 2023 16:07:43 +0000 Subject: [PATCH 2/8] document --- man/return_linter.Rd | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/man/return_linter.Rd b/man/return_linter.Rd index f18f2d8c1..fc4fdbab0 100644 --- a/man/return_linter.Rd +++ b/man/return_linter.Rd @@ -8,7 +8,8 @@ return_linter( return_style = c("implicit", "explicit"), allow_implicit_else = TRUE, return_functions = NULL, - except = NULL + except = NULL, + except_regex = NULL ) } \arguments{ @@ -27,10 +28,11 @@ from base that are always allowed: \code{\link[=stop]{stop()}}, \code{\link[=q]{ \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 +\item{except, except_regex}{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()}.} +\code{.Last.lib()}, \code{.First()} and \code{.Last()}. \code{except} matches function names exactly, +while \code{except_regex} does exclusion by pattern matching with \code{\link[rex:re_matches]{rex::re_matches()}}.} } \description{ This linter checks functions' \code{\link[=return]{return()}} expressions. From 5724ba35a6a746ada29bb7a4e08068998a8cde94 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 14 Dec 2023 02:01:33 +0000 Subject: [PATCH 3/8] more tests inspired by review --- tests/testthat/test-return_linter.R | 40 +++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) diff --git a/tests/testthat/test-return_linter.R b/tests/testthat/test-return_linter.R index c88692101..a284193bd 100644 --- a/tests/testthat/test-return_linter.R +++ b/tests/testthat/test-return_linter.R @@ -722,6 +722,46 @@ test_that("except_regex= argument works", { 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", { From b3d2b116778fa4e72a7577299853cd510a7bf380 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 14 Dec 2023 02:07:48 +0000 Subject: [PATCH 4/8] nolint --- R/return_linter.R | 15 +++++++++------ 1 file changed, 9 insertions(+), 6 deletions(-) diff --git a/R/return_linter.R b/R/return_linter.R index 444fa4a53..2a4d6c837 100644 --- a/R/return_linter.R +++ b/R/return_linter.R @@ -79,16 +79,19 @@ return_linter <- function( return_style <- match.arg(return_style) 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(union(special_funs, except)) }] )]" - if (is.null(except_regex)) except_xpath <- glue(except_xpath_fmt) + if (!defer_except) except_xpath <- glue(except_xpath_fmt) # nolint: object_usage_linter. Hidden by dynamic glue. } if (return_style == "implicit") { - body_xpath <- "(//FUNCTION | //OP-LAMBDA)/following-sibling::expr[1]" + body_xpath <- "(//FUNCTION | //OP-LAMBDA)/following-sibling::expr[1]" # nolint: object_usage_linter. Hidden by dynamic glue. params <- list( implicit = TRUE, type = "style", @@ -120,10 +123,10 @@ return_linter <- function( /following-sibling::expr[OP-LEFT-BRACE and expr[last()]/@line1 != @line1] /expr[last()] " - if (is.null(except_regex)) { - body_xpath <- glue(body_xpath_fmt) - } else { + if (defer_except) { function_name_xpath <- "(//FUNCTION | //OP-LAMBDA)/parent::expr/preceding-sibling::expr/SYMBOL" + } else { + body_xpath <- glue(body_xpath_fmt) } params <- list( @@ -141,7 +144,7 @@ return_linter <- function( Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content - if (check_except && !is.null(except_regex)) { + 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) From 63e3887a9751d07f994f29d255da8ca1c31b06ca Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 14 Dec 2023 03:10:57 +0000 Subject: [PATCH 5/8] delint --- R/return_linter.R | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/R/return_linter.R b/R/return_linter.R index 2a4d6c837..a3d3afdd5 100644 --- a/R/return_linter.R +++ b/R/return_linter.R @@ -87,11 +87,13 @@ return_linter <- function( except_xpath_fmt <- "parent::expr[not( preceding-sibling::expr/SYMBOL[{ xp_text_in_table(union(special_funs, except)) }] )]" - if (!defer_except) except_xpath <- glue(except_xpath_fmt) # nolint: object_usage_linter. Hidden by dynamic glue. + # nolint next: object_usage_linter. Hidden by dynamic glue. + if (!defer_except) except_xpath <- glue(except_xpath_fmt) } if (return_style == "implicit") { - body_xpath <- "(//FUNCTION | //OP-LAMBDA)/following-sibling::expr[1]" # nolint: object_usage_linter. Hidden by dynamic glue. + # nolint next: object_usage_linter. Hidden by dynamic glue. + body_xpath <- "(//FUNCTION | //OP-LAMBDA)/following-sibling::expr[1]" params <- list( implicit = TRUE, type = "style", From c8cd16cf9e5259e272e00bacb25a0be23cd46fc3 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 14 Dec 2023 23:39:51 -0800 Subject: [PATCH 6/8] remove _linter suffix --- R/return_linter.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/return_linter.R b/R/return_linter.R index a3d3afdd5..055c53a1c 100644 --- a/R/return_linter.R +++ b/R/return_linter.R @@ -87,12 +87,12 @@ return_linter <- function( except_xpath_fmt <- "parent::expr[not( preceding-sibling::expr/SYMBOL[{ xp_text_in_table(union(special_funs, except)) }] )]" - # nolint next: object_usage_linter. Hidden by dynamic glue. + # nolint next: object_usage. Hidden by dynamic glue. if (!defer_except) except_xpath <- glue(except_xpath_fmt) } if (return_style == "implicit") { - # nolint next: object_usage_linter. Hidden by dynamic glue. + # nolint next: object_usage. Hidden by dynamic glue. body_xpath <- "(//FUNCTION | //OP-LAMBDA)/following-sibling::expr[1]" params <- list( implicit = TRUE, From 29d8a69c0a82e7f8c1a5eacffd12da00e1ae8050 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 14 Dec 2023 23:43:54 -0800 Subject: [PATCH 7/8] pass glue data directly for clarity --- R/return_linter.R | 15 ++++++--------- 1 file changed, 6 insertions(+), 9 deletions(-) diff --git a/R/return_linter.R b/R/return_linter.R index 055c53a1c..e035e1bcd 100644 --- a/R/return_linter.R +++ b/R/return_linter.R @@ -85,14 +85,13 @@ return_linter <- function( if (check_except) { except_xpath_fmt <- "parent::expr[not( - preceding-sibling::expr/SYMBOL[{ xp_text_in_table(union(special_funs, except)) }] + preceding-sibling::expr/SYMBOL[{ xp_text_in_table(except) }] )]" - # nolint next: object_usage. Hidden by dynamic glue. - if (!defer_except) except_xpath <- glue(except_xpath_fmt) + except <- union(special_funs, except) + if (!defer_except) except_xpath <- glue(except_xpath_fmt, except = except) } if (return_style == "implicit") { - # nolint next: object_usage. Hidden by dynamic glue. body_xpath <- "(//FUNCTION | //OP-LAMBDA)/following-sibling::expr[1]" params <- list( implicit = TRUE, @@ -101,8 +100,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", @@ -128,7 +125,7 @@ return_linter <- function( if (defer_except) { function_name_xpath <- "(//FUNCTION | //OP-LAMBDA)/parent::expr/preceding-sibling::expr/SYMBOL" } else { - body_xpath <- glue(body_xpath_fmt) + body_xpath <- glue(body_xpath_fmt, except_xpath = except_xpath) } params <- list( @@ -149,8 +146,8 @@ return_linter <- function( 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) - body_xpath <- glue(body_xpath_fmt) + 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) From 33b51b424565611136bae7e5a35a841cd94ad75e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 15 Dec 2023 07:51:57 +0000 Subject: [PATCH 8/8] nolint for false positive --- R/return_linter.R | 1 + 1 file changed, 1 insertion(+) diff --git a/R/return_linter.R b/R/return_linter.R index e035e1bcd..fd3dd5831 100644 --- a/R/return_linter.R +++ b/R/return_linter.R @@ -92,6 +92,7 @@ return_linter <- function( } if (return_style == "implicit") { + # nolint next: object_usage. False positive. body_xpath <- "(//FUNCTION | //OP-LAMBDA)/following-sibling::expr[1]" params <- list( implicit = TRUE,