New expect_true_false_linter

DESCRIPTION

@@ -67,6 +67,7 @@ Collate:
     'expect_not_linter.R'
     'expect_null_linter.R'
     'expect_s3_class_linter.R'
+    'expect_true_false_linter.R'
     'expect_type_linter.R'
     'extract.R'
     'extraction_operator_linter.R'

NAMESPACE

@@ -35,6 +35,7 @@ export(expect_not_linter)
 export(expect_null_linter)
 export(expect_s3_class_linter)
 export(expect_s4_class_linter)
+export(expect_true_false_linter)
 export(expect_type_linter)
 export(extraction_operator_linter)
 export(function_left_parentheses_linter)

NEWS.md

@@ -92,6 +92,7 @@ function calls. (#850, #851, @renkun-ken)
    + `expect_s3_class_linter()` Require usage of `expect_s3_class(x, k)` over `expect_equal(class(x), k)` and similar
    + `expect_s4_class_linter()` Require usage of `expect_s4_class(x, k)` over `expect_true(methods::is(x, k))`
    + `expect_not_linter()` Require usage of `expect_false(x)` over `expect_true(!x)`, and _vice versa_.
+   + `expect_true_false_linter()` Require usage of `expect_true(x)` over `expect_equal(x, TRUE)` and similar
 * `assignment_linter()` now lints right assignment (`->` and `->>`) and gains two arguments. `allow_cascading_assign` (`TRUE` by default) toggles whether to lint `<<-` and `->>`; `allow_right_assign` toggles whether to lint `->` and `->>` (#915, @michaelchirico)
 
 # lintr 2.0.1

R/expect_true_false_linter.R

@@ -0,0 +1,39 @@
+#' Require usage of expect_true(x) over expect_equal(x, TRUE)
+#'
+#' [testthat::expect_true()] and [testthat::expect_false()] exist specifically
+#'   for testing the `TRUE`/`FALSE` value of an object.
+#'   [testthat::expect_equal()] and [testthat::expect_identical()] can also be
+#'   used for such tests, but it is better to use the tailored function instead.
+#'
+#' @evalRd rd_tags("expect_true_false_linter")
+#' @seealso [linters] for a complete list of linters available in lintr.
+#' @export
+expect_true_false_linter <- function() {
+  Linter(function(source_file) {
+    if (length(source_file$parsed_content) == 0L) {
+      return(list())
+    }
+
+    xml <- source_file$xml_parsed_content
+
+    xpath <- "//expr[expr[
+      SYMBOL_FUNCTION_CALL[text() = 'expect_equal' or text() = 'expect_identical']
+      and following-sibling::expr[position() <= 2 and NUM_CONST[text() = 'TRUE' or text() = 'FALSE']]
+    ]]"
+
+    bad_expr <- xml2::xml_find_all(xml, xpath)
+    return(lapply(bad_expr, gen_expect_true_false_lint, source_file))
+  })
+}
+
+gen_expect_true_false_lint <- function(expr, source_file) {
+  # NB: use expr/$node, not expr[$node], to exclude other things (especially ns:: parts of the call)
+  call_name <- xml2::xml_text(xml2::xml_find_first(expr, "expr/SYMBOL_FUNCTION_CALL[starts-with(text(), 'expect_')]"))
+  truth_value <- xml2::xml_text(xml2::xml_find_first(expr, "expr/NUM_CONST[text() = 'TRUE' or text() = 'FALSE']"))
+  if (truth_value == "TRUE") {
+    lint_msg <- sprintf("expect_true(x) is better than %s(x, TRUE)", call_name)
+  } else {
+    lint_msg <- sprintf("expect_false(x) is better than %s(x, FALSE)", call_name)
+  }
+  xml_nodes_to_lint(expr, source_file, lint_msg, type = "warning")
+}

inst/lintr/linters.csv

@@ -13,6 +13,7 @@ expect_not_linter,package_development best_practices readability
 expect_null_linter,package_development best_practices
 expect_s3_class_linter,package_development best_practices
 expect_s4_class_linter,package_development best_practices
+expect_true_false_linter,package_development best_practices readability
 expect_type_linter,package_development best_practices
 extraction_operator_linter,style best_practices
 function_left_parentheses_linter,style readability default

tests/testthat/test-expect_true_false_linter.R

@@ -0,0 +1,26 @@
+test_that("expect_true_false_linter skips allowed usages", {
+  # expect_true is a scalar test; testing logical vectors with expect_equal is OK
+  expect_lint("expect_equal(x, c(TRUE, FALSE))", NULL, expect_true_false_linter())
+})
+
+test_that("expect_true_false_linter blocks simple disallowed usages", {
+  expect_lint(
+    "expect_equal(foo(x), TRUE)",
+    rex::rex("expect_true(x) is better than expect_equal(x, TRUE)"),
+    expect_true_false_linter()
+  )
+
+  # expect_identical is treated the same as expect_equal
+  expect_lint(
+    "testthat::expect_identical(x, FALSE)",
+    rex::rex("expect_false(x) is better than expect_identical(x, FALSE)"),
+    expect_true_false_linter()
+  )
+
+  # also caught when TRUE/FALSE is the first argument
+  expect_lint(
+    "expect_equal(TRUE, foo(x))",
+    rex::rex("expect_true(x) is better than expect_equal(x, TRUE)"),
+    expect_true_false_linter()
+  )
+})

tests/testthat/test-settings.R

@@ -92,10 +92,10 @@ test_that("logical_env utility works as intended", {
   on.exit(if (is.na(old)) Sys.unsetenv(test_env) else sym_set_env(test_env, old))
 
   sym_set_env(test_env, "true")
-  expect_equal(lintr:::logical_env(test_env), TRUE)
+  expect_true(lintr:::logical_env(test_env))
 
   sym_set_env(test_env, "F")
-  expect_equal(lintr:::logical_env(test_env), FALSE)
+  expect_false(lintr:::logical_env(test_env))
 
   sym_set_env(test_env, "")
   expect_null(lintr:::logical_env(test_env))