Catch consecutive calls to assert_that in renamed consecutive_asserion_linter (#1940)

* Catch consecutive calls to assert_that in renamed consecutive_assertion_linter

* new examples

* remove dated comment

* [style] better parallelism for similar xpath

* fix lints

* use local variables in tests

Author: MichaelChirico

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'

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)

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
 
@@ -95,8 +96,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)
 
@@ -148,6 +148,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.

R/consecutive_assertion_linter.R

@@ -0,0 +1,68 @@
+#' 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()
+#' )
+#'
+#' 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
+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
+    ]
+  |
+  //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"
+    )
+  })
+}

R/consecutive_stopifnot_linter.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()
+}

R/lintr-deprecated.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 (<expr> node). See #1919.
+#'   in particular when there are comments within an expression (`<expr>` node). See #1919.
 #'
 #' @noRd
 xml2lang <- function(x) {

R/utils.R

@@ -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