New comparison_negation_linter

DESCRIPTION

@@ -77,6 +77,7 @@ Collate:
  'commas_linter.R'
  'comment_linters.R'
  'comments.R'
+ 'comparison_negation_linter.R'
  'condition_message_linter.R'
  'conjunct_test_linter.R'
  'consecutive_assertion_linter.R'

NAMESPACE

@@ -36,6 +36,7 @@ export(clear_cache)
 export(closed_curly_linter)
 export(commas_linter)
 export(commented_code_linter)
+export(comparison_negation_linter)
 export(condition_message_linter)
 export(conjunct_test_linter)
 export(consecutive_assertion_linter)

NEWS.md

@@ -4,6 +4,10 @@
 
 * More helpful errors for invalid configs (#2253, @MichaelChirico).
 
+### New linters
+
+* `comparison_negation_linter()` for discouraging negated comparisons when a direct negation is preferable, e.g. `!(x == y)` could be `x != y` (part of #884, @MichaelChirico).
+
 ### Lint accuracy fixes: removing false positives
 
 * `unreachable_code_linter()` ignores reachable code in inline functions like `function(x) if (x > 2) stop() else x` (#2259, @MEO265).

R/comparison_negation_linter.R

@@ -0,0 +1,64 @@
+#' Block usages like !(x == y) where a direct relational operator is appropriate
+#'
+#' `!(x == y)` is more readably expressed as `x != y`. The same is true of
+#' other negations of simple comparisons like `!(x > y)` and `!(x <= y)`.
+#'
+#' @evalRd rd_tags("comparison_negation_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+comparison_negation_linter <- function() {
+ comparators <- infix_metadata$xml_tag[infix_metadata$comparator]
+
+ comparator_inverses <- c(EQ = "!=", NE = "==", GE = "<", LE = ">", GT = "<=", LT = ">=")
+
+ # outline
+ # - match !
+ # - avoid false positives like `!!x > y`
+ # + two conditions: one for the "outer" ! and one for the "inner" !
+ # - avoid false positives like !any(x > y)
+ # - avoid false positives like !x[f == g]
+ # - make sure to catch both !(x == y) and !x == y
+ xpath <- glue("
+ //OP-EXCLAMATION
+ /parent::expr[
+ not(parent::expr[OP-EXCLAMATION])
+ and expr[
+ not(expr[SYMBOL_FUNCTION_CALL] or OP-EXCLAMATION or OP-LEFT-BRACKET)
+ and (
+ expr[ {xp_or(comparators)} ]
+ or {xp_or(comparators)}
+ )
+ ]
+ ]
+ ")
+
+ 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)
+
+
+ comparator_node <- xml_find_first(bad_expr, "expr/expr/*[2]")
+ comparator_name <- xml_name(comparator_node)
+
+ # "typical" case is assumed to be !(x == y), so try that first, and back
+ # up to the less nested case. there may be a cleaner way to do this...
+ unnested <- !comparator_name %in% names(comparator_inverses)
+ comparator_node[unnested] <- xml_find_first(bad_expr[unnested], "expr/*[2]")
+ comparator_name[unnested] <- xml_name(comparator_node[unnested])
+
+ comparator_text <- xml_text(comparator_node)
+ inverse <- comparator_inverses[comparator_name]
+
+ xml_nodes_to_lints(
+ bad_expr,
+ source_expression = source_expression,
+ lint_message = glue("Use x {inverse} y, not !(x {comparator_text} y)."),
+ type = "warning"
+ )
+ })
+}

inst/lintr/linters.csv

@@ -10,6 +10,7 @@ class_equals_linter,best_practices robustness consistency
 closed_curly_linter,style readability deprecated configurable
 commas_linter,style readability default configurable
 commented_code_linter,style readability best_practices default
+comparison_negation_linter,readability consistency
 condition_message_linter,best_practices consistency
 conjunct_test_linter,package_development best_practices readability configurable pkg_testthat
 consecutive_assertion_linter,style readability consistency

tests/testthat/test-comparison_negation_linter.R

@@ -0,0 +1,61 @@
+test_that("comparison_negation_linter skips allowed usages", {
+ linter <- comparison_negation_linter()
+
+ # doesn't apply to joint statements
+ expect_lint("!(x == y | y == z)", NULL, linter)
+ # don't force de Morgan's laws
+ expect_lint("!(x & y)", NULL, linter)
+
+ # naive xpath will include !foo(x) cases
+ expect_lint("!any(x > y)", NULL, linter)
+ # ditto for tidyeval cases
+ expect_lint("!!target == 1 ~ 'target'", NULL, linter)
+ # ditto for !x[f == g]
+ expect_lint("!passes.test[stage == 1]", NULL, linter)
+})
+
+local({
+ comparators <- c("==", "!=", ">=", ">", "<=", "<")
+ inverses <- c("!=", "==", "<", "<=", ">", ">=")
+ patrick::with_parameters_test_that(
+ "comparison_negation_linter blocks simple disallowed usages",
+ {
+ expect_lint(
+ sprintf("!(x %s y)", comparator),
+ rex::rex(sprintf("Use x %s y, not !(x %s y)", inverse, comparator)),
+ linter
+ )
+ expect_lint(
+ sprintf("!x %s y", comparator),
+ rex::rex(sprintf("Use x %s y, not !(x %s y)", inverse, comparator)),
+ linter
+ )
+ },
+ .test_name = comparators,
+ comparator = comparators,
+ inverse = inverses
+ )
+})
+
+test_that("comparison_negation_linter catches plain ! (no parens) + call", {
+ # Earlier logic would find the wrong node due to expr in length()
+ expect_lint(
+ "!length(x) > 0",
+ rex::rex("Use x <= y, not !(x > y)"),
+ comparison_negation_linter()
+ )
+})
+
+test_that("Lints vectorize", {
+ expect_lint(
+ trim_some("{
+ !(x > y)
+ !x == y
+ }"),
+ list(
+ list(rex::rex("Use x <= y, not !(x > y)."), line_number = 2L),
+ list(rex::rex("Use x != y, not !(x == y)."), line_number = 3L)
+ ),
+ comparison_negation_linter()
+ )
+})