From c4fd90366741a6e2c02021ae8bc0dc9f0dc2b847 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 16 Nov 2023 23:31:28 +0000 Subject: [PATCH 1/9] New one_call_pipe_linter --- DESCRIPTION | 1 + NAMESPACE | 1 + R/one_call_pipe_linter.R | 63 ++++++++++++++ inst/lintr/linters.csv | 1 + man/linters.Rd | 5 +- man/one_call_pipe_linter.Rd | 27 ++++++ man/readability_linters.Rd | 1 + man/style_linters.Rd | 1 + tests/testthat/test-one_call_pipe_linter.R | 97 ++++++++++++++++++++++ 9 files changed, 195 insertions(+), 2 deletions(-) create mode 100644 R/one_call_pipe_linter.R create mode 100644 man/one_call_pipe_linter.Rd create mode 100644 tests/testthat/test-one_call_pipe_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 31871bd90..a8cc2e627 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -142,6 +142,7 @@ Collate: 'object_length_linter.R' 'object_name_linter.R' 'object_usage_linter.R' + 'one_call_pipe_linter.R' 'outer_negation_linter.R' 'package_hooks_linter.R' 'paren_body_linter.R' diff --git a/NAMESPACE b/NAMESPACE index a6c17992e..19c313a78 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -104,6 +104,7 @@ export(numeric_leading_zero_linter) export(object_length_linter) export(object_name_linter) export(object_usage_linter) +export(one_call_pipe_linter) export(open_curly_linter) export(outer_negation_linter) export(package_hooks_linter) diff --git a/R/one_call_pipe_linter.R b/R/one_call_pipe_linter.R new file mode 100644 index 000000000..60d339b6f --- /dev/null +++ b/R/one_call_pipe_linter.R @@ -0,0 +1,63 @@ +#' Block single-call magrittr pipes +#' +#' Prefer using a plain call instead of a pipe with only one call, +#' i.e. `1:10 %>% sum()` should instead be `sum(1:10)`. Note that +#' calls in the first `%>%` argument count. `rowSums(x) %>% max()` is OK +#' because there are two total calls (`rowSums()` and `max()`). +#' +#' Note also that un-"called" steps are *not* counted, since they should +#' be calls (see [pipe_call_linter()]). +#' +#' @evalRd rd_tags("one_call_pipe_linter") +#' @seealso +#' - [linters] for a complete list of linters available in lintr. +#' - +#' @export +one_call_pipe_linter <- function() { + pipes_cond <- xp_text_in_table(c("%>%", "%$%", "%T>%")) + + # preceding-sibling::SPECIAL: if there are ever two pipes, don't lint + # OP-LEFT-BRACKET/LBB: accept DT[...] %>% .[...] as a two-call pipe, + # (but not DT %>% .[...]) + # parent::expr/SPECIAL: make sure we are at the top of a pipeline + # count(): any call anywhere else in the AST within the pipe expression + # TODO(michaelchirico): Add support for native pipe |> like DT |> _[...] + xpath <- glue(" + //SPECIAL[ + ({ pipes_cond }) + and not(preceding-sibling::expr[1]/SPECIAL[{ xp_text_in_table(magrittr_pipes) }]) + and ( + not(following-sibling::expr[OP-LEFT-BRACKET or LBB]) + or not(preceding-sibling::expr[OP-LEFT-BRACKET or LBB]) + ) + ] + /parent::expr[ + not(parent::expr/SPECIAL[{ pipes_cond }]) + and count(.//SYMBOL_FUNCTION_CALL) <= 1 + ] + | + //PIPE[not(preceding-sibling::expr[1]/PIPE)] + /parent::expr[ + not(parent::expr/PIPE) + and count(.//SYMBOL_FUNCTION_CALL) <= 1 + ] + ") + + Linter(function(source_expression) { + if (!is_lint_level(source_expression, "expression")) { + return(list()) + } + + xml <- source_expression$xml_parsed_content + + bad_expr <- xml_find_all(xml, xpath) + pipe <- xml_find_chr(bad_expr, "string(SPECIAL | PIPE)") + + xml_nodes_to_lints( + bad_expr, + source_expression = source_expression, + lint_message = paste0("Expressions with only a single call shouldn't use pipe ", pipe, "."), + type = "warning" + ) + }) +} diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index c6ca4ca94..2b7d7ce1e 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -61,6 +61,7 @@ numeric_leading_zero_linter,style consistency readability object_length_linter,style readability default configurable executing object_name_linter,style consistency default configurable executing object_usage_linter,style readability correctness default executing configurable +one_call_pipe_linter,style readability open_curly_linter,style readability deprecated configurable outer_negation_linter,readability efficiency best_practices package_hooks_linter,style correctness package_development diff --git a/man/linters.Rd b/man/linters.Rd index ef71af792..5069874ca 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -28,9 +28,9 @@ The following tags exist: \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} \item{\link[=pkg_testthat_linters]{pkg_testthat} (12 linters)} -\item{\link[=readability_linters]{readability} (57 linters)} +\item{\link[=readability_linters]{readability} (58 linters)} \item{\link[=robustness_linters]{robustness} (16 linters)} -\item{\link[=style_linters]{style} (38 linters)} +\item{\link[=style_linters]{style} (39 linters)} } } \section{Linters}{ @@ -95,6 +95,7 @@ The following linters exist: \item{\code{\link{object_length_linter}} (tags: configurable, default, executing, readability, style)} \item{\code{\link{object_name_linter}} (tags: configurable, consistency, default, executing, style)} \item{\code{\link{object_usage_linter}} (tags: configurable, correctness, default, executing, readability, style)} +\item{\code{\link{one_call_pipe_linter}} (tags: readability, style)} \item{\code{\link{outer_negation_linter}} (tags: best_practices, efficiency, readability)} \item{\code{\link{package_hooks_linter}} (tags: correctness, package_development, style)} \item{\code{\link{paren_body_linter}} (tags: default, readability, style)} diff --git a/man/one_call_pipe_linter.Rd b/man/one_call_pipe_linter.Rd new file mode 100644 index 000000000..c4aed5c2e --- /dev/null +++ b/man/one_call_pipe_linter.Rd @@ -0,0 +1,27 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/one_call_pipe_linter.R +\name{one_call_pipe_linter} +\alias{one_call_pipe_linter} +\title{Block single-call magrittr pipes} +\usage{ +one_call_pipe_linter() +} +\description{ +Prefer using a plain call instead of a pipe with only one call, +i.e. \code{1:10 \%>\% sum()} should instead be \code{sum(1:10)}. Note that +calls in the first \verb{\%>\%} argument count. \code{rowSums(x) \%>\% max()} is OK +because there are two total calls (\code{rowSums()} and \code{max()}). +} +\details{ +Note also that un-"called" steps are \emph{not} counted, since they should +be calls (see \code{\link[=pipe_call_linter]{pipe_call_linter()}}). +} +\seealso{ +\itemize{ +\item \link{linters} for a complete list of linters available in lintr. +\item \url{https://style.tidyverse.org/pipes.html#short-pipes} +} +} +\section{Tags}{ +\link[=readability_linters]{readability}, \link[=style_linters]{style} +} diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index 06deb9233..6048142f5 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -45,6 +45,7 @@ The following linters are tagged with 'readability': \item{\code{\link{numeric_leading_zero_linter}}} \item{\code{\link{object_length_linter}}} \item{\code{\link{object_usage_linter}}} +\item{\code{\link{one_call_pipe_linter}}} \item{\code{\link{outer_negation_linter}}} \item{\code{\link{paren_body_linter}}} \item{\code{\link{pipe_call_linter}}} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index 37928ffa7..47c78fc2c 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -32,6 +32,7 @@ The following linters are tagged with 'style': \item{\code{\link{object_length_linter}}} \item{\code{\link{object_name_linter}}} \item{\code{\link{object_usage_linter}}} +\item{\code{\link{one_call_pipe_linter}}} \item{\code{\link{package_hooks_linter}}} \item{\code{\link{paren_body_linter}}} \item{\code{\link{pipe_call_linter}}} diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R new file mode 100644 index 000000000..0a8ed9b74 --- /dev/null +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -0,0 +1,97 @@ +test_that("one_call_pipe_linter skips allowed usages", { + linter <- one_call_pipe_linter() + + # two pipe steps is OK + expect_lint("x %>% foo() %>% bar()", NULL, linter) + # call in first step --> OK + expect_lint("foo(x) %>% bar()", NULL, linter) + # both calls in second step --> OK + expect_lint("x %>% foo(bar(.))", NULL, linter) +}) + +test_that("one_call_pipe_linter blocks simple disallowed usages", { + linter <- one_call_pipe_linter() + lint_msg <- rex::rex("Expressions with only a single call shouldn't use pipe %>%.") + + expect_lint("x %>% foo()", lint_msg, linter) + + # new lines don't matter + expect_lint("x %>%\n foo()", lint_msg, linter) + + # catch the "inner" pipe chain, not the "outer" one + # TODO(michaelchirico): actually, this should lint twice -- we're too aggressive + # in counting _all_ nested calls. + expect_lint("x %>% inner_join(y %>% filter(is_treatment))", lint_msg, linter) +}) + +test_that("one_call_pipe_linter skips data.table chains", { + linter <- one_call_pipe_linter() + lint_msg <- rex::rex("Expressions with only a single call shouldn't use pipe %>%.") + + expect_lint("DT[x > 5, sum(y), by = keys] %>% .[, .SD[1], by = key1]", NULL, linter) + + # lint here: instead of a pipe, use DT[x > 5, sum(y), by = keys] + expect_lint("DT %>% .[x > 5, sum(y), by = keys]", lint_msg, linter) + + # ditto for [[ + expect_lint("DT %>% rowSums() %>% .[[idx]]", NULL, linter) + + expect_lint("DT %>% .[[idx]]", lint_msg, linter) +}) + +test_that("one_call_pipe_linter treats all pipes equally", { + linter <- one_call_pipe_linter() + + expect_lint("foo %>% bar() %$% col", NULL, linter) + expect_lint( + "x %T>% foo()", + rex::rex("Expressions with only a single call shouldn't use pipe %T>%."), + linter + ) + expect_lint( + "x %$%\n foo()", + rex::rex("Expressions with only a single call shouldn't use pipe %$%."), + linter + ) + expect_lint( + 'data %>% filter(type == "console") %$% obscured_gaia_id %>% unique()', + NULL, + linter + ) +}) + +test_that("multiple lints are generated correctly", { + expect_lint( + trim_some("{ + a %>% b() + c %$% d() + e %T>% f() + }"), + list( + list(message = "pipe %>%"), + list(message = "pipe %\\$%"), + list(message = "pipe %T>%") + ), + one_call_pipe_linter() + ) +}) + +test_that("Native pipes are handled as well", { + expect_lint( + "x |> foo()", + rex::rex("Expressions with only a single call shouldn't use pipe |>."), + one_call_pipe_linter() + ) + + expect_lint( + trim_some("{ + a %>% b() + c |> d() + }"), + list( + list(message = "pipe %>%"), + list(message = "pipe |>") + ), + one_call_pipe_linter() + ) +}) From 6c5380b3454e0c67d00eb999667c11ef351c7857 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 17 Nov 2023 00:26:17 +0000 Subject: [PATCH 2/9] examples --- R/one_call_pipe_linter.R | 23 +++++++++++++++++++++++ man/one_call_pipe_linter.Rd | 24 ++++++++++++++++++++++++ 2 files changed, 47 insertions(+) diff --git a/R/one_call_pipe_linter.R b/R/one_call_pipe_linter.R index 60d339b6f..79137ee41 100644 --- a/R/one_call_pipe_linter.R +++ b/R/one_call_pipe_linter.R @@ -8,6 +8,29 @@ #' Note also that un-"called" steps are *not* counted, since they should #' be calls (see [pipe_call_linter()]). #' +#' @examples +#' # will produce lints +#' lint( +#' text = "(1:10) %>% sum()", +#' linters = one_call_pipe_linter() +#' ) +#' +#' lint( +#' text = "DT %>% .[grp == 'a', sum(v)]", +#' linters = one_call_pipe_linter() +#' ) +#' +#' # okay +#' lint( +#' text = "rowSums(x) %>% mean()", +#' linters = one_call_pipe_linter() +#' ) +#' +#' lint( +#' text = "DT[src == 'a', .N, by = grp] %>% .[N > 10]", +#' linters = one_call_pipe_linter() +#' ) +#' #' @evalRd rd_tags("one_call_pipe_linter") #' @seealso #' - [linters] for a complete list of linters available in lintr. diff --git a/man/one_call_pipe_linter.Rd b/man/one_call_pipe_linter.Rd index c4aed5c2e..a20c19efd 100644 --- a/man/one_call_pipe_linter.Rd +++ b/man/one_call_pipe_linter.Rd @@ -15,6 +15,30 @@ because there are two total calls (\code{rowSums()} and \code{max()}). \details{ Note also that un-"called" steps are \emph{not} counted, since they should be calls (see \code{\link[=pipe_call_linter]{pipe_call_linter()}}). +} +\examples{ +# will produce lints +lint( + text = "(1:10) \%>\% sum()", + linters = one_call_pipe_linter() +) + +lint( + text = "DT \%>\% .[grp == 'a', sum(v)]", + linters = one_call_pipe_linter() +) + +# okay +lint( + text = "rowSums(x) \%>\% mean()", + linters = one_call_pipe_linter() +) + +lint( + text = "DT[src == 'a', .N, by = grp] \%>\% .[N > 10]", + linters = one_call_pipe_linter() +) + } \seealso{ \itemize{ From fc84ca876b7ad476a7a5a67002bd1c3a4f9c73a8 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Thu, 16 Nov 2023 20:57:26 -0800 Subject: [PATCH 3/9] Skip native pipe tests on old R --- tests/testthat/test-one_call_pipe_linter.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index 0a8ed9b74..d58687b92 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -77,6 +77,7 @@ test_that("multiple lints are generated correctly", { }) test_that("Native pipes are handled as well", { + skip_if_not_r_version("4.1.0") expect_lint( "x |> foo()", rex::rex("Expressions with only a single call shouldn't use pipe |>."), From 619627b814346047b3cfb3ac4452bf0676b13869 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 17 Nov 2023 08:14:26 -0800 Subject: [PATCH 4/9] confirm logic works with native placeholder, simplify, add tests --- R/one_call_pipe_linter.R | 14 +++-------- tests/testthat/test-one_call_pipe_linter.R | 28 ++++++++++++++++++++-- 2 files changed, 29 insertions(+), 13 deletions(-) diff --git a/R/one_call_pipe_linter.R b/R/one_call_pipe_linter.R index 79137ee41..9bd319bce 100644 --- a/R/one_call_pipe_linter.R +++ b/R/one_call_pipe_linter.R @@ -44,24 +44,16 @@ one_call_pipe_linter <- function() { # (but not DT %>% .[...]) # parent::expr/SPECIAL: make sure we are at the top of a pipeline # count(): any call anywhere else in the AST within the pipe expression - # TODO(michaelchirico): Add support for native pipe |> like DT |> _[...] xpath <- glue(" - //SPECIAL[ - ({ pipes_cond }) - and not(preceding-sibling::expr[1]/SPECIAL[{ xp_text_in_table(magrittr_pipes) }]) + (//SPECIAL[{pipes_cond}] | //PIPE)[ + not(preceding-sibling::expr[1]/*[self::SPECIAL[{pipes_cond}] or self::PIPE]) and ( not(following-sibling::expr[OP-LEFT-BRACKET or LBB]) or not(preceding-sibling::expr[OP-LEFT-BRACKET or LBB]) ) ] /parent::expr[ - not(parent::expr/SPECIAL[{ pipes_cond }]) - and count(.//SYMBOL_FUNCTION_CALL) <= 1 - ] - | - //PIPE[not(preceding-sibling::expr[1]/PIPE)] - /parent::expr[ - not(parent::expr/PIPE) + not(parent::expr/*[self::SPECIAL[{ pipes_cond }] or self::PIPE]) and count(.//SYMBOL_FUNCTION_CALL) <= 1 ] ") diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index d58687b92..8767f49d1 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -78,12 +78,19 @@ test_that("multiple lints are generated correctly", { test_that("Native pipes are handled as well", { skip_if_not_r_version("4.1.0") + + linter <- one_call_pipe_linter() + expect_lint( "x |> foo()", rex::rex("Expressions with only a single call shouldn't use pipe |>."), - one_call_pipe_linter() + linter ) + # mixed pipes + expect_lint("x |> foo() %>% bar()", NULL, linter) + expect_lint("x %>% foo() |> bar()", NULL, linter) + expect_lint( trim_some("{ a %>% b() @@ -93,6 +100,23 @@ test_that("Native pipes are handled as well", { list(message = "pipe %>%"), list(message = "pipe |>") ), - one_call_pipe_linter() + linter ) }) + +test_that("one_call_pipe_linter skips data.table chains with native pipe", { + skip_if_not_r_version("4.3.0") + + linter <- one_call_pipe_linter() + lint_msg <- rex::rex("Expressions with only a single call shouldn't use pipe |>.") + + expect_lint("DT[x > 5, sum(y), by = keys] |> _[, .SD[1], by = key1]", NULL, linter) + + # lint here: instead of a pipe, use DT[x > 5, sum(y), by = keys] + expect_lint("DT |> _[x > 5, sum(y), by = keys]", lint_msg, linter) + + # ditto for [[ + expect_lint("DT |> rowSums() |> _[[idx]]", NULL, linter) + + expect_lint("DT |> _[[idx]]", lint_msg, linter) +}) From aaa342e36af707f284117f7b6359ee3be61d6f41 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 18 Nov 2023 12:10:26 -0800 Subject: [PATCH 5/9] test metadata --- tests/testthat/test-one_call_pipe_linter.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index 8767f49d1..7d1e58c08 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -68,9 +68,9 @@ test_that("multiple lints are generated correctly", { e %T>% f() }"), list( - list(message = "pipe %>%"), - list(message = "pipe %\\$%"), - list(message = "pipe %T>%") + list(rex::rex("pipe %>%"), line_number = 2L), + list(rex::rex("pipe %$%"), line_number = 3L), + list(rex::rex("pipe %T>%"), line_number = 4L) ), one_call_pipe_linter() ) From 17e39f2db29e92ebb2e53e6b8c63e4f4ad8613a8 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 18 Nov 2023 12:49:52 -0800 Subject: [PATCH 6/9] fix bad merge --- inst/lintr/linters.csv | 4 ---- man/deprecated_linters.Rd | 1 - man/linters.Rd | 5 +---- 3 files changed, 1 insertion(+), 9 deletions(-) diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 2d70ec0e9..85e97f528 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -62,12 +62,8 @@ numeric_leading_zero_linter,style consistency readability object_length_linter,style readability default configurable executing object_name_linter,style consistency default configurable executing object_usage_linter,style readability correctness default executing configurable -<<<<<<< HEAD one_call_pipe_linter,style readability -open_curly_linter,style readability deprecated configurable -======= open_curly_linter,defunct ->>>>>>> main outer_negation_linter,readability efficiency best_practices package_hooks_linter,style correctness package_development paren_body_linter,style readability default diff --git a/man/deprecated_linters.Rd b/man/deprecated_linters.Rd index a3e8b87cb..08de6c677 100644 --- a/man/deprecated_linters.Rd +++ b/man/deprecated_linters.Rd @@ -15,7 +15,6 @@ The following linters are tagged with 'deprecated': \itemize{ \item{\code{\link{consecutive_stopifnot_linter}}} \item{\code{\link{no_tab_linter}}} -\item{\code{\link{open_curly_linter}}} \item{\code{\link{single_quotes_linter}}} \item{\code{\link{unneeded_concatenation_linter}}} } diff --git a/man/linters.Rd b/man/linters.Rd index 250f742dd..de2dd740a 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -23,7 +23,7 @@ The following tags exist: \item{\link[=consistency_linters]{consistency} (24 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} -\item{\link[=deprecated_linters]{deprecated} (5 linters)} +\item{\link[=deprecated_linters]{deprecated} (4 linters)} \item{\link[=efficiency_linters]{efficiency} (27 linters)} \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} @@ -36,9 +36,6 @@ The following tags exist: \section{Linters}{ The following linters exist: \itemize{ -\item{\code{\link{<<<<<<< HEAD}} (tags: )} -\item{\code{\link{=======}} (tags: )} -\item{\code{\link{>>>>>>> main}} (tags: )} \item{\code{\link{absolute_path_linter}} (tags: best_practices, configurable, robustness)} \item{\code{\link{any_duplicated_linter}} (tags: best_practices, efficiency)} \item{\code{\link{any_is_na_linter}} (tags: best_practices, efficiency)} From 23b223719a58d9285fe59563337d38eb362a3493 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 10:46:12 -0800 Subject: [PATCH 7/9] re-use 'magrittr_pipes' --- R/one_call_pipe_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/one_call_pipe_linter.R b/R/one_call_pipe_linter.R index 9bd319bce..4ee4c094d 100644 --- a/R/one_call_pipe_linter.R +++ b/R/one_call_pipe_linter.R @@ -37,7 +37,7 @@ #' - #' @export one_call_pipe_linter <- function() { - pipes_cond <- xp_text_in_table(c("%>%", "%$%", "%T>%")) + pipes_cond <- xp_text_in_table(magrittr_pipes) # preceding-sibling::SPECIAL: if there are ever two pipes, don't lint # OP-LEFT-BRACKET/LBB: accept DT[...] %>% .[...] as a two-call pipe, From aef423d36e60543262bf67ec1bd590e19db0f382 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 10:47:28 -0800 Subject: [PATCH 8/9] multi-line case for robustness --- tests/testthat/test-one_call_pipe_linter.R | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/tests/testthat/test-one_call_pipe_linter.R b/tests/testthat/test-one_call_pipe_linter.R index 7d1e58c08..50be3a38b 100644 --- a/tests/testthat/test-one_call_pipe_linter.R +++ b/tests/testthat/test-one_call_pipe_linter.R @@ -65,7 +65,8 @@ test_that("multiple lints are generated correctly", { trim_some("{ a %>% b() c %$% d() - e %T>% f() + e %T>% + f() }"), list( list(rex::rex("pipe %>%"), line_number = 2L), From c971f07a84375a987daa85e11a839295f484bd8b Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sun, 19 Nov 2023 11:25:53 -0800 Subject: [PATCH 9/9] finish merge --- man/linters.Rd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/man/linters.Rd b/man/linters.Rd index 9ff0e0df7..66fee2b8f 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -28,7 +28,7 @@ The following tags exist: \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} \item{\link[=pkg_testthat_linters]{pkg_testthat} (12 linters)} -\item{\link[=readability_linters]{readability} (59 linters)} +\item{\link[=readability_linters]{readability} (60 linters)} \item{\link[=regex_linters]{regex} (4 linters)} \item{\link[=robustness_linters]{robustness} (16 linters)} \item{\link[=style_linters]{style} (39 linters)}