From 016aa9c11d500474d93881c280dee30db0afb1e7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 29 Mar 2023 23:30:53 +0000 Subject: [PATCH 1/6] Catch consecutive calls to assert_that in renamed consecutive_assertion_linter --- DESCRIPTION | 2 +- NAMESPACE | 1 + NEWS.md | 6 +- R/consecutive_assertion_linter.R | 58 ++++++++++ R/consecutive_stopifnot_linter.R | 48 -------- R/lintr-deprecated.R | 13 +++ R/utils.R | 2 +- inst/lintr/linters.csv | 3 +- ...ter.Rd => consecutive_assertion_linter.Rd} | 17 +-- man/consistency_linters.Rd | 1 + man/deprecated_linters.Rd | 1 + man/linters.Rd | 11 +- man/lintr-deprecated.Rd | 3 + man/readability_linters.Rd | 1 + man/style_linters.Rd | 1 + .../test-consecutive_assertion_linter.R | 109 ++++++++++++++++++ .../test-consecutive_stopifnot_linter.R | 57 --------- 17 files changed, 211 insertions(+), 123 deletions(-) create mode 100644 R/consecutive_assertion_linter.R delete mode 100644 R/consecutive_stopifnot_linter.R rename man/{consecutive_stopifnot_linter.Rd => consecutive_assertion_linter.Rd} (51%) create mode 100644 tests/testthat/test-consecutive_assertion_linter.R delete mode 100644 tests/testthat/test-consecutive_stopifnot_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index 2301435ba..15ec1550b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -75,7 +75,7 @@ Collate: 'comments.R' 'condition_message_linter.R' 'conjunct_test_linter.R' - 'consecutive_stopifnot_linter.R' + 'consecutive_assertion_linter.R' 'cyclocomp_linter.R' 'declared_functions.R' 'deprecated.R' diff --git a/NAMESPACE b/NAMESPACE index 157c3c467..2691e86f6 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -38,6 +38,7 @@ export(commas_linter) export(commented_code_linter) export(condition_message_linter) export(conjunct_test_linter) +export(consecutive_assertion_linter) export(consecutive_stopifnot_linter) export(cyclocomp_linter) export(default_linters) diff --git a/NEWS.md b/NEWS.md index 2f5dc967a..b9a695465 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ * `single_quotes_linter()` is deprecated in favor of the more generalizable `quotes_linter()` (#1729, @MichaelChirico). * `unneeded_concatentation_linter()` is deprecated in favor of `unnecessary_concatenation_linter()` for naming consistency (#1707, @IndrajeetPatil). +* `consecutive_stopifnot_linter()` is deprecated in favor of the more general (see below) `consecutive_assertion_linter()` (#1604, @MichaelChirico). ## Bug fixes @@ -91,8 +92,7 @@ * `infix_spaces_linter()` supports the native R pipe `|>` (#1793, @AshesITR) -* `unneeded_concatenation_linter()` no longer lints on `c(...)` (i.e., passing `...` in a function call) - when `allow_single_expression = FALSE` (#1696, @MichaelChirico) +* `unnecessary_concatenation_linter()` (f.k.a. `unneeded_concatenation_linter()`) no longer lints on `c(...)` (i.e., passing `...` in a function call) when `allow_single_expression = FALSE` (#1696, @MichaelChirico) * `object_name_linter()` gains parameter `regexes` to allow custom naming conventions (#822, #1421, @AshesITR) @@ -144,6 +144,8 @@ * `unnecessary_concatenation_linter()` is simply `unneeded_concatenation_linter()`, renamed. +* `consecutive_assertion_linter()` (f.k.a. `consecutive_stopifnot_linter()`) now lints for consecutive calls to `assertthat::assert_that()` (as long as the `msg=` argument is not used; #1604, @MichaelChirico). + ## Notes * {lintr} now depends on R version 3.5.0, in line with the tidyverse policy for R version compatibility. diff --git a/R/consecutive_assertion_linter.R b/R/consecutive_assertion_linter.R new file mode 100644 index 000000000..31d21b9d3 --- /dev/null +++ b/R/consecutive_assertion_linter.R @@ -0,0 +1,58 @@ +#' Force consecutive calls to assertions into just one when possible +#' +#' [stopifnot()] accepts any number of tests, so sequences like +#' `stopifnot(x); stopifnot(y)` are redundant. Ditto for tests using +#' `assertthat::assert_that()` without specifying `msg=`. +#' +#' @examples +#' # will produce lints +#' lint( +#' text = "stopifnot(x); stopifnot(y)", +#' linters = consecutive_assertion_linter() +#' ) +#' +#' # okay +#' lint( +#' text = "stopifnot(x, y)", +#' linters = consecutive_assertion_linter() +#' ) +#' +#' @evalRd rd_tags("consecutive_assertion_linter") +#' @seealso [linters] for a complete list of linters available in lintr. +#' @export +consecutive_assertion_linter <- function() { + # match on the expr, not the SYMBOL_FUNCTION_CALL, to ensure + # namespace-qualified calls only match if the namespaces do. + xpath <- " + //SYMBOL_FUNCTION_CALL[text() = 'stopifnot'] + /parent::expr + /parent::expr[expr[1]/SYMBOL_FUNCTION_CALL = following-sibling::expr[1]/expr[1]/SYMBOL_FUNCTION_CALL] + | + //SYMBOL_FUNCTION_CALL[text() = 'assert_that'] + /parent::expr + /parent::expr[ + not(SYMBOL_SUB[text() = 'msg']) + and not(following-sibling::expr[1]/SYMBOL_SUB[text() = 'msg']) + and expr[1]/SYMBOL_FUNCTION_CALL = following-sibling::expr[1]/expr[1]/SYMBOL_FUNCTION_CALL + ] + " + + Linter(function(source_expression) { + # need the full file to also catch usages at the top level + if (!is_lint_level(source_expression, "file")) { + return(list()) + } + + xml <- source_expression$full_xml_parsed_content + + bad_expr <- xml2::xml_find_all(xml, xpath) + + matched_function <- xp_call_name(bad_expr) + xml_nodes_to_lints( + bad_expr, + source_expression, + lint_message = sprintf("Unify consecutive calls to %s().", matched_function), + type = "warning" + ) + }) +} diff --git a/R/consecutive_stopifnot_linter.R b/R/consecutive_stopifnot_linter.R deleted file mode 100644 index f10ce8733..000000000 --- a/R/consecutive_stopifnot_linter.R +++ /dev/null @@ -1,48 +0,0 @@ -#' Force consecutive calls to stopifnot into just one when possible -#' -#' [stopifnot()] accepts any number of tests, so sequences like -#' `stopifnot(x); stopifnot(y)` are redundant. -#' -#' @examples -#' # will produce lints -#' lint( -#' text = "stopifnot(x); stopifnot(y)", -#' linters = consecutive_stopifnot_linter() -#' ) -#' -#' # okay -#' lint( -#' text = "stopifnot(x, y)", -#' linters = consecutive_stopifnot_linter() -#' ) -#' -#' @evalRd rd_tags("consecutive_stopifnot_linter") -#' @seealso [linters] for a complete list of linters available in lintr. -#' @export -consecutive_stopifnot_linter <- function() { - # match on the expr, not the SYMBOL_FUNCTION_CALL, to ensure - # namespace-qualified calls only match if the namespaces do. - xpath <- " - //SYMBOL_FUNCTION_CALL[text() = 'stopifnot'] - /parent::expr - /parent::expr[expr[1] = following-sibling::expr[1]/expr] - " - - Linter(function(source_expression) { - # need the full file to also catch usages at the top level - if (!is_lint_level(source_expression, "file")) { - return(list()) - } - - xml <- source_expression$full_xml_parsed_content - - bad_expr <- xml2::xml_find_all(xml, xpath) - - xml_nodes_to_lints( - bad_expr, - source_expression = source_expression, - lint_message = "Unify consecutive calls to stopifnot().", - type = "warning" - ) - }) -} diff --git a/R/lintr-deprecated.R b/R/lintr-deprecated.R index 43662a198..9709ac35d 100644 --- a/R/lintr-deprecated.R +++ b/R/lintr-deprecated.R @@ -226,3 +226,16 @@ single_quotes_linter <- function() { ) quotes_linter() } + +#' Consecutive stopifnot linter +#' @rdname lintr-deprecated +#' @export +consecutive_stopifnot_linter <- function() { + lintr_deprecated( + old = "consecutive_stopifnot_linter", + new = "consecutive_assertion_linter", + version = "3.1.0", + type = "Linter" + ) + consecutive_assertion_linter() +} diff --git a/R/utils.R b/R/utils.R index ef6de0e77..05d010696 100644 --- a/R/utils.R +++ b/R/utils.R @@ -281,7 +281,7 @@ get_r_code <- function(xml) { #' #' [xml2::xml_text()] is deceptively close to obviating this helper, but it collapses #' text across lines. R is _mostly_ whitespace-agnostic, so this only matters in some edge cases, -#' in particular when there are comments within an expression ( node). See #1919. +#' in particular when there are comments within an expression (`` node). See #1919. #' #' @noRd xml2lang <- function(x) { diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 48d052cf7..53ee21534 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -12,7 +12,8 @@ commas_linter,style readability default commented_code_linter,style readability best_practices default condition_message_linter,best_practices consistency conjunct_test_linter,package_development best_practices readability configurable -consecutive_stopifnot_linter,style readability consistency +consecutive_assertion_linter,style readability consistency +consecutive_stopifnot_linter,style readability consistency deprecated cyclocomp_linter,style readability best_practices default configurable duplicate_argument_linter,correctness common_mistakes configurable empty_assignment_linter,readability best_practices diff --git a/man/consecutive_stopifnot_linter.Rd b/man/consecutive_assertion_linter.Rd similarity index 51% rename from man/consecutive_stopifnot_linter.Rd rename to man/consecutive_assertion_linter.Rd index 2f44f67a5..e9e5c7e1b 100644 --- a/man/consecutive_stopifnot_linter.Rd +++ b/man/consecutive_assertion_linter.Rd @@ -1,26 +1,27 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/consecutive_stopifnot_linter.R -\name{consecutive_stopifnot_linter} -\alias{consecutive_stopifnot_linter} -\title{Force consecutive calls to stopifnot into just one when possible} +% Please edit documentation in R/consecutive_assertion_linter.R +\name{consecutive_assertion_linter} +\alias{consecutive_assertion_linter} +\title{Force consecutive calls to assertions into just one when possible} \usage{ -consecutive_stopifnot_linter() +consecutive_assertion_linter() } \description{ \code{\link[=stopifnot]{stopifnot()}} accepts any number of tests, so sequences like -\verb{stopifnot(x); stopifnot(y)} are redundant. +\verb{stopifnot(x); stopifnot(y)} are redundant. Ditto for tests using +\code{assertthat::assert_that()} without specifying \verb{msg=}. } \examples{ # will produce lints lint( text = "stopifnot(x); stopifnot(y)", - linters = consecutive_stopifnot_linter() + linters = consecutive_assertion_linter() ) # okay lint( text = "stopifnot(x, y)", - linters = consecutive_stopifnot_linter() + linters = consecutive_assertion_linter() ) } diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 78fb5feca..63874947d 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -16,6 +16,7 @@ The following linters are tagged with 'consistency': \item{\code{\link{assignment_linter}}} \item{\code{\link{class_equals_linter}}} \item{\code{\link{condition_message_linter}}} +\item{\code{\link{consecutive_assertion_linter}}} \item{\code{\link{consecutive_stopifnot_linter}}} \item{\code{\link{function_argument_linter}}} \item{\code{\link{implicit_integer_linter}}} diff --git a/man/deprecated_linters.Rd b/man/deprecated_linters.Rd index ffedebb44..657d1f2c2 100644 --- a/man/deprecated_linters.Rd +++ b/man/deprecated_linters.Rd @@ -14,6 +14,7 @@ These linters will be excluded from \code{linters_with_tags()} by default. The following linters are tagged with 'deprecated': \itemize{ \item{\code{\link{closed_curly_linter}}} +\item{\code{\link{consecutive_stopifnot_linter}}} \item{\code{\link{open_curly_linter}}} \item{\code{\link{paren_brace_linter}}} \item{\code{\link{semicolon_terminator_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index f041b945a..28aa2a56e 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -20,16 +20,16 @@ The following tags exist: \item{\link[=best_practices_linters]{best_practices} (50 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (7 linters)} \item{\link[=configurable_linters]{configurable} (33 linters)} -\item{\link[=consistency_linters]{consistency} (19 linters)} +\item{\link[=consistency_linters]{consistency} (20 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} -\item{\link[=deprecated_linters]{deprecated} (6 linters)} +\item{\link[=deprecated_linters]{deprecated} (7 linters)} \item{\link[=efficiency_linters]{efficiency} (24 linters)} \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} -\item{\link[=readability_linters]{readability} (53 linters)} +\item{\link[=readability_linters]{readability} (54 linters)} \item{\link[=robustness_linters]{robustness} (14 linters)} -\item{\link[=style_linters]{style} (40 linters)} +\item{\link[=style_linters]{style} (41 linters)} } } \section{Linters}{ @@ -48,7 +48,8 @@ The following linters exist: \item{\code{\link{commented_code_linter}} (tags: best_practices, default, readability, style)} \item{\code{\link{condition_message_linter}} (tags: best_practices, consistency)} \item{\code{\link{conjunct_test_linter}} (tags: best_practices, configurable, package_development, readability)} -\item{\code{\link{consecutive_stopifnot_linter}} (tags: consistency, readability, style)} +\item{\code{\link{consecutive_assertion_linter}} (tags: consistency, readability, style)} +\item{\code{\link{consecutive_stopifnot_linter}} (tags: consistency, deprecated, readability, style)} \item{\code{\link{cyclocomp_linter}} (tags: best_practices, configurable, default, readability, style)} \item{\code{\link{duplicate_argument_linter}} (tags: common_mistakes, configurable, correctness)} \item{\code{\link{empty_assignment_linter}} (tags: best_practices, readability)} diff --git a/man/lintr-deprecated.Rd b/man/lintr-deprecated.Rd index 1c678ad86..0df89df9b 100644 --- a/man/lintr-deprecated.Rd +++ b/man/lintr-deprecated.Rd @@ -8,6 +8,7 @@ \alias{semicolon_terminator_linter} \alias{unneeded_concatenation_linter} \alias{single_quotes_linter} +\alias{consecutive_stopifnot_linter} \title{Deprecated functions in lintr} \usage{ closed_curly_linter(allow_single_line = FALSE) @@ -21,6 +22,8 @@ semicolon_terminator_linter(semicolon = c("compound", "trailing")) unneeded_concatenation_linter(allow_single_expression = TRUE) single_quotes_linter() + +consecutive_stopifnot_linter() } \arguments{ \item{allow_single_line}{if \code{TRUE}, allow an open and closed curly pair on the same line.} diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd index 0e27eef21..9d2e74997 100644 --- a/man/readability_linters.Rd +++ b/man/readability_linters.Rd @@ -18,6 +18,7 @@ The following linters are tagged with 'readability': \item{\code{\link{commas_linter}}} \item{\code{\link{commented_code_linter}}} \item{\code{\link{conjunct_test_linter}}} +\item{\code{\link{consecutive_assertion_linter}}} \item{\code{\link{consecutive_stopifnot_linter}}} \item{\code{\link{cyclocomp_linter}}} \item{\code{\link{empty_assignment_linter}}} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index ca6bf6fc8..7e115b922 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -17,6 +17,7 @@ The following linters are tagged with 'style': \item{\code{\link{closed_curly_linter}}} \item{\code{\link{commas_linter}}} \item{\code{\link{commented_code_linter}}} +\item{\code{\link{consecutive_assertion_linter}}} \item{\code{\link{consecutive_stopifnot_linter}}} \item{\code{\link{cyclocomp_linter}}} \item{\code{\link{extraction_operator_linter}}} diff --git a/tests/testthat/test-consecutive_assertion_linter.R b/tests/testthat/test-consecutive_assertion_linter.R new file mode 100644 index 000000000..979839abb --- /dev/null +++ b/tests/testthat/test-consecutive_assertion_linter.R @@ -0,0 +1,109 @@ +test_that("consecutive_assertion_linter skips allowed usages", { + expect_lint("stopifnot(x)", NULL, consecutive_assertion_linter()) + expect_lint("stopifnot(x, y, z)", NULL, consecutive_assertion_linter()) + + # intervening expression + expect_lint("stopifnot(x); y; stopifnot(z)", NULL, consecutive_assertion_linter()) + + # inline or potentially with gaps don't matter + lines <- trim_some(" + stopifnot(x) + y + + stopifnot(z) + ") + expect_lint(lines, NULL, consecutive_assertion_linter()) +}) + +test_that("consecutive_assertion_linter blocks simple disallowed usages", { + # one test of inline usage + expect_lint( + "stopifnot(x); stopifnot(y)", + rex::rex("Unify consecutive calls to stopifnot()."), + consecutive_assertion_linter() + ) + + lines_gap <- trim_some(" + stopifnot(x) + + stopifnot(y, z) + ") + expect_lint( + lines_gap, + rex::rex("Unify consecutive calls to stopifnot()."), + consecutive_assertion_linter() + ) + + lines_consecutive <- trim_some(" + stopifnot(x) + stopifnot(y) + ") + expect_lint( + lines_consecutive, + rex::rex("Unify consecutive calls to stopifnot()."), + consecutive_assertion_linter() + ) + + lines_comment <- trim_some(" + stopifnot(x) + # a comment on y + stopifnot(y) + ") + expect_lint( + lines_comment, + rex::rex("Unify consecutive calls to stopifnot()."), + consecutive_assertion_linter() + ) +}) + +test_that("assert_that usages are handled correctly too", { + linter <- consecutive_assertion_linter() + lint_msg <- rex::rex("Unify consecutive calls to assert_that().") + + expect_lint("assert_that(x)", NULL, consecutive_assertion_linter()) + expect_lint("assertthat::assert_that(x, y, z)", NULL, consecutive_assertion_linter()) + + # if msg= is used, can't necessarily combine + lines <- trim_some(" + assert_that(x, msg = 'bad x') + assert_that(y, msg = 'bad y') + ") + expect_lint(lines, NULL, consecutive_assertion_linter()) + + # one test of inline usage + expect_lint( + "assert_that(x); assert_that(y)", + lint_msg, + consecutive_assertion_linter() + ) + + lines_gap <- trim_some(" + assert_that(x) + + assertthat::assert_that(y, z) + ") + expect_lint(lines_gap, lint_msg, consecutive_assertion_linter()) +}) + +test_that("Mixing test functions is fine", { + expect_lint( + trim_some(" + assert_that(x) + stopifnot(y) + "), + NULL, + consecutive_assertion_linter() + ) +}) + +test_that("old name consecutive_stopifnot_linter() is deprecated", { + expect_warning( + { + old_linter <- consecutive_stopifnot_linter() + }, + "Use consecutive_assertion_linter instead", + fixed = TRUE + ) + expect_lint('stopifnot(x); y; stopifnot(z)', NULL, old_linter) + expect_lint("stopifnot(x); stopifnot(y)", "Unify consecutive calls", old_linter) +}) diff --git a/tests/testthat/test-consecutive_stopifnot_linter.R b/tests/testthat/test-consecutive_stopifnot_linter.R deleted file mode 100644 index 4d7bdeb01..000000000 --- a/tests/testthat/test-consecutive_stopifnot_linter.R +++ /dev/null @@ -1,57 +0,0 @@ -test_that("consecutive_stopifnot_linter skips allowed usages", { - expect_lint("stopifnot(x)", NULL, consecutive_stopifnot_linter()) - expect_lint("stopifnot(x, y, z)", NULL, consecutive_stopifnot_linter()) - - # intervening expression - expect_lint("stopifnot(x); y; stopifnot(z)", NULL, consecutive_stopifnot_linter()) - - # inline or potentially with gaps don't matter - lines <- trim_some(" - stopifnot(x) - y - - stopifnot(z) - ") - expect_lint(lines, NULL, consecutive_stopifnot_linter()) -}) - -test_that("consecutive_stopifnot_linter blocks simple disallowed usages", { - # one test of inline usage - expect_lint( - "stopifnot(x); stopifnot(y)", - rex::rex("Unify consecutive calls to stopifnot()."), - consecutive_stopifnot_linter() - ) - - lines_gap <- trim_some(" - stopifnot(x) - - stopifnot(y, z) - ") - expect_lint( - lines_gap, - rex::rex("Unify consecutive calls to stopifnot()."), - consecutive_stopifnot_linter() - ) - - lines_consecutive <- trim_some(" - stopifnot(x) - stopifnot(y) - ") - expect_lint( - lines_consecutive, - rex::rex("Unify consecutive calls to stopifnot()."), - consecutive_stopifnot_linter() - ) - - lines_comment <- trim_some(" - stopifnot(x) - # a comment on y - stopifnot(y) - ") - expect_lint( - lines_comment, - rex::rex("Unify consecutive calls to stopifnot()."), - consecutive_stopifnot_linter() - ) -}) From 7917be20ad4f04bdbf5d1ac9973e556fe9a5b443 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 29 Mar 2023 23:34:07 +0000 Subject: [PATCH 2/6] new examples --- R/consecutive_assertion_linter.R | 10 ++++++++++ man/consecutive_assertion_linter.Rd | 10 ++++++++++ 2 files changed, 20 insertions(+) diff --git a/R/consecutive_assertion_linter.R b/R/consecutive_assertion_linter.R index 31d21b9d3..f0a9a9364 100644 --- a/R/consecutive_assertion_linter.R +++ b/R/consecutive_assertion_linter.R @@ -11,12 +11,22 @@ #' linters = consecutive_assertion_linter() #' ) #' +#' lint( +#' text = "assert_that(x); assert_that(y)", +#' linters = consecutive_assertion_linter() +#' ) +#' #' # okay #' lint( #' text = "stopifnot(x, y)", #' linters = consecutive_assertion_linter() #' ) #' +#' lint( +#' text = 'assert_that(x, msg = "Bad x!"); assert_that(y)', +#' linters = consecutive_assertion_linter() +#' ) +#' #' @evalRd rd_tags("consecutive_assertion_linter") #' @seealso [linters] for a complete list of linters available in lintr. #' @export diff --git a/man/consecutive_assertion_linter.Rd b/man/consecutive_assertion_linter.Rd index e9e5c7e1b..72e3a8925 100644 --- a/man/consecutive_assertion_linter.Rd +++ b/man/consecutive_assertion_linter.Rd @@ -18,12 +18,22 @@ lint( linters = consecutive_assertion_linter() ) +lint( + text = "assert_that(x); assert_that(y)", + linters = consecutive_assertion_linter() +) + # okay lint( text = "stopifnot(x, y)", linters = consecutive_assertion_linter() ) +lint( + text = 'assert_that(x, msg = "Bad x!"); assert_that(y)', + linters = consecutive_assertion_linter() +) + } \seealso{ \link{linters} for a complete list of linters available in lintr. From 4bff694c3889d499db01db5ac47a0d7bde893712 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 29 Mar 2023 23:35:18 +0000 Subject: [PATCH 3/6] remove dated comment --- R/consecutive_assertion_linter.R | 2 -- 1 file changed, 2 deletions(-) diff --git a/R/consecutive_assertion_linter.R b/R/consecutive_assertion_linter.R index f0a9a9364..9822f7c1d 100644 --- a/R/consecutive_assertion_linter.R +++ b/R/consecutive_assertion_linter.R @@ -31,8 +31,6 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export consecutive_assertion_linter <- function() { - # match on the expr, not the SYMBOL_FUNCTION_CALL, to ensure - # namespace-qualified calls only match if the namespaces do. xpath <- " //SYMBOL_FUNCTION_CALL[text() = 'stopifnot'] /parent::expr From 8838e67fc8182fe4cc5c4396d097381d23afe693 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 29 Mar 2023 23:38:45 +0000 Subject: [PATCH 4/6] [style] better parallelism for similar xpath --- R/consecutive_assertion_linter.R | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/R/consecutive_assertion_linter.R b/R/consecutive_assertion_linter.R index 9822f7c1d..3a83584cf 100644 --- a/R/consecutive_assertion_linter.R +++ b/R/consecutive_assertion_linter.R @@ -34,7 +34,9 @@ consecutive_assertion_linter <- function() { xpath <- " //SYMBOL_FUNCTION_CALL[text() = 'stopifnot'] /parent::expr - /parent::expr[expr[1]/SYMBOL_FUNCTION_CALL = following-sibling::expr[1]/expr[1]/SYMBOL_FUNCTION_CALL] + /parent::expr[ + expr[1]/SYMBOL_FUNCTION_CALL = following-sibling::expr[1]/expr[1]/SYMBOL_FUNCTION_CALL + ] | //SYMBOL_FUNCTION_CALL[text() = 'assert_that'] /parent::expr From 7b1dd0c5c43e6f66b76b2a9ca406e71032fd984f Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Wed, 29 Mar 2023 17:01:14 -0700 Subject: [PATCH 5/6] fix lints --- tests/testthat/test-consecutive_assertion_linter.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-consecutive_assertion_linter.R b/tests/testthat/test-consecutive_assertion_linter.R index 979839abb..b0c9b7e2e 100644 --- a/tests/testthat/test-consecutive_assertion_linter.R +++ b/tests/testthat/test-consecutive_assertion_linter.R @@ -69,7 +69,7 @@ test_that("assert_that usages are handled correctly too", { assert_that(y, msg = 'bad y') ") expect_lint(lines, NULL, consecutive_assertion_linter()) - + # one test of inline usage expect_lint( "assert_that(x); assert_that(y)", @@ -104,6 +104,6 @@ test_that("old name consecutive_stopifnot_linter() is deprecated", { "Use consecutive_assertion_linter instead", fixed = TRUE ) - expect_lint('stopifnot(x); y; stopifnot(z)', NULL, old_linter) + expect_lint("stopifnot(x); y; stopifnot(z)", NULL, old_linter) expect_lint("stopifnot(x); stopifnot(y)", "Unify consecutive calls", old_linter) }) From e7002a2187dfe74c4a1daa3215e4e32998260005 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 3 Apr 2023 20:11:35 -0700 Subject: [PATCH 6/6] use local variables in tests --- .../test-consecutive_assertion_linter.R | 84 ++++++++++--------- 1 file changed, 44 insertions(+), 40 deletions(-) diff --git a/tests/testthat/test-consecutive_assertion_linter.R b/tests/testthat/test-consecutive_assertion_linter.R index b0c9b7e2e..362e3ba18 100644 --- a/tests/testthat/test-consecutive_assertion_linter.R +++ b/tests/testthat/test-consecutive_assertion_linter.R @@ -1,58 +1,62 @@ test_that("consecutive_assertion_linter skips allowed usages", { - expect_lint("stopifnot(x)", NULL, consecutive_assertion_linter()) - expect_lint("stopifnot(x, y, z)", NULL, consecutive_assertion_linter()) + linter <- consecutive_assertion_linter() + expect_lint("stopifnot(x)", NULL, linter) + expect_lint("stopifnot(x, y, z)", NULL, linter) # intervening expression - expect_lint("stopifnot(x); y; stopifnot(z)", NULL, consecutive_assertion_linter()) + expect_lint("stopifnot(x); y; stopifnot(z)", NULL, linter) # inline or potentially with gaps don't matter - lines <- trim_some(" - stopifnot(x) - y - - stopifnot(z) - ") - expect_lint(lines, NULL, consecutive_assertion_linter()) + expect_lint( + trim_some(" + stopifnot(x) + y + + stopifnot(z) + "), + NULL, + linter + ) }) test_that("consecutive_assertion_linter blocks simple disallowed usages", { + linter <- consecutive_assertion_linter() + lint_msg <- rex::rex("Unify consecutive calls to stopifnot().") + # one test of inline usage expect_lint( "stopifnot(x); stopifnot(y)", - rex::rex("Unify consecutive calls to stopifnot()."), - consecutive_assertion_linter() + lint_msg, + linter ) - lines_gap <- trim_some(" - stopifnot(x) - - stopifnot(y, z) - ") expect_lint( - lines_gap, - rex::rex("Unify consecutive calls to stopifnot()."), - consecutive_assertion_linter() + trim_some(" + stopifnot(x) + + stopifnot(y, z) + "), + lint_msg, + linter ) - lines_consecutive <- trim_some(" - stopifnot(x) - stopifnot(y) - ") expect_lint( - lines_consecutive, - rex::rex("Unify consecutive calls to stopifnot()."), - consecutive_assertion_linter() + trim_some(" + stopifnot(x) + stopifnot(y) + "), + lint_msg, + linter ) - lines_comment <- trim_some(" - stopifnot(x) - # a comment on y - stopifnot(y) - ") expect_lint( - lines_comment, - rex::rex("Unify consecutive calls to stopifnot()."), - consecutive_assertion_linter() + trim_some(" + stopifnot(x) + # a comment on y + stopifnot(y) + "), + lint_msg, + linter ) }) @@ -60,21 +64,21 @@ test_that("assert_that usages are handled correctly too", { linter <- consecutive_assertion_linter() lint_msg <- rex::rex("Unify consecutive calls to assert_that().") - expect_lint("assert_that(x)", NULL, consecutive_assertion_linter()) - expect_lint("assertthat::assert_that(x, y, z)", NULL, consecutive_assertion_linter()) + expect_lint("assert_that(x)", NULL, linter) + expect_lint("assertthat::assert_that(x, y, z)", NULL, linter) # if msg= is used, can't necessarily combine lines <- trim_some(" assert_that(x, msg = 'bad x') assert_that(y, msg = 'bad y') ") - expect_lint(lines, NULL, consecutive_assertion_linter()) + expect_lint(lines, NULL, linter) # one test of inline usage expect_lint( "assert_that(x); assert_that(y)", lint_msg, - consecutive_assertion_linter() + linter ) lines_gap <- trim_some(" @@ -82,7 +86,7 @@ test_that("assert_that usages are handled correctly too", { assertthat::assert_that(y, z) ") - expect_lint(lines_gap, lint_msg, consecutive_assertion_linter()) + expect_lint(lines_gap, lint_msg, linter) }) test_that("Mixing test functions is fine", {