From ce448694c43a3416b95f6a2550fc74cb367992e0 Mon Sep 17 00:00:00 2001
From: Michael Chirico <chiricom@google.com>
Date: Wed, 16 Mar 2022 02:07:49 +0000
Subject: [PATCH 1/3] New expect_true_false_linter

---
 DESCRIPTION                                   |  1 +
 NAMESPACE                                     |  1 +
 NEWS.md                                       |  1 +
 R/expect_true_false_linter.R                  | 36 +++++++++++++++++++
 inst/lintr/linters.csv                        |  1 +
 man/best_practices_linters.Rd                 |  1 +
 man/expect_not_linter.Rd                      |  4 ++-
 man/expect_true_false_linter.Rd               | 20 +++++++++++
 man/linters.Rd                                |  7 ++--
 man/package_development_linters.Rd            |  1 +
 man/readability_linters.Rd                    |  1 +
 .../testthat/test-expect_true_false_linter.R  | 26 ++++++++++++++
 12 files changed, 96 insertions(+), 4 deletions(-)
 create mode 100644 R/expect_true_false_linter.R
 create mode 100644 man/expect_true_false_linter.Rd
 create mode 100644 tests/testthat/test-expect_true_false_linter.R

diff --git a/DESCRIPTION b/DESCRIPTION
index 4e44760c6..1e87fe0c4 100644
--- a/DESCRIPTION
+++ b/DESCRIPTION
@@ -66,6 +66,7 @@ Collate:
     'expect_lint.R'
     'expect_not_linter.R'
     'expect_null_linter.R'
+    'expect_true_false_linter.R'
     'expect_type_linter.R'
     'extract.R'
     'extraction_operator_linter.R'
diff --git a/NAMESPACE b/NAMESPACE
index d563fed50..6aef46177 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -33,6 +33,7 @@ export(expect_lint)
 export(expect_lint_free)
 export(expect_not_linter)
 export(expect_null_linter)
+export(expect_true_false_linter)
 export(expect_type_linter)
 export(extraction_operator_linter)
 export(function_left_parentheses_linter)
