From 033c0d98486c743e442b674b72c464e57aa7ca2f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 19 Dec 2023 05:29:42 +0800 Subject: [PATCH 1/7] Subsume unnecessary_nested_if_linter() into unnecessary_nesting_linter() (#2458) --- DESCRIPTION | 1 - NEWS.md | 1 + R/lintr-deprecated.R | 38 ++ R/unnecessary_nested_if_linter.R | 44 -- R/unnecessary_nesting_linter.R | 41 +- inst/lintr/linters.csv | 4 +- man/best_practices_linters.Rd | 2 +- man/deprecated_linters.Rd | 1 + man/linters.Rd | 7 +- man/lintr-deprecated.Rd | 3 + man/readability_linters.Rd | 1 - man/unnecessary_nested_if_linter.Rd | 39 -- man/unnecessary_nesting_linter.Rd | 20 +- .../test-unnecessary_nested_if_linter.R | 15 +- .../test-unnecessary_nesting_linter.R | 538 ++++++++++++++---- 15 files changed, 542 insertions(+), 213 deletions(-) delete mode 100644 R/unnecessary_nested_if_linter.R delete mode 100644 man/unnecessary_nested_if_linter.Rd diff --git a/DESCRIPTION b/DESCRIPTION index f00ad990c..4a46f62ef 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -192,7 +192,6 @@ Collate: 'undesirable_operator_linter.R' 'unnecessary_concatenation_linter.R' 'unnecessary_lambda_linter.R' - 'unnecessary_nested_if_linter.R' 'unnecessary_nesting_linter.R' 'unnecessary_placeholder_linter.R' 'unreachable_code_linter.R' diff --git a/NEWS.md b/NEWS.md index 830f8be46..c2230b008 100644 --- a/NEWS.md +++ b/NEWS.md @@ -13,6 +13,7 @@ * `all_linters()` has signature `all_linters(..., packages)` rather than `all_linters(packages, ...)` (#2332, @MichaelChirico). This forces `packages=` to be supplied by name and will break users who rely on supplying `packages=` positionally, of which we found none searching GitHub. * Adjusted various lint messages for consistency in readability (#1330, @MichaelChirico). In general, we favor lint messages to be phrased like "Action, reason" to but the "what" piece of the message front-and-center. This may be a breaking change for code that tests the specific phrasing of lints. * `extraction_operator_linter()` is deprecated. Although switching from `$` to `[[` has some robustness benefits for package code, it can lead to non-idiomatic code in many contexts (e.g. R6 classes, Shiny applications, etc.) (#2409, @IndrajeetPatil). To enable the detection of the `$` operator for extraction through partial matching, use `options(warnPartialMatchDollar = TRUE)`. +* `unnecessary_nested_if_linter()` is deprecated and subsumed into the new/more general `unnecessary_nesting_linter()`. ## Bug fixes diff --git a/R/lintr-deprecated.R b/R/lintr-deprecated.R index 549109f2c..2d20aa904 100644 --- a/R/lintr-deprecated.R +++ b/R/lintr-deprecated.R @@ -161,3 +161,41 @@ extraction_operator_linter <- function() { ) }) } + +#' Unnecessary nested if linter +#' @rdname lintr-deprecated +#' @export +unnecessary_nested_if_linter <- function() { + lintr_deprecated( + what = "unnecessary_nested_if_linter", + alternative = "unnecessary_nesting_linter", + version = "3.2.0", + type = "Linter", + signal = "warning" + ) + + xpath <- paste0( + "//IF/parent::expr[not(ELSE)]/OP-RIGHT-PAREN/", + c( + "following-sibling::expr[IF and not(ELSE)]", # catch if (cond) if (other_cond) { ... } + "following-sibling::expr[OP-LEFT-BRACE and count(expr) = 1] + /expr[IF and not(ELSE)]" # catch if (cond) { if (other_cond) { ... } } + ), + collapse = " | " + ) + + Linter(linter_level = "expression", function(source_expression) { + xml <- source_expression$xml_parsed_content + + bad_exprs <- xml_find_all(xml, xpath) + xml_nodes_to_lints( + bad_exprs, + source_expression = source_expression, + lint_message = paste( + "Don't use nested `if` statements,", + "where a single `if` with the combined conditional expression will do.", + "For example, instead of `if (x) { if (y) { ... }}`, use `if (x && y) { ... }`." + ) + ) + }) +} diff --git a/R/unnecessary_nested_if_linter.R b/R/unnecessary_nested_if_linter.R deleted file mode 100644 index 5702fc7d7..000000000 --- a/R/unnecessary_nested_if_linter.R +++ /dev/null @@ -1,44 +0,0 @@ -#' Avoid unnecessary nested `if` conditional statements -#' -#' @examples -#' # will produce lints -#' writeLines("if (x) { \n if (y) { \n return(1L) \n } \n}") -#' lint( -#' text = "if (x) { \n if (y) { \n return(1L) \n } \n}", -#' linters = unnecessary_nested_if_linter() -#' ) -#' -#' # okay -#' writeLines("if (x && y) { \n return(1L) \n}") -#' lint( -#' text = "if (x && y) { \n return(1L) \n}", -#' linters = unnecessary_nested_if_linter() -#' ) -#' -#' writeLines("if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}") -#' lint( -#' text = "if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}", -#' linters = unnecessary_nested_if_linter() -#' ) -#' -#' @evalRd rd_tags("unnecessary_nested_if_linter") -#' @seealso [linters] for a complete list of linters available in lintr. -#' @export -unnecessary_nested_if_linter <- make_linter_from_xpath( - xpath = paste0( - "//IF/parent::expr[not(ELSE)]/OP-RIGHT-PAREN/", - c( - "following-sibling::expr[IF and not(ELSE)]", # catch if (cond) if (other_cond) { ... } - "following-sibling::expr[OP-LEFT-BRACE and count(expr) = 1] - /expr[IF and not(ELSE)]" # catch if (cond) { if (other_cond) { ... } } - ), - collapse = " | " - ), - lint_message = paste( - "Don't use nested `if` statements,", - "where a single `if` with the combined conditional expression will do.", - "For example, instead of `if (x) { if (y) { ... }}`, use `if (x && y) { ... }`." - ), - # need the full file to also catch usages at the top level - level = "file" -) diff --git a/R/unnecessary_nesting_linter.R b/R/unnecessary_nesting_linter.R index fdd2a4798..7d20084c6 100644 --- a/R/unnecessary_nesting_linter.R +++ b/R/unnecessary_nesting_linter.R @@ -33,6 +33,12 @@ #' linters = unnecessary_nesting_linter(allow_assignment = FALSE) #' ) #' +#' writeLines("if (x) { \n if (y) { \n return(1L) \n } \n}") +#' lint( +#' text = "if (x) { \n if (y) { \n return(1L) \n } \n}", +#' linters = unnecessary_nested_if_linter() +#' ) +#' #' # okay #' code <- "if (A) {\n stop('A is bad because a.')\n} else {\n stop('!A is bad too.')\n}" #' writeLines(code) @@ -55,6 +61,18 @@ #' linters = unnecessary_nesting_linter() #' ) #' +#' writeLines("if (x && y) { \n return(1L) \n}") +#' lint( +#' text = "if (x && y) { \n return(1L) \n}", +#' linters = unnecessary_nested_if_linter() +#' ) +#' +#' writeLines("if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}") +#' lint( +#' text = "if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}", +#' linters = unnecessary_nested_if_linter() +#' ) +#' #' @evalRd rd_tags("unnecessary_nesting_linter") #' @seealso #' - [cyclocomp_linter()] for another linter that penalizes overly complexcode. @@ -141,6 +159,17 @@ unnecessary_nesting_linter <- function(allow_assignment = TRUE) { ] ") + unnecessary_nested_if_xpath <- paste0( + "//IF/parent::expr[not(ELSE)]/OP-RIGHT-PAREN/", + c( + # catch if (cond) if (other_cond) { ... } + "following-sibling::expr[IF and not(ELSE)]", + # catch if (cond) { if (other_cond) { ... } } + "following-sibling::expr[OP-LEFT-BRACE and count(expr) = 1]/expr[IF and not(ELSE)]" + ), + collapse = " | " + ) + Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content @@ -165,6 +194,16 @@ unnecessary_nesting_linter <- function(allow_assignment = TRUE) { type = "warning" ) - c(if_else_exit_lints, unnecessary_brace_lints) + unnecessary_nested_if_expr <- xml_find_all(xml, unnecessary_nested_if_xpath) + unnecessary_nested_if_lints <- xml_nodes_to_lints( + unnecessary_nested_if_expr, + source_expression = source_expression, + lint_message = paste( + "Don't use nested `if` statements, where a single `if` with the combined conditional expression will do.", + "For example, instead of `if (x) { if (y) { ... }}`, use `if (x && y) { ... }`." + ) + ) + + c(if_else_exit_lints, unnecessary_brace_lints, unnecessary_nested_if_lints) }) } diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index e0805e47d..77907fb74 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -112,8 +112,8 @@ undesirable_function_linter,style efficiency configurable robustness best_practi undesirable_operator_linter,style efficiency configurable robustness best_practices unnecessary_concatenation_linter,style readability efficiency configurable unnecessary_lambda_linter,best_practices efficiency readability configurable -unnecessary_nested_if_linter,readability best_practices -unnecessary_nesting_linter,readability consistency configurable +unnecessary_nested_if_linter,readability best_practices deprecated +unnecessary_nesting_linter,readability consistency configurable best_practices unnecessary_placeholder_linter,readability best_practices unneeded_concatenation_linter,style readability efficiency configurable deprecated unreachable_code_linter,best_practices readability configurable diff --git a/man/best_practices_linters.Rd b/man/best_practices_linters.Rd index 101e5e153..9e55cb99e 100644 --- a/man/best_practices_linters.Rd +++ b/man/best_practices_linters.Rd @@ -69,7 +69,7 @@ The following linters are tagged with 'best_practices': \item{\code{\link{undesirable_function_linter}}} \item{\code{\link{undesirable_operator_linter}}} \item{\code{\link{unnecessary_lambda_linter}}} -\item{\code{\link{unnecessary_nested_if_linter}}} +\item{\code{\link{unnecessary_nesting_linter}}} \item{\code{\link{unnecessary_placeholder_linter}}} \item{\code{\link{unreachable_code_linter}}} \item{\code{\link{unused_import_linter}}} diff --git a/man/deprecated_linters.Rd b/man/deprecated_linters.Rd index e6470b77c..df533f2b3 100644 --- a/man/deprecated_linters.Rd +++ b/man/deprecated_linters.Rd @@ -17,6 +17,7 @@ The following linters are tagged with 'deprecated': \item{\code{\link{extraction_operator_linter}}} \item{\code{\link{no_tab_linter}}} \item{\code{\link{single_quotes_linter}}} +\item{\code{\link{unnecessary_nested_if_linter}}} \item{\code{\link{unneeded_concatenation_linter}}} } } diff --git a/man/linters.Rd b/man/linters.Rd index 76cd1d34f..838044aad 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -23,12 +23,12 @@ The following tags exist: \item{\link[=consistency_linters]{consistency} (32 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (26 linters)} -\item{\link[=deprecated_linters]{deprecated} (5 linters)} +\item{\link[=deprecated_linters]{deprecated} (6 linters)} \item{\link[=efficiency_linters]{efficiency} (32 linters)} \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} (65 linters)} +\item{\link[=readability_linters]{readability} (64 linters)} \item{\link[=regex_linters]{regex} (4 linters)} \item{\link[=robustness_linters]{robustness} (17 linters)} \item{\link[=style_linters]{style} (40 linters)} @@ -143,8 +143,7 @@ The following linters exist: \item{\code{\link{undesirable_operator_linter}} (tags: best_practices, configurable, efficiency, robustness, style)} \item{\code{\link{unnecessary_concatenation_linter}} (tags: configurable, efficiency, readability, style)} \item{\code{\link{unnecessary_lambda_linter}} (tags: best_practices, configurable, efficiency, readability)} -\item{\code{\link{unnecessary_nested_if_linter}} (tags: best_practices, readability)} -\item{\code{\link{unnecessary_nesting_linter}} (tags: configurable, consistency, readability)} +\item{\code{\link{unnecessary_nesting_linter}} (tags: best_practices, configurable, consistency, readability)} \item{\code{\link{unnecessary_placeholder_linter}} (tags: best_practices, readability)} \item{\code{\link{unreachable_code_linter}} (tags: best_practices, configurable, readability)} \item{\code{\link{unused_import_linter}} (tags: best_practices, common_mistakes, configurable, executing)} diff --git a/man/lintr-deprecated.Rd b/man/lintr-deprecated.Rd index 3d6ff1b23..f7ef42a41 100644 --- a/man/lintr-deprecated.Rd +++ b/man/lintr-deprecated.Rd @@ -11,6 +11,7 @@ \alias{consecutive_stopifnot_linter} \alias{no_tab_linter} \alias{extraction_operator_linter} +\alias{unnecessary_nested_if_linter} \alias{with_defaults} \title{Deprecated functions in lintr} \usage{ @@ -32,6 +33,8 @@ no_tab_linter() extraction_operator_linter() +unnecessary_nested_if_linter() + with_defaults(..., default = default_linters) } \arguments{ diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index ed0c5f868..372d2fd9e 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -71,7 +71,6 @@ The following linters are tagged with 'readability': \item{\code{\link{T_and_F_symbol_linter}}} \item{\code{\link{unnecessary_concatenation_linter}}} \item{\code{\link{unnecessary_lambda_linter}}} -\item{\code{\link{unnecessary_nested_if_linter}}} \item{\code{\link{unnecessary_nesting_linter}}} \item{\code{\link{unnecessary_placeholder_linter}}} \item{\code{\link{unreachable_code_linter}}} diff --git a/man/unnecessary_nested_if_linter.Rd b/man/unnecessary_nested_if_linter.Rd deleted file mode 100644 index 3b27ee6e4..000000000 --- a/man/unnecessary_nested_if_linter.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/unnecessary_nested_if_linter.R -\name{unnecessary_nested_if_linter} -\alias{unnecessary_nested_if_linter} -\title{Avoid unnecessary nested \code{if} conditional statements} -\usage{ -unnecessary_nested_if_linter() -} -\description{ -Avoid unnecessary nested \code{if} conditional statements -} -\examples{ -# will produce lints -writeLines("if (x) { \n if (y) { \n return(1L) \n } \n}") -lint( - text = "if (x) { \n if (y) { \n return(1L) \n } \n}", - linters = unnecessary_nested_if_linter() -) - -# okay -writeLines("if (x && y) { \n return(1L) \n}") -lint( - text = "if (x && y) { \n return(1L) \n}", - linters = unnecessary_nested_if_linter() -) - -writeLines("if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}") -lint( - text = "if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}", - linters = unnecessary_nested_if_linter() -) - -} -\seealso{ -\link{linters} for a complete list of linters available in lintr. -} -\section{Tags}{ -\link[=best_practices_linters]{best_practices}, \link[=readability_linters]{readability} -} diff --git a/man/unnecessary_nesting_linter.Rd b/man/unnecessary_nesting_linter.Rd index 484097017..f4ce0853d 100644 --- a/man/unnecessary_nesting_linter.Rd +++ b/man/unnecessary_nesting_linter.Rd @@ -41,6 +41,12 @@ lint( linters = unnecessary_nesting_linter(allow_assignment = FALSE) ) +writeLines("if (x) { \n if (y) { \n return(1L) \n } \n}") +lint( + text = "if (x) { \n if (y) { \n return(1L) \n } \n}", + linters = unnecessary_nested_if_linter() +) + # okay code <- "if (A) {\n stop('A is bad because a.')\n} else {\n stop('!A is bad too.')\n}" writeLines(code) @@ -63,6 +69,18 @@ lint( linters = unnecessary_nesting_linter() ) +writeLines("if (x && y) { \n return(1L) \n}") +lint( + text = "if (x && y) { \n return(1L) \n}", + linters = unnecessary_nested_if_linter() +) + +writeLines("if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}") +lint( + text = "if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}", + linters = unnecessary_nested_if_linter() +) + } \seealso{ \itemize{ @@ -71,5 +89,5 @@ lint( } } \section{Tags}{ -\link[=configurable_linters]{configurable}, \link[=consistency_linters]{consistency}, \link[=readability_linters]{readability} +\link[=best_practices_linters]{best_practices}, \link[=configurable_linters]{configurable}, \link[=consistency_linters]{consistency}, \link[=readability_linters]{readability} } diff --git a/tests/testthat/test-unnecessary_nested_if_linter.R b/tests/testthat/test-unnecessary_nested_if_linter.R index f5b87a68e..8308b2791 100644 --- a/tests/testthat/test-unnecessary_nested_if_linter.R +++ b/tests/testthat/test-unnecessary_nested_if_linter.R @@ -1,5 +1,14 @@ +test_that("unnecessary_nested_if_linter generates deprecation warning", { + expect_warning( + unnecessary_nested_if_linter(), + rex::rex("unnecessary_nested_if_linter was deprecated", anything, "Use unnecessary_nesting_linter") + ) +}) + test_that("unnecessary_nested_if_linter skips allowed usages", { - linter <- unnecessary_nested_if_linter() + expect_warning({ + linter <- unnecessary_nested_if_linter() + }) expect_lint( trim_some(" @@ -174,7 +183,9 @@ test_that("unnecessary_nested_if_linter skips allowed usages", { test_that("unnecessary_nested_if_linter blocks disallowed usages", { lint_message <- rex::rex("Don't use nested `if` statements") - linter <- unnecessary_nested_if_linter() + expect_warning({ + linter <- unnecessary_nested_if_linter() + }) expect_lint( trim_some(" diff --git a/tests/testthat/test-unnecessary_nesting_linter.R b/tests/testthat/test-unnecessary_nesting_linter.R index 50aa3351e..41ad17165 100644 --- a/tests/testthat/test-unnecessary_nesting_linter.R +++ b/tests/testthat/test-unnecessary_nesting_linter.R @@ -32,107 +32,115 @@ test_that("unnecessary_nesting_linter skips allowed usages", { # but it's not true in general. test_that("Multiple if/else statements don't require unnesting", { # with further branches, reducing nesting might be less readable - if_else_if_else_lines <- c( - "if (x == 'a') {", - " stop()", - "} else if (x == 'b') {", - " do_b()", - "} else {", - " stop()", - "}" - ) - expect_lint(if_else_if_else_lines, NULL, unnecessary_nesting_linter()) + expect_lint( + trim_some(" + if (x == 'a') { + stop() + } else if (x == 'b') { + do_b() + } else { + stop() + } + "), + NULL, + unnecessary_nesting_linter() + ) }) test_that("else-less if statements don't lint", { - multi_statement_if_lines <- c( - "if (x == 4) {", - " msg <- 'failed'", - " stop(msg)", - "}" + expect_lint( + trim_some(" + if (x == 4) { + msg <- 'failed' + stop(msg) + } + "), + NULL, + unnecessary_nesting_linter() ) - expect_lint(multi_statement_if_lines, NULL, unnecessary_nesting_linter()) }) test_that("non-terminal expressions are not considered for the logic", { - multi_statement_if_lines <- c( - "if (x == 4) {", - " x <- 5", - " return(x)", - "} else {", - " return(x)", - "}" - ) - expect_lint(multi_statement_if_lines, NULL, unnecessary_nesting_linter()) + expect_lint( + trim_some(" + if (x == 4) { + x <- 5 + return(x) + } else { + return(x) + } + "), + NULL, + unnecessary_nesting_linter() + ) }) test_that("parallels in further nesting are skipped", { - terminal_if_else_lines <- c( - "if (length(bucket) > 1) {", - " return(age)", - "} else {", - " if (grepl('[0-9]', age)) {", - " return(age)", - " } else {", - " return('unknown')", - " }", - "}" - ) - expect_lint(terminal_if_else_lines, NULL, unnecessary_nesting_linter()) + expect_lint( + trim_some(" + if (length(bucket) > 1) { + return(age) + } else { + if (grepl('[0-9]', age)) { + return(age) + } else { + return('unknown') + } + } + "), + NULL, + unnecessary_nesting_linter() + ) }) test_that("unnecessary_nesting_linter blocks if/else with one exit branch", { linter <- unnecessary_nesting_linter() - if_stop_lines <- c( - "if (A) {", - " stop()", - "} else {", - " B", - "}" - ) expect_lint( - if_stop_lines, + trim_some(" + if (A) { + stop() + } else { + B + } + "), rex::rex("Reduce the nesting of this if/else statement by unnesting the portion"), linter ) - if_return_lines <- c( - "if (A) {", - " return()", - "} else {", - " B", - "}" - ) expect_lint( - if_return_lines, + trim_some(" + if (A) { + return() + } else { + B + } + "), rex::rex("Reduce the nesting of this if/else statement by unnesting the portion"), linter ) # also find exits in the later branch - else_stop_lines <- c( - "if (A) {", - " B", - "} else {", - " stop()", - "}" - ) expect_lint( - else_stop_lines, + trim_some(" + if (A) { + B + } else { + stop() + } + "), rex::rex("Reduce the nesting of this if/else statement by unnesting the portion"), linter ) - else_return_lines <- c( - "if (A) {", - " B", - "} else {", - " return()", - "}" - ) expect_lint( - else_return_lines, + trim_some(" + if (A) { + B + } else { + return() + } + "), rex::rex("Reduce the nesting of this if/else statement by unnesting the portion"), linter ) @@ -141,68 +149,89 @@ test_that("unnecessary_nesting_linter blocks if/else with one exit branch", { test_that("unnecessary_nesting_linter skips one-line functions", { linter <- unnecessary_nesting_linter() - anonymous_function_lines <- c( - "foo <- function(x) {", - " return(x)", - "}" + expect_lint( + trim_some(" + foo <- function(x) { + return(x) + } + "), + NULL, + linter ) - expect_lint(anonymous_function_lines, NULL, linter) # purrr anonymous functions also get skipped - purrr_function_lines <- c( - "purrr::map(x, ~ {", - " .x", - "})" + expect_lint( + trim_some(" + purrr::map(x, ~ { + .x + }) + "), + NULL, + linter ) - expect_lint(purrr_function_lines, NULL, linter) }) test_that("unnecessary_nesting_linter skips one-expression for loops", { linter <- unnecessary_nesting_linter() - for_lines <- c( - "for (i in 1:10) {", - " print(i)", - "}" + expect_lint( + trim_some(" + for (i in 1:10) { + print(i) + } + "), + NULL, + linter ) - expect_lint(for_lines, NULL, linter) # also for extended control flow functionality from packages - foreach_lines <- c( - "foreach (i = 1:10) %dopar% {", - " print(i)", - "}" + expect_lint( + trim_some(" + foreach (i = 1:10) %dopar% { + print(i) + } + "), + NULL, + linter ) - expect_lint(foreach_lines, NULL, linter) }) test_that("unnecessary_nesting_linter skips one-expression if and else clauses", { - lines <- c( - "if (TRUE) {", - " x", - "} else {", - " y", - "}" - ) - expect_lint(lines, NULL, unnecessary_nesting_linter()) + expect_lint( + trim_some(" + if (TRUE) { + x + } else { + y + } + "), + NULL, + unnecessary_nesting_linter() + ) }) test_that("unnecessary_nesting_linter skips one-expression while loops", { - lines <- c( - "while (x < 10) {", - " x <- x + 1", - "}" + expect_lint( + trim_some(" + while (x < 10) { + x <- x + 1 + } + "), + NULL, + unnecessary_nesting_linter() ) - expect_lint(lines, NULL, unnecessary_nesting_linter()) }) test_that("unnecessary_nesting_linter skips one-expression repeat loops", { - lines <- c( - "repeat {", - " x <- x + 1", - "}" + expect_lint( + trim_some(" + repeat { + x <- x + 1 + } + "), + NULL, + unnecessary_nesting_linter() ) - expect_lint(lines, NULL, unnecessary_nesting_linter()) }) test_that("unnecessary_nesting_linter skips one-expression assignments by default", { @@ -218,16 +247,19 @@ test_that("unnecessary_nesting_linter skips one-expression assignments by defaul }) test_that("unnecessary_nesting_linter passes for multi-line braced expressions", { - lines <- c( - "tryCatch(", - " {", - " foo(x)", - " bar(x)", - " },", - " error = identity", - ")" - ) - expect_lint(lines, NULL, unnecessary_nesting_linter()) + expect_lint( + trim_some(" + tryCatch( + { + foo(x) + bar(x) + }, + error = identity + ) + "), + NULL, + unnecessary_nesting_linter() + ) }) test_that("unnecessary_nesting_linter skips if unbracing won't reduce nesting", { @@ -345,3 +377,275 @@ test_that("lints vectorize", { unnecessary_nesting_linter() ) }) + +test_that("unnecessary_nesting_linter skips allowed usages", { + linter <- unnecessary_nesting_linter() + + expect_lint( + trim_some(" + if (x && y) { + 1L + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + for (x in 1:3) { + if (x && y) { + 1L + } + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x) { + 1L + } else if (y) { + 2L + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x) { + 1L + } else { + if (y) { + 2L + } + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (if (x) TRUE else FALSE) { + 1L + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x) { + y <- x + 1L + if (y) { + 1L + } + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if ((x && y) || (if (x) TRUE else FALSE)) { + 1L + } + "), + NULL, + linter + ) + + # if there is any additional code between the inner and outer scopes, no lint + expect_lint( + trim_some(" + if (x && a) { + y <- x + 1L + if (y || b) { + 1L + } + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x) { + if (y) { + 1L + } + y <- x + 1L + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x) { + y <- x + 1L + if (y) { + 1L + } + y <- x + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x) { + y <- x + 1L + { + if (y) { + 1L + } + } + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x) { + { + y <- x + 1L + if (y) { + 1L + } + } + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x) { + { + if (y) { + 1L + } + } + y <- x + 1L + } + "), + NULL, + linter + ) + + expect_lint( + trim_some(" + if (x) { + { + y <- x + 1L + { + if (y) { + 1L + } + } + } + } + "), + NULL, + linter + ) +}) + +test_that("unnecessary_nesting_linter blocks disallowed usages", { + lint_message <- rex::rex("Don't use nested `if` statements") + linter <- unnecessary_nesting_linter() + + expect_lint( + trim_some(" + if (x) { + if (y) { + 1L + } + } + "), + lint_message, + linter + ) + + expect_lint( + trim_some(" + if (x) { + if (y) 1L + } + "), + lint_message, + linter + ) + + expect_lint( + trim_some(" + if (x && a) { + if (y || b) { + 1L + } + } + "), + lint_message, + linter + ) + + expect_lint( + trim_some(" + if (if (x) TRUE else FALSE) { + if (y) { + 1L + } + } + "), + lint_message, + linter + ) + + expect_lint( + "if (x) if (y) 1L", + lint_message, + linter + ) + + expect_lint( + trim_some(" + for (x in 1:3) { + if (x) if (y) 1L + } + "), + lint_message, + linter + ) + + expect_lint( + trim_some(" + if (x) { + if (y) { + if (z) { + 1L + } + } + } + "), + list( + list(message = lint_message, line_number = 2L, column_number = 3L), + list(message = lint_message, line_number = 3L, column_number = 5L) + ), + linter + ) +}) From 72eeefd87596ea7fa72ee1a8b14bcb82d322c381 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 19 Dec 2023 09:46:20 +0800 Subject: [PATCH 2/7] use trim_some() consistently (#2461) Co-authored-by: AshesITR --- tests/testthat/test-commented_code_linter.R | 5 +- tests/testthat/test-expect_lint.R | 4 +- tests/testthat/test-library_call_linter.R | 63 +++++++++++++-------- tests/testthat/test-object_name_linter.R | 2 +- 4 files changed, 44 insertions(+), 30 deletions(-) diff --git a/tests/testthat/test-commented_code_linter.R b/tests/testthat/test-commented_code_linter.R index d7ff74651..fadc98d5e 100644 --- a/tests/testthat/test-commented_code_linter.R +++ b/tests/testthat/test-commented_code_linter.R @@ -3,9 +3,8 @@ test_that("commented_code_linter skips allowed usages", { expect_lint("blah", NULL, linter) expect_lint("#' blah <- 1", NULL, linter) - expect_lint(c("a <- 1", "# comment without code"), NULL, linter) - expect_lint(c("a <- 1", "# comment without code"), NULL, linter) - expect_lint(c("a <- 1", "## whatever"), NULL, linter) + expect_lint("a <- 1\n# comment without code", NULL, linter) + expect_lint("a <- 1\n## whatever", NULL, linter) expect_lint("TRUE", NULL, linter) expect_lint("#' @examples", NULL, linter) diff --git a/tests/testthat/test-expect_lint.R b/tests/testthat/test-expect_lint.R index d2152854e..622882884 100644 --- a/tests/testthat/test-expect_lint.R +++ b/tests/testthat/test-expect_lint.R @@ -42,8 +42,8 @@ test_that("multiple checks", { expect_success(expect_lint("a=1; b=2", list(c(message = lint_msg), c(message = lint_msg)), linter)) expect_success(expect_lint("a=1; b=2", list(c(line_number = 1L), c(linter = "assignment_linter")), linter)) expect_success(expect_lint("a=1; b=2", list(lint_msg, c(line = "a=1; b=2", type = "warning")), linter)) - expect_success(expect_lint(c("a=1", "b=2"), list(c(line_number = 1L), c(line_number = 2L)), linter)) - expect_failure(expect_lint(c("a=1", "b=2"), list(c(line_number = 2L), c(line_number = 2L)), linter)) + expect_success(expect_lint("a=1\nb=2", list(c(line_number = 1L), c(line_number = 2L)), linter)) + expect_failure(expect_lint("a=1\nb=2", list(c(line_number = 2L), c(line_number = 2L)), linter)) expect_success(expect_lint("a=1; b=2", list(list(line_number = 1L), list(line_number = 2L)), linter)) expect_failure(expect_lint("a=1; b=2", list(list(line_number = 2L), list(line_number = 2L)), linter)) diff --git a/tests/testthat/test-library_call_linter.R b/tests/testthat/test-library_call_linter.R index 69b68ec9f..e7d118906 100644 --- a/tests/testthat/test-library_call_linter.R +++ b/tests/testthat/test-library_call_linter.R @@ -331,20 +331,26 @@ patrick::with_parameters_test_that( expect_lint(sprintf("%1$s(x); y; %1$s(z)", call), NULL, linter) # inline or potentially with gaps don't matter - lines <- c( - sprintf("%s(x)", call), - "y", - "", - "stopifnot(z)" + expect_lint( + trim_some(glue::glue(" + {call}(x) + y + + stopifnot(z) + ")), + NULL, + linter ) - expect_lint(lines, NULL, linter) # only suppressing calls with library() - lines_consecutive <- c( - sprintf("%s(x)", call), - sprintf("%s(y)", call) + expect_lint( + trim_some(glue::glue(" + {call}(x) + {call}(y) + ")), + NULL, + linter ) - expect_lint(lines_consecutive, NULL, linter) }, .test_name = c("suppressMessages", "suppressPackageStartupMessages"), call = c("suppressMessages", "suppressPackageStartupMessages") @@ -359,25 +365,34 @@ patrick::with_parameters_test_that( # one test of inline usage expect_lint(sprintf("%1$s(library(x)); %1$s(library(y))", call), message, linter) - lines_gap <- c( - sprintf("%s(library(x))", call), - "", - sprintf("%s(library(y))", call) + expect_lint( + trim_some(glue::glue(" + {call}(library(x)) + + {call}(library(y)) + ")), + message, + linter ) - expect_lint(lines_gap, message, linter) - lines_consecutive <- c( - sprintf("%s(require(x))", call), - sprintf("%s(require(y))", call) + expect_lint( + trim_some(glue::glue(" + {call}(require(x)) + {call}(require(y)) + ")), + message, + linter ) - expect_lint(lines_consecutive, message, linter) - lines_comment <- c( - sprintf("%s(library(x))", call), - "# a comment on y", - sprintf("%s(library(y))", call) + expect_lint( + trim_some(glue::glue(" + {call}(library(x)) + # a comment on y + {call}(library(y)) + ")), + message, + linter ) - expect_lint(lines_comment, message, linter) }, .test_name = c("suppressMessages", "suppressPackageStartupMessages"), call = c("suppressMessages", "suppressPackageStartupMessages") diff --git a/tests/testthat/test-object_name_linter.R b/tests/testthat/test-object_name_linter.R index 7a0154561..97f0022ca 100644 --- a/tests/testthat/test-object_name_linter.R +++ b/tests/testthat/test-object_name_linter.R @@ -96,7 +96,7 @@ test_that("linter accepts vector of styles", { linter <- object_name_linter(styles = c("camelCase", "dotted.case")) expect_lint( - c("var.one <- 1", "varTwo <- 2", "var_three <- 3"), + "var.one <- 1\nvarTwo <- 2\nvar_three <- 3", list(message = lint_msg, line_number = 3L, column_number = 1L), linter ) From f00f4a9a715346a3e696aab9cffff2756833e50a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 19 Dec 2023 14:47:44 +0800 Subject: [PATCH 3/7] Catch 'else { if' where 'else if' is preferable in unnecessary_nesting_linter() (#2462) * initial deprecation * document * delint * fix inconsistency in trim_some() * Always use trim_some() * catch else { if where else if is preferable * delint --- NEWS.md | 2 +- R/shared_constants.R | 13 ++-- R/unnecessary_nesting_linter.R | 15 ++++- .../test-unnecessary_nesting_linter.R | 66 ++++++++++++++++++- 4 files changed, 85 insertions(+), 11 deletions(-) diff --git a/NEWS.md b/NEWS.md index c2230b008..e715ece4f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -60,7 +60,7 @@ * `which_grepl_linter()` for discouraging `which(grepl(ptn, x))` in favor of directly using `grep(ptn, x)` (part of #884, @MichaelChirico). * `list_comparison_linter()` for discouraging comparisons on the output of `lapply()`, e.g. `lapply(x, sum) > 10` (part of #884, @MichaelChirico). * `print_linter()` for discouraging usage of `print()` on string literals like `print("Reached here")` or `print(paste("Found", nrow(DF), "rows."))` (#1894, @MichaelChirico). -* `unnecessary_nesting_linter()` for discouraging overly-nested code where an early return or eliminated sub-expression (inside '{') is preferable (part of #884, @MichaelChirico). +* `unnecessary_nesting_linter()` for discouraging overly-nested code where an early return or eliminated sub-expression (inside '{') is preferable (#2317 and part of #884, @MichaelChirico). * `consecutive_mutate_linter()` for encouraging consecutive calls to `dplyr::mutate()` to be combined (part of #884, @MichaelChirico). * `if_switch_linter()` for encouraging `switch()` over repeated `if`/`else` tests (part of #884, @MichaelChirico). * `nested_pipe_linter()` for discouraging pipes within pipes, e.g. `df1 %>% inner_join(df2 %>% select(a, b))` (part of #884, @MichaelChirico). diff --git a/R/shared_constants.R b/R/shared_constants.R index d581c7e35..ef4eccb50 100644 --- a/R/shared_constants.R +++ b/R/shared_constants.R @@ -34,6 +34,7 @@ rx_static_token <- local({ rx_unescaped_regex <- paste0("(?s)", rex(start, zero_or_more(rx_non_active_char), end)) rx_static_regex <- paste0("(?s)", rex(start, zero_or_more(rx_static_token), end)) rx_first_static_token <- paste0("(?s)", rex(start, zero_or_more(rx_non_active_char), rx_static_escape)) +rx_escapable_tokens <- "^${}().*+?|[]\\<>=:;/_-!@#%&,~" #' Determine whether a regex pattern actually uses regex patterns #' @@ -95,19 +96,17 @@ get_fixed_string <- function(static_regex) { #' #' @noRd get_token_replacement <- function(token_content, token_type) { - if (token_type == "trivial_char_group") { + if (token_type == "trivial_char_group") { # otherwise, char_escape token_content <- substr(token_content, start = 2L, stop = nchar(token_content) - 1L) if (startsWith(token_content, "\\")) { # escape within trivial char group get_token_replacement(token_content, "char_escape") } else { token_content } - } else { # char_escape token - if (re_matches(token_content, rex("\\", one_of("^${}().*+?|[]\\<>=:;/_-!@#%&,~")))) { - substr(token_content, start = 2L, stop = nchar(token_content)) - } else { - eval(parse(text = paste0('"', token_content, '"'))) - } + } else if (re_matches(token_content, rex("\\", one_of(rx_escapable_tokens)))) { + substr(token_content, start = 2L, stop = nchar(token_content)) + } else { + eval(parse(text = paste0('"', token_content, '"'))) } } diff --git a/R/unnecessary_nesting_linter.R b/R/unnecessary_nesting_linter.R index 7d20084c6..f2e034f9d 100644 --- a/R/unnecessary_nesting_linter.R +++ b/R/unnecessary_nesting_linter.R @@ -170,6 +170,8 @@ unnecessary_nesting_linter <- function(allow_assignment = TRUE) { collapse = " | " ) + unnecessary_else_brace_xpath <- "//IF/parent::expr[parent::expr[preceding-sibling::ELSE and count(expr) = 1]]" + Linter(linter_level = "expression", function(source_expression) { xml <- source_expression$xml_parsed_content @@ -201,9 +203,18 @@ unnecessary_nesting_linter <- function(allow_assignment = TRUE) { lint_message = paste( "Don't use nested `if` statements, where a single `if` with the combined conditional expression will do.", "For example, instead of `if (x) { if (y) { ... }}`, use `if (x && y) { ... }`." - ) + ), + type = "warning" + ) + + unnecessary_else_brace_expr <- xml_find_all(xml, unnecessary_else_brace_xpath) + 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.", + type = "warning" ) - c(if_else_exit_lints, unnecessary_brace_lints, unnecessary_nested_if_lints) + c(if_else_exit_lints, unnecessary_brace_lints, unnecessary_nested_if_lints, unnecessary_else_brace_lints) }) } diff --git a/tests/testthat/test-unnecessary_nesting_linter.R b/tests/testthat/test-unnecessary_nesting_linter.R index 41ad17165..72ec96000 100644 --- a/tests/testthat/test-unnecessary_nesting_linter.R +++ b/tests/testthat/test-unnecessary_nesting_linter.R @@ -81,6 +81,7 @@ test_that("parallels in further nesting are skipped", { if (length(bucket) > 1) { return(age) } else { + age <- age / 2 if (grepl('[0-9]', age)) { return(age) } else { @@ -420,8 +421,9 @@ test_that("unnecessary_nesting_linter skips allowed usages", { if (x) { 1L } else { + 2L if (y) { - 2L + 3L } } "), @@ -649,3 +651,65 @@ test_that("unnecessary_nesting_linter blocks disallowed usages", { linter ) }) + +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.") + + expect_lint( + trim_some(" + if (A) { + 1 + } else { + if (B) { + 2 + } else { + 3 + } + } + "), + list(lint_msg, line_number = 4L), + linter + ) + + expect_lint( + trim_some(" + if (A) { + 1 + } else if (B) { + 2 + } else { + if (C) { + 3 + } else { + 4 + } + } + "), + list(lint_msg, line_number = 6L), + linter + ) + + expect_lint( + trim_some(" + if (A) { + 1 + } else { + if (B) { + 2 + } else { + if (C) { + 3 + } else { + 4 + } + } + } + "), + list( + list(lint_msg, line_number = 4L), + list(lint_msg, line_number = 7L) + ), + linter + ) +}) From 7cb5023e12064c659fd47d23ef045e606abe63f6 Mon Sep 17 00:00:00 2001 From: Indrajeet Patil Date: Wed, 20 Dec 2023 22:32:35 +0100 Subject: [PATCH 4/7] Remove reference to deprecated function from examples (#2498) --- R/unnecessary_nesting_linter.R | 6 +++--- man/unnecessary_nesting_linter.Rd | 6 +++--- 2 files changed, 6 insertions(+), 6 deletions(-) diff --git a/R/unnecessary_nesting_linter.R b/R/unnecessary_nesting_linter.R index f2e034f9d..54df45d04 100644 --- a/R/unnecessary_nesting_linter.R +++ b/R/unnecessary_nesting_linter.R @@ -36,7 +36,7 @@ #' writeLines("if (x) { \n if (y) { \n return(1L) \n } \n}") #' lint( #' text = "if (x) { \n if (y) { \n return(1L) \n } \n}", -#' linters = unnecessary_nested_if_linter() +#' linters = unnecessary_nesting_linter() #' ) #' #' # okay @@ -64,13 +64,13 @@ #' writeLines("if (x && y) { \n return(1L) \n}") #' lint( #' text = "if (x && y) { \n return(1L) \n}", -#' linters = unnecessary_nested_if_linter() +#' linters = unnecessary_nesting_linter() #' ) #' #' writeLines("if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}") #' lint( #' text = "if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}", -#' linters = unnecessary_nested_if_linter() +#' linters = unnecessary_nesting_linter() #' ) #' #' @evalRd rd_tags("unnecessary_nesting_linter") diff --git a/man/unnecessary_nesting_linter.Rd b/man/unnecessary_nesting_linter.Rd index f4ce0853d..6119e3e13 100644 --- a/man/unnecessary_nesting_linter.Rd +++ b/man/unnecessary_nesting_linter.Rd @@ -44,7 +44,7 @@ lint( writeLines("if (x) { \n if (y) { \n return(1L) \n } \n}") lint( text = "if (x) { \n if (y) { \n return(1L) \n } \n}", - linters = unnecessary_nested_if_linter() + linters = unnecessary_nesting_linter() ) # okay @@ -72,13 +72,13 @@ lint( writeLines("if (x && y) { \n return(1L) \n}") lint( text = "if (x && y) { \n return(1L) \n}", - linters = unnecessary_nested_if_linter() + linters = unnecessary_nesting_linter() ) writeLines("if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}") lint( text = "if (x) { \n y <- x + 1L\n if (y) { \n return(1L) \n } \n}", - linters = unnecessary_nested_if_linter() + linters = unnecessary_nesting_linter() ) } From ccdb186ae7ef2cab7e900433efa6d0718ed3899e Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 21 Dec 2023 07:47:21 +0800 Subject: [PATCH 5/7] also lint nrow(filter(.)) (#2457) Co-authored-by: AshesITR --- NEWS.md | 2 +- R/nrow_subset_linter.R | 12 +++++++++++- man/nrow_subset_linter.Rd | 10 ++++++++++ tests/testthat/test-nrow_subset_linter.R | 14 ++++++++++++-- 4 files changed, 34 insertions(+), 4 deletions(-) diff --git a/NEWS.md b/NEWS.md index e715ece4f..c7bb1d938 100644 --- a/NEWS.md +++ b/NEWS.md @@ -64,7 +64,7 @@ * `consecutive_mutate_linter()` for encouraging consecutive calls to `dplyr::mutate()` to be combined (part of #884, @MichaelChirico). * `if_switch_linter()` for encouraging `switch()` over repeated `if`/`else` tests (part of #884, @MichaelChirico). * `nested_pipe_linter()` for discouraging pipes within pipes, e.g. `df1 %>% inner_join(df2 %>% select(a, b))` (part of #884, @MichaelChirico). -* `nrow_subset_linter()` for discouraging usage like `nrow(subset(x, conditions))` in favor of something like `with(x, sum(conditions))` which doesn't require a full subset of `x` (#2314 and part of #884, @MichaelChirico). +* `nrow_subset_linter()` for discouraging usage like `nrow(subset(x, conditions))` in favor of something like `with(x, sum(conditions))` which doesn't require a full subset of `x` (#2313, #2314 and part of #884, @MichaelChirico). * `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). diff --git a/R/nrow_subset_linter.R b/R/nrow_subset_linter.R index f34246229..57ad645e1 100644 --- a/R/nrow_subset_linter.R +++ b/R/nrow_subset_linter.R @@ -14,6 +14,16 @@ #' linters = nrow_subset_linter() #' ) #' +#' lint( +#' text = "nrow(filter(x, is_treatment))", +#' linters = nrow_subset_linter() +#' ) +#' +#' lint( +#' text = "x %>% filter(x, is_treatment) %>% nrow()", +#' linters = nrow_subset_linter() +#' ) +#' #' # okay #' lint( #' text = "with(x, sum(is_treatment, na.rm = TRUE))", @@ -25,7 +35,7 @@ #' @include shared_constants.R #' @export nrow_subset_linter <- make_linter_from_function_xpath( - function_names = "subset", + function_names = c("subset", "filter"), xpath = glue(" parent::expr /parent::expr diff --git a/man/nrow_subset_linter.Rd b/man/nrow_subset_linter.Rd index 3e2edcb2a..a32627b79 100644 --- a/man/nrow_subset_linter.Rd +++ b/man/nrow_subset_linter.Rd @@ -21,6 +21,16 @@ lint( linters = nrow_subset_linter() ) +lint( + text = "nrow(filter(x, is_treatment))", + linters = nrow_subset_linter() +) + +lint( + text = "x \%>\% filter(x, is_treatment) \%>\% nrow()", + linters = nrow_subset_linter() +) + # okay lint( text = "with(x, sum(is_treatment, na.rm = TRUE))", diff --git a/tests/testthat/test-nrow_subset_linter.R b/tests/testthat/test-nrow_subset_linter.R index 2594f00ef..8f1d49f24 100644 --- a/tests/testthat/test-nrow_subset_linter.R +++ b/tests/testthat/test-nrow_subset_linter.R @@ -13,6 +13,14 @@ test_that("nrow_subset_linter blocks subset() cases", { ) }) +test_that("nrow_subset_linter blocks filter() cases", { + expect_lint( + "nrow(filter(x, y == z))", + rex::rex("Use arithmetic to count the number of rows satisfying a condition"), + nrow_subset_linter() + ) +}) + test_that("lints vectorize", { lint_msg <- rex::rex("Use arithmetic to count the number of rows satisfying a condition") @@ -21,10 +29,12 @@ test_that("lints vectorize", { nrow(subset(x, y == z)) subset(x) %>% transform(m = 2) nrow(subset(a, b == c)) + x %>% filter(y == z) %>% nrow() }"), list( list(lint_msg, line_number = 2L), - list(lint_msg, line_number = 4L) + list(lint_msg, line_number = 4L), + list(lint_msg, line_number = 5L) ), nrow_subset_linter() ) @@ -35,7 +45,7 @@ test_that("linter is pipeline-aware", { lint_msg <- "Use arithmetic to count the number of rows satisfying a condition" expect_lint("x %>% subset(y == z) %>% nrow()", lint_msg, linter) - expect_lint("subset(x) %>% nrow()", lint_msg, linter) + expect_lint("filter(x, y == z) %>% nrow()", lint_msg, linter) skip_if_not_r_version("4.1.0") expect_lint("x |> subset(y == z) |> nrow()", lint_msg, linter) From 34e1df1a8b4e66ae7645981f3728de29b59cab52 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 21 Dec 2023 15:19:28 +0800 Subject: [PATCH 6/7] Remove check-link-rot action (#2500) --- .github/workflows/check-link-rot.yaml | 41 --------------------------- 1 file changed, 41 deletions(-) delete mode 100644 .github/workflows/check-link-rot.yaml diff --git a/.github/workflows/check-link-rot.yaml b/.github/workflows/check-link-rot.yaml deleted file mode 100644 index e83026690..000000000 --- a/.github/workflows/check-link-rot.yaml +++ /dev/null @@ -1,41 +0,0 @@ -on: - push: - branches: [main, master] - pull_request: - branches: [main, master] - -name: check-link-rot - -jobs: - check-link-rot: - runs-on: ubuntu-latest - env: - GITHUB_PAT: ${{ secrets.GITHUB_TOKEN }} - R_KEEP_PKG_SOURCE: yes - steps: - - uses: actions/checkout@v4 - - - uses: r-lib/actions/setup-pandoc@v2 - - - uses: r-lib/actions/setup-r@v2 - with: - r-version: "devel" - http-user-agent: "release" - use-public-rspm: true - - - uses: r-lib/actions/setup-r-dependencies@v2 - with: - pak-version: devel - extra-packages: | - any::rcmdcheck - any::urlchecker - - - name: Run URL checker - run: | - options(crayon.enabled = TRUE) - rotten_links <- urlchecker::url_check(progress = FALSE) - print(rotten_links) - if (length(rotten_links$URL) > 0L) { - stop("Some URLs are outdated and need to be updated.", call. = FALSE) - } - shell: Rscript {0} From 17c27e1a1d0dca6d2408026b5765f193b9ea672a Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 21 Dec 2023 15:36:49 +0800 Subject: [PATCH 7/7] Remove obsolete loop (#2505) Co-authored-by: Indrajeet Patil --- R/get_source_expressions.R | 11 ----------- 1 file changed, 11 deletions(-) diff --git a/R/get_source_expressions.R b/R/get_source_expressions.R index 2d934ea2d..3bdba9030 100644 --- a/R/get_source_expressions.R +++ b/R/get_source_expressions.R @@ -640,18 +640,7 @@ fix_eq_assigns <- function(pc) { for (i in seq_len(n_expr)) { start_loc <- true_locs[i] - - # TODO(michaelchirico): vectorize this loop away. the tricky part is, - # this loop doesn't execute on most R versions (we tried 3.6.3 and 4.2.0). - # so it likely requires some GHA print debugging -- tedious :) end_loc <- true_locs[i] - j <- end_loc + 1L - # nocov start: only runs on certain R versions - while (j <= length(expr_locs) && !expr_locs[j]) { - end_loc <- j - j <- j + 1L - } - # nocov end prev_loc <- prev_locs[start_loc] next_loc <- next_locs[end_loc]