diff --git a/DESCRIPTION b/DESCRIPTION index ff326321a..2afb4bb1e 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -76,6 +76,7 @@ Collate: 'commas_linter.R' 'commented_code_linter.R' 'comparison_negation_linter.R' + 'complex_conditional_linter.R' 'condition_call_linter.R' 'condition_message_linter.R' 'conjunct_test_linter.R' diff --git a/NAMESPACE b/NAMESPACE index 6b5c46937..e89104fa5 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -31,6 +31,7 @@ export(closed_curly_linter) export(commas_linter) export(commented_code_linter) export(comparison_negation_linter) +export(complex_conditional_linter) export(condition_call_linter) export(condition_message_linter) export(conjunct_test_linter) diff --git a/NEWS.md b/NEWS.md index b827f1e7a..24510ef34 100644 --- a/NEWS.md +++ b/NEWS.md @@ -19,7 +19,6 @@ * `scalar_in_linter` is now configurable to allow other `%in%` like operators to be linted. The data.table operator `%chin%` is no longer linted by default; use `in_operators = "%chin%"` to continue linting it. (@F-Noelle) * `lint()` and friends now normalize paths to forward slashes on Windows (@olivroy, #2613). * `undesirable_function_linter()`, `undesirable_operator_linter()`, and `list_comparison_linter()` were removed from the tag `efficiency` (@IndrajeetPatil, #2655). If you use `linters_with_tags("efficiency")` to include these linters, you'll need to adjust your config to keep linting your code against them. We did not find any such users on GitHub. - ## Bug fixes @@ -47,7 +46,7 @@ + `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`. +* `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). * `string_boundary_linter()` recognizes regular expression calls like `grepl("^abc$", x)` that can be replaced by using `==` instead (#1613, @MichaelChirico). @@ -83,6 +82,7 @@ * `pipe_return_linter()` for discouraging usage of `return()` inside a {magrittr} pipeline (part of #884, @MichaelChirico). * `one_call_pipe_linter()` for discouraging one-step pipelines like `x |> as.character()` (#2330 and part of #884, @MichaelChirico). * `object_overwrite_linter()` for discouraging re-use of upstream package exports as local variables (#2344, #2346 and part of #884, @MichaelChirico and @AshesITR). +* `complex_conditional_linter()` for encouraging refactoring of complex conditional expressions (like `if (x > 0 && y < 0 || z == 0)`) via well-named abstractions (#2676, @IndrajeetPatil). ### Lint accuracy fixes: removing false positives diff --git a/R/complex_conditional_linter.R b/R/complex_conditional_linter.R new file mode 100644 index 000000000..128440d87 --- /dev/null +++ b/R/complex_conditional_linter.R @@ -0,0 +1,111 @@ +#' Complex Conditional Expressions Linter +#' +#' Detects complex conditional expressions and suggests extracting +#' them into Boolean functions or variables for improved readability and reusability. +#' +#' For example, if you have a conditional expression with more than two logical operands, +#' +#' ``` +#' if (looks_like_a_duck(x) && +#' swims_like_a_duck(x) && +#' quacks_like_a_duck(x)) { +#' ... +#' } +#' ```` +#' +#' to improve its readability and reusability, you can extract the conditional expression. +#' +#' You can either extract it into a Boolean function: +#' +#' ``` +#' is_duck <- function(x) { +#' looks_like_a_duck(x) && +#' swims_like_a_duck(x) && +#' quacks_like_a_duck(x) +#' } +#' +#' if (is_duck(x)) { +#' ... +#' } +#' ``` +#' +#' or into a Boolean variable: +#' +#' ``` +#' is_duck <- looks_like_a_duck(x) && +#' swims_like_a_duck(x) && +#' quacks_like_a_duck(x) +#' +#' if (is_duck) { +#' ... +#' } +#' ``` +#' +#' In addition to improving code readability, extracting complex conditional expressions +#' has the added benefit of introducing a reusable abstraction. +#' +#' @param threshold Integer. The maximum number of logical operators (`&&` or `||`) +#' allowed in a conditional expression. The default is `2L`, meaning any conditional expression +#' with more than two logical operators will be flagged. +#' +#' @examples +#' # will produce lints +#' code <- "if (a && b && c) { do_something() }" +#' writeLines(code) +#' lint( +#' text = code, +#' linters = complex_conditional_linter() +#' ) +#' +#' # okay +#' code <- "if (ready_to_do_something) { do_something() }" +#' writeLines(code) +#' lint( +#' text = code, +#' linters = complex_conditional_linter() +#' ) +#' +#' code <- "if (a && b && c) { do_something() }" +#' writeLines(code) +#' lint( +#' text = code, +#' linters = complex_conditional_linter(threshold = 2L) +#' ) +#' +#' @evalRd rd_tags("complex_conditional_linter") +#' @seealso [linters] for a complete list of linters available in lintr. +#' @export +complex_conditional_linter <- function(threshold = 2L) { + stopifnot(is.numeric(threshold), length(threshold) == 1L, threshold >= 1L) + threshold <- as.integer(threshold) + + xpath <- glue::glue("//expr[ + parent::expr[IF or WHILE] + and + preceding-sibling::*[1][self::OP-LEFT-PAREN] + and + following-sibling::*[1][self::OP-RIGHT-PAREN] + and + count(descendant-or-self::*[AND2 or OR2]) > {threshold} + ]") + + + Linter(linter_level = "expression", function(source_expression) { + xml <- source_expression$xml_parsed_content + + nodes <- xml2::xml_find_all(xml, xpath) + + lints <- xml_nodes_to_lints( + nodes, + source_expression = source_expression, + lint_message = paste0( + "Complex conditional with more than ", + threshold, + " logical operator(s). Consider extracting into a boolean function or variable for readability and reusability." + ), + type = "warning" + ) + + lints + }) +} diff --git a/R/get_source_expressions.R b/R/get_source_expressions.R index 3f1817023..70bda9dd2 100644 --- a/R/get_source_expressions.R +++ b/R/get_source_expressions.R @@ -85,8 +85,9 @@ get_source_expressions <- function(filename, lines = NULL) { names(source_expression$lines) <- seq_along(source_expression$lines) source_expression$content <- get_content(source_expression$lines) parsed_content <- get_source_expression(source_expression, error = function(e) lint_parse_error(e, source_expression)) + is_unreliable_lint <- is.na(e$line) || !nzchar(e$line) || e$message == "unexpected end of input" - if (is_lint(e) && (is.na(e$line) || !nzchar(e$line) || e$message == "unexpected end of input")) { + if (is_lint(e) && is_unreliable_lint) { # Don't create expression list if it's unreliable (invalid encoding or unhandled parse error) expressions <- list() } else { diff --git a/R/lint.R b/R/lint.R index 1961acb05..772b0f381 100644 --- a/R/lint.R +++ b/R/lint.R @@ -360,11 +360,11 @@ validate_linter_object <- function(linter, name) { ) } +# A linter factory is a function whose last call is to `Linter()` is_linter_factory <- function(fun) { - # A linter factory is a function whose last call is to Linter() bdexpr <- body(fun) - # covr internally transforms each call into if (TRUE) { covr::count(...); call } - while (is.call(bdexpr) && (bdexpr[[1L]] == "{" || (bdexpr[[1L]] == "if" && bdexpr[[2L]] == "TRUE"))) { + # covr internally transforms each call into `if (TRUE) { covr::count(...); call }` + while (is.call(bdexpr) && (bdexpr[[1L]] == "{" || (bdexpr[[1L]] == "if" && bdexpr[[2L]] == "TRUE"))) { # nolint: complex_conditional_linter bdexpr <- bdexpr[[length(bdexpr)]] } is.call(bdexpr) && identical(bdexpr[[1L]], as.name("Linter")) diff --git a/R/unnecessary_nesting_linter.R b/R/unnecessary_nesting_linter.R index 653406881..77ea0aacd 100644 --- a/R/unnecessary_nesting_linter.R +++ b/R/unnecessary_nesting_linter.R @@ -238,7 +238,7 @@ unnecessary_nesting_linter <- function( unnecessary_else_brace_lints <- xml_nodes_to_lints( unnecessary_else_brace_expr, source_expression = source_expression, - lint_message = "Simplify this condition by using 'else if' instead of 'else { if.", + lint_message = "Simplify this condition by using 'else if' instead of 'else { if'.", type = "warning" ) diff --git a/R/utils.R b/R/utils.R index acdf2c521..f38941fba 100644 --- a/R/utils.R +++ b/R/utils.R @@ -1,5 +1,6 @@ `%||%` <- function(x, y) { - if (is.null(x) || length(x) == 0L || (is.atomic(x[[1L]]) && is.na(x[[1L]]))) { + is_atomic_and_missing <- is.atomic(x[[1L]]) && is.na(x[[1L]]) + if (is.null(x) || length(x) == 0L || is_atomic_and_missing) { y } else { x diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 1f070f45f..5832b8a14 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -11,6 +11,7 @@ closed_curly_linter,defunct commas_linter,style readability default configurable commented_code_linter,style readability best_practices default comparison_negation_linter,readability consistency +complex_conditional_linter,style readability best_practices configurable condition_call_linter,style tidy_design best_practices configurable condition_message_linter,best_practices consistency conjunct_test_linter,package_development best_practices readability configurable pkg_testthat diff --git a/man/best_practices_linters.Rd b/man/best_practices_linters.Rd index 9e55cb99e..a93f11448 100644 --- a/man/best_practices_linters.Rd +++ b/man/best_practices_linters.Rd @@ -18,6 +18,7 @@ The following linters are tagged with 'best_practices': \item{\code{\link{boolean_arithmetic_linter}}} \item{\code{\link{class_equals_linter}}} \item{\code{\link{commented_code_linter}}} +\item{\code{\link{complex_conditional_linter}}} \item{\code{\link{condition_call_linter}}} \item{\code{\link{condition_message_linter}}} \item{\code{\link{conjunct_test_linter}}} diff --git a/man/complex_conditional_linter.Rd b/man/complex_conditional_linter.Rd new file mode 100644 index 000000000..f717606ea --- /dev/null +++ b/man/complex_conditional_linter.Rd @@ -0,0 +1,87 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/complex_conditional_linter.R +\name{complex_conditional_linter} +\alias{complex_conditional_linter} +\title{Complex Conditional Expressions Linter} +\usage{ +complex_conditional_linter(threshold = 2L) +} +\arguments{ +\item{threshold}{Integer. The maximum number of logical operators (\code{&&} or \code{||}) +allowed in a conditional expression. The default is \code{2L}, meaning any conditional expression +with more than two logical operators will be flagged.} +} +\description{ +Detects complex conditional expressions and suggests extracting +them into Boolean functions or variables for improved readability and reusability. +} +\details{ +For example, if you have a conditional expression with more than two logical operands, + +\if{html}{\out{
}}\preformatted{if (looks_like_a_duck(x) && + swims_like_a_duck(x) && + quacks_like_a_duck(x)) \{ + ... +\} +}\if{html}{\out{
}} + +to improve its readability and reusability, you can extract the conditional expression. + +You can either extract it into a Boolean function: + +\if{html}{\out{
}}\preformatted{is_duck <- function(x) \{ + looks_like_a_duck(x) && + swims_like_a_duck(x) && + quacks_like_a_duck(x) +\} + +if (is_duck(x)) \{ + ... +\} +}\if{html}{\out{
}} + +or into a Boolean variable: + +\if{html}{\out{
}}\preformatted{is_duck <- looks_like_a_duck(x) && + swims_like_a_duck(x) && + quacks_like_a_duck(x) + +if (is_duck) \{ + ... +\} +}\if{html}{\out{
}} + +In addition to improving code readability, extracting complex conditional expressions +has the added benefit of introducing a reusable abstraction. +} +\examples{ +# will produce lints +code <- "if (a && b && c) { do_something() }" +writeLines(code) +lint( + text = code, + linters = complex_conditional_linter() +) + +# okay +code <- "if (ready_to_do_something) { do_something() }" +writeLines(code) +lint( + text = code, + linters = complex_conditional_linter() +) + +code <- "if (a && b && c) { do_something() }" +writeLines(code) +lint( + text = code, + linters = complex_conditional_linter(threshold = 2L) +) + +} +\seealso{ +\link{linters} for a complete list of linters available in lintr. +} +\section{Tags}{ +\link[=best_practices_linters]{best_practices}, \link[=configurable_linters]{configurable}, \link[=readability_linters]{readability}, \link[=style_linters]{style} +} diff --git a/man/configurable_linters.Rd b/man/configurable_linters.Rd index 1c72fffab..84193ab5d 100644 --- a/man/configurable_linters.Rd +++ b/man/configurable_linters.Rd @@ -17,6 +17,7 @@ The following linters are tagged with 'configurable': \item{\code{\link{backport_linter}}} \item{\code{\link{brace_linter}}} \item{\code{\link{commas_linter}}} +\item{\code{\link{complex_conditional_linter}}} \item{\code{\link{condition_call_linter}}} \item{\code{\link{conjunct_test_linter}}} \item{\code{\link{consecutive_mutate_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index 50f8baf7d..9848fcbf8 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -17,9 +17,9 @@ see also \code{\link[=available_tags]{available_tags()}}. \section{Tags}{ The following tags exist: \itemize{ -\item{\link[=best_practices_linters]{best_practices} (63 linters)} +\item{\link[=best_practices_linters]{best_practices} (64 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (11 linters)} -\item{\link[=configurable_linters]{configurable} (44 linters)} +\item{\link[=configurable_linters]{configurable} (45 linters)} \item{\link[=consistency_linters]{consistency} (32 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} @@ -28,10 +28,10 @@ The following tags exist: \item{\link[=executing_linters]{executing} (6 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} \item{\link[=pkg_testthat_linters]{pkg_testthat} (12 linters)} -\item{\link[=readability_linters]{readability} (64 linters)} +\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} (40 linters)} +\item{\link[=style_linters]{style} (41 linters)} \item{\link[=tidy_design_linters]{tidy_design} (1 linters)} } } @@ -49,6 +49,7 @@ The following linters exist: \item{\code{\link{commas_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{commented_code_linter}} (tags: best_practices, default, readability, style)} \item{\code{\link{comparison_negation_linter}} (tags: consistency, readability)} +\item{\code{\link{complex_conditional_linter}} (tags: best_practices, configurable, readability, style)} \item{\code{\link{condition_call_linter}} (tags: best_practices, configurable, style, tidy_design)} \item{\code{\link{condition_message_linter}} (tags: best_practices, consistency)} \item{\code{\link{conjunct_test_linter}} (tags: best_practices, configurable, package_development, pkg_testthat, readability)} diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index 372d2fd9e..3a12a7ef7 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -17,6 +17,7 @@ The following linters are tagged with 'readability': \item{\code{\link{commas_linter}}} \item{\code{\link{commented_code_linter}}} \item{\code{\link{comparison_negation_linter}}} +\item{\code{\link{complex_conditional_linter}}} \item{\code{\link{conjunct_test_linter}}} \item{\code{\link{consecutive_assertion_linter}}} \item{\code{\link{consecutive_mutate_linter}}} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index 1a7e188c9..c5ef0a619 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -16,6 +16,7 @@ The following linters are tagged with 'style': \item{\code{\link{brace_linter}}} \item{\code{\link{commas_linter}}} \item{\code{\link{commented_code_linter}}} +\item{\code{\link{complex_conditional_linter}}} \item{\code{\link{condition_call_linter}}} \item{\code{\link{consecutive_assertion_linter}}} \item{\code{\link{cyclocomp_linter}}} diff --git a/tests/testthat/test-complex_conditional_linter.R b/tests/testthat/test-complex_conditional_linter.R new file mode 100644 index 000000000..9185291f9 --- /dev/null +++ b/tests/testthat/test-complex_conditional_linter.R @@ -0,0 +1,190 @@ +test_that("complex_conditional_linter doesn't lint simple conditionals", { + linter <- complex_conditional_linter() + + expect_lint( + trim_some(" + if (x > 0) { + print('simple') + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x > 0 && y < 10) { + print('two conditions') + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + while (i <= n && !done) { + i <- i + 1 + } + "), + NULL, + linter + ) +}) + +test_that("complex_conditional_linter lints complex conditionals above set threshold", { + linter <- complex_conditional_linter(threshold = 1L) + lint_message <- rex::rex("Complex conditional with more than 1 logical operator(s)") + + expect_lint( + trim_some(" + if (x > 0 && y < 10 && z == TRUE) { + print('complex') + } + "), + lint_message, + linter + ) + + expect_lint( + trim_some(" + while (a > b || c < d && e == f) { + next + } + "), + lint_message, + linter + ) +}) + +test_that("complex_conditional_linter handles nested conditionals", { + linter <- complex_conditional_linter() + lint_message <- rex::rex("Complex conditional with more than 2 logical operator(s)") + + # simple outer, complex inner + expect_lint( + trim_some(" + if (x > 0) { + if (a == 1 && b == 2 && c == 3 && d == 4) { + print('nested') + } + } + "), + lint_message, + linter + ) + + # multiple complex conditions + expect_lint( + trim_some(" + if (x > 0 && y < 10 && z == TRUE && !w) { + while (a && b && c || d) { + print('double complex') + } + } + "), + list( + list(message = lint_message, line_number = 1L), + list(message = lint_message, line_number = 2L) + ), + linter + ) +}) + +test_that("complex_conditional_linter respects threshold parameter", { + expect_lint( + trim_some(" + if (a && b && c) { + print('test') + } + "), + NULL, + complex_conditional_linter(threshold = 3L) + ) + + expect_lint( + trim_some(" + if (a && b && c && d) { + print('test') + } + "), + rex::rex("Complex conditional with more than 2 logical operator(s)"), + complex_conditional_linter(threshold = 2L) + ) +}) + +test_that("complex_conditional_linter handles mixed operators and parentheses", { + linter <- complex_conditional_linter(threshold = 2L) + lint_message <- rex::rex("Complex conditional with more than 2 logical operator(s)") + + expect_lint( + trim_some(" + if ((a && b) || (c && d) || e) { + print('mixed') + } + "), + lint_message, + linter + ) + + expect_lint( + trim_some(" + if (a && (b || c) && d) { + print('nested ops') + } + "), + lint_message, + linter + ) +}) + +test_that("complex_conditional_linter skips non-conditional expressions", { + linter <- complex_conditional_linter() + + expect_lint( + trim_some(" + x <- a && b && c && d + if (x) { + print('okay') + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + result <- all( + a > 0, + b < 10, + c != 0, + !is.na(d) + ) + if (result) { + print('clean') + } + "), + NULL, + linter + ) +}) + +# styler: off +invalid_cases <- list( + list(name = "character", input = "2", error = "is.numeric"), + list(name = "logical", input = TRUE, error = "is.numeric"), + list(name = "vector", input = c(2L, 3L), error = "length"), + list(name = "empty", input = numeric(0L), error = "length"), + list(name = "zero", input = 0L, error = "threshold >= 1L"), + list(name = "negative", input = -1L, error = "threshold >= 1L"), + list(name = "NA", input = NA_real_, error = "is.numeric"), + list(name = "NaN", input = NaN, error = "threshold >= 1L"), + list(name = "Inf", input = Inf, error = "threshold >= 1L") +) +# styler: on + +patrick::with_parameters_test_that( + "complex_conditional_linter rejects invalid threshold arguments", + expect_error(complex_conditional_linter(input), regexp = invalid_cases$error), + .cases = invalid_cases +) diff --git a/tests/testthat/test-unnecessary_nesting_linter.R b/tests/testthat/test-unnecessary_nesting_linter.R index a1114e965..70d29009a 100644 --- a/tests/testthat/test-unnecessary_nesting_linter.R +++ b/tests/testthat/test-unnecessary_nesting_linter.R @@ -651,7 +651,7 @@ test_that("unnecessary_nesting_linter blocks disallowed usages", { test_that("else that can drop braces is found", { linter <- unnecessary_nesting_linter() - lint_msg <- rex::rex("Simplify this condition by using 'else if' instead of 'else { if.") + lint_msg <- rex::rex("Simplify this condition by using 'else if' instead of 'else { if'.") expect_lint( trim_some("