diff --git a/NEWS.md b/NEWS.md
index 64ae49a9f..1802287f3 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -90,6 +90,7 @@ function calls. (#850, #851, @renkun-ken)
    + `expect_null_linter()` Require usage of `expect_null(x)` over `expect_equal(x, NULL)` and similar
    + `expect_type_linter()` Require usage of `expect_type(x, t)` over `expect_equal(typeof(x), t)` and similar
    + `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
diff --git a/R/expect_true_false_linter.R b/R/expect_true_false_linter.R
new file mode 100644
index 000000000..4b7c84f45
--- /dev/null
+++ b/R/expect_true_false_linter.R
@@ -0,0 +1,36 @@
+#' 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[
+      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,
+      xml_nodes_to_lint,
+      source_file = source_file,
+      message = paste(
+        "expect_true(x) is better than expect_equal(x, TRUE);",
+        "expect_false(x) is better than expect_equal(x, FALSE)."
+      ),
+      type = "warning"
+    ))
+  })
+}
diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv
index ce0dcbf02..b0c9775aa 100644
--- a/inst/lintr/linters.csv
+++ b/inst/lintr/linters.csv
@@ -11,6 +11,7 @@ duplicate_argument_linter,correctness common_mistakes configurable
 equals_na_linter,robustness correctness common_mistakes default
 expect_not_linter,package_development best_practices readability
 expect_null_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
diff --git a/man/best_practices_linters.Rd b/man/best_practices_linters.Rd
index b84a09504..120e9c713 100644
--- a/man/best_practices_linters.Rd
+++ b/man/best_practices_linters.Rd
@@ -17,6 +17,7 @@ The following linters are tagged with 'best_practices':
 \item{\code{\link{cyclocomp_linter}}}
 \item{\code{\link{expect_not_linter}}}
 \item{\code{\link{expect_null_linter}}}
+\item{\code{\link{expect_true_false_linter}}}
 \item{\code{\link{expect_type_linter}}}
 \item{\code{\link{extraction_operator_linter}}}
 \item{\code{\link{implicit_integer_linter}}}
diff --git a/man/expect_not_linter.Rd b/man/expect_not_linter.Rd
index cb11b7baf..0331aee89 100644
--- a/man/expect_not_linter.Rd
+++ b/man/expect_not_linter.Rd
@@ -7,9 +7,11 @@
 expect_not_linter()
 }
 \description{
-\code{\link[testthat:logical-expectations]{testthat::expect_false()}} exists specifically for testing an output is
+\code{\link[testthat:logical-expectations]{testthat::expect_false()}} exists specifically for testing that an output is
 \code{FALSE}. \code{\link[testthat:logical-expectations]{testthat::expect_true()}} can also be used for such tests by
 negating the output, but it is better to use the tailored function instead.
+The reverse is also true -- use \code{expect_false(A)} instead of
+\code{expect_true(!A)}.
 }
 \seealso{
 \link{linters} for a complete list of linters available in lintr.
diff --git a/man/expect_true_false_linter.Rd b/man/expect_true_false_linter.Rd
new file mode 100644
index 000000000..fe0542591
--- /dev/null
+++ b/man/expect_true_false_linter.Rd
@@ -0,0 +1,20 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/expect_true_false_linter.R
+\name{expect_true_false_linter}
+\alias{expect_true_false_linter}
+\title{Require usage of expect_true(x) over expect_equal(x, TRUE)}
+\usage{
+expect_true_false_linter()
+}
+\description{
+\code{\link[testthat:logical-expectations]{testthat::expect_true()}} and \code{\link[testthat:logical-expectations]{testthat::expect_false()}} exist specifically
+for testing the \code{TRUE}/\code{FALSE} value of an object.
+\code{\link[testthat:equality-expectations]{testthat::expect_equal()}} and \code{\link[testthat:equality-expectations]{testthat::expect_identical()}} can also be
+used for such tests, but it is better to use the tailored function instead.
+}
+\seealso{
+\link{linters} for a complete list of linters available in lintr.
+}
+\section{Tags}{
+\link[=best_practices_linters]{best_practices}, \link[=package_development_linters]{package_development}, \link[=readability_linters]{readability}
+}
diff --git a/man/linters.Rd b/man/linters.Rd
index 6c3353f97..9c841c878 100644
--- a/man/linters.Rd
+++ b/man/linters.Rd
@@ -17,15 +17,15 @@ Documentation for linters is structured into tags to allow for easier discovery.
 \section{Tags}{
 The following tags exist:
 \itemize{
-\item{\link[=best_practices_linters]{best_practices} (13 linters)}
+\item{\link[=best_practices_linters]{best_practices} (14 linters)}
 \item{\link[=common_mistakes_linters]{common_mistakes} (5 linters)}
 \item{\link[=configurable_linters]{configurable} (16 linters)}
 \item{\link[=consistency_linters]{consistency} (7 linters)}
 \item{\link[=correctness_linters]{correctness} (7 linters)}
 \item{\link[=default_linters]{default} (25 linters)}
 \item{\link[=efficiency_linters]{efficiency} (4 linters)}
-\item{\link[=package_development_linters]{package_development} (5 linters)}
-\item{\link[=readability_linters]{readability} (22 linters)}
+\item{\link[=package_development_linters]{package_development} (6 linters)}
+\item{\link[=readability_linters]{readability} (23 linters)}
 \item{\link[=robustness_linters]{robustness} (10 linters)}
 \item{\link[=style_linters]{style} (32 linters)}
 }
@@ -45,6 +45,7 @@ The following linters exist:
 \item{\code{\link{equals_na_linter}} (tags: common_mistakes, correctness, default, robustness)}
 \item{\code{\link{expect_not_linter}} (tags: best_practices, package_development, readability)}
 \item{\code{\link{expect_null_linter}} (tags: best_practices, package_development)}
+\item{\code{\link{expect_true_false_linter}} (tags: best_practices, package_development, readability)}
 \item{\code{\link{expect_type_linter}} (tags: best_practices, package_development)}
 \item{\code{\link{extraction_operator_linter}} (tags: best_practices, style)}
 \item{\code{\link{function_left_parentheses_linter}} (tags: default, readability, style)}
diff --git a/man/package_development_linters.Rd b/man/package_development_linters.Rd
index 6fbc2e23b..e5a07cad7 100644
--- a/man/package_development_linters.Rd
+++ b/man/package_development_linters.Rd
@@ -15,6 +15,7 @@ The following linters are tagged with 'package_development':
 \item{\code{\link{backport_linter}}}
 \item{\code{\link{expect_not_linter}}}
 \item{\code{\link{expect_null_linter}}}
+\item{\code{\link{expect_true_false_linter}}}
 \item{\code{\link{expect_type_linter}}}
 \item{\code{\link{package_hooks_linter}}}
 }
diff --git a/man/readability_linters.Rd b/man/readability_linters.Rd
index 6795161e1..f5cab44f2 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{commented_code_linter}}}
 \item{\code{\link{cyclocomp_linter}}}
 \item{\code{\link{expect_not_linter}}}
+\item{\code{\link{expect_true_false_linter}}}
 \item{\code{\link{function_left_parentheses_linter}}}
 \item{\code{\link{infix_spaces_linter}}}
 \item{\code{\link{line_length_linter}}}
diff --git a/tests/testthat/test-expect_true_false_linter.R b/tests/testthat/test-expect_true_false_linter.R
new file mode 100644
index 000000000..46a9275f6
--- /dev/null
+++ b/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_true(x) is better than expect_equal(x, TRUE)"),
+    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()
+  )
+})

From 5a6e4d3fdd58d3aa4ce7137f7e529475f08d113e Mon Sep 17 00:00:00 2001
From: Michael Chirico <chiricom@google.com>
Date: Wed, 16 Mar 2022 02:28:55 +0000
Subject: [PATCH 2/3] fix lint in test suite

---
 tests/testthat/test-settings.R | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/tests/testthat/test-settings.R b/tests/testthat/test-settings.R
index 5a40e87d7..3d7d0b31a 100644
--- a/tests/testthat/test-settings.R
+++ b/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))

From fc0a0804c6646ce9677e87fa1a2871d42fee9abb Mon Sep 17 00:00:00 2001
From: Michael Chirico <chiricom@google.com>
Date: Wed, 16 Mar 2022 06:38:44 +0000
Subject: [PATCH 3/3] customize message to observed usage

---
 R/expect_true_false_linter.R                  | 27 ++++++++++---------
 .../testthat/test-expect_true_false_linter.R  |  2 +-
 2 files changed, 16 insertions(+), 13 deletions(-)

diff --git a/R/expect_true_false_linter.R b/R/expect_true_false_linter.R
index 4b7c84f45..2d5dd1d09 100644
--- a/R/expect_true_false_linter.R
+++ b/R/expect_true_false_linter.R
@@ -16,21 +16,24 @@ expect_true_false_linter <- function() {
 
     xml <- source_file$xml_parsed_content
 
-    xpath <- "//expr[
+    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,
-      xml_nodes_to_lint,
-      source_file = source_file,
-      message = paste(
-        "expect_true(x) is better than expect_equal(x, TRUE);",
-        "expect_false(x) is better than expect_equal(x, FALSE)."
-      ),
-      type = "warning"
-    ))
+    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")
+}
diff --git a/tests/testthat/test-expect_true_false_linter.R b/tests/testthat/test-expect_true_false_linter.R
index 46a9275f6..e0bee7e12 100644
--- a/tests/testthat/test-expect_true_false_linter.R
+++ b/tests/testthat/test-expect_true_false_linter.R
@@ -13,7 +13,7 @@ test_that("expect_true_false_linter blocks simple disallowed usages", {
   # expect_identical is treated the same as expect_equal
   expect_lint(
     "testthat::expect_identical(x, FALSE)",
-    rex::rex("expect_true(x) is better than expect_equal(x, TRUE)"),
+    rex::rex("expect_false(x) is better than expect_identical(x, FALSE)"),
     expect_true_false_linter()
   )