From 7b5a4f4268e2054aaa95d533d29db2f10dd0e801 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 3 Mar 2025 23:56:01 +0000 Subject: [PATCH 1/3] pipe-aware linting --- NEWS.md | 1 + R/expect_true_false_linter.R | 10 +++++--- .../testthat/test-expect_true_false_linter.R | 24 ++++++++++--------- 3 files changed, 21 insertions(+), 14 deletions(-) diff --git a/NEWS.md b/NEWS.md index 7092889262..d4e5144fc3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -43,6 +43,7 @@ * `return_linter()` works on functions that happen to use braced expressions in their formals (#2616, @MichaelChirico). * `object_name_linter()` and `object_length_linter()` account for S3 class correctly when the generic is assigned with `=` (#2507, @MichaelChirico). * `assignment_linter()` with `operator = "="` does a better job of skipping implicit assignments, which are intended to be governed by `implicit_assignment_linter()` (#2765, @MichaelChirico). +* `expect_true_false_linter()` is pipe-aware, so that `42 |> expect_identical(x, ignore_attr = TRUE)` no longer lints (#1520, @MichaelChirico). ## Notes diff --git a/R/expect_true_false_linter.R b/R/expect_true_false_linter.R index bf540c0c80..af6234770e 100644 --- a/R/expect_true_false_linter.R +++ b/R/expect_true_false_linter.R @@ -32,10 +32,14 @@ #' @seealso [linters] for a complete list of linters available in lintr. #' @export expect_true_false_linter <- function() { - xpath <- " - following-sibling::expr[position() <= 2 and NUM_CONST[text() = 'TRUE' or text() = 'FALSE']] + pipe_cond <- glue("parent::expr/parent::expr[PIPE or SPECIAL[{xp_text_in_table(magrittr_pipes)}]]") + xpath <- glue(" + following-sibling::expr[ + NUM_CONST[text() = 'TRUE' or text() = 'FALSE'] + and position() <= 2 - count({pipe_cond}) + ] /parent::expr - " + ") Linter(linter_level = "expression", function(source_expression) { xml_calls <- source_expression$xml_find_function_calls(c("expect_equal", "expect_identical")) diff --git a/tests/testthat/test-expect_true_false_linter.R b/tests/testthat/test-expect_true_false_linter.R index 76ed5c42c5..b245575441 100644 --- a/tests/testthat/test-expect_true_false_linter.R +++ b/tests/testthat/test-expect_true_false_linter.R @@ -1,16 +1,19 @@ test_that("expect_true_false_linter skips allowed usages", { + linter <- expect_true_false_linter() # 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()) + expect_no_lint("expect_equal(x, c(TRUE, FALSE))", linter) + + expect_no_lint("expect_equal(x, y, ignore_attr = TRUE)") + + expect_no_lint("42 |> expect_identical(42, ignore_attr = TRUE)", linter) + expect_no_lint("42 %>% expect_identical(42, ignore_attr = TRUE)", linter) }) test_that("expect_true_false_linter blocks simple disallowed usages", { linter <- expect_true_false_linter() + lint_msg <- rex::rex("expect_true(x) is better than expect_equal(x, TRUE)") - expect_lint( - "expect_equal(foo(x), TRUE)", - rex::rex("expect_true(x) is better than expect_equal(x, TRUE)"), - linter - ) + expect_lint("expect_equal(foo(x), TRUE)", lint_msg, linter) # expect_identical is treated the same as expect_equal expect_lint( @@ -20,11 +23,10 @@ test_that("expect_true_false_linter blocks simple disallowed usages", { ) # 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)"), - linter - ) + expect_lint("expect_equal(TRUE, foo(x))", lint_msg, linter) + + expect_lint("42 |> expect_equal(TRUE)", lint_msg, linter) + expect_lint("42 %T>% expect_equal(TRUE)", lint_msg, linter) }) test_that("lints vectorize", { From ff0dbb376f97d6c0918994f19192ae04b8963da7 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Tue, 4 Mar 2025 00:20:56 +0000 Subject: [PATCH 2/3] skip on old R --- tests/testthat/test-expect_true_false_linter.R | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/tests/testthat/test-expect_true_false_linter.R b/tests/testthat/test-expect_true_false_linter.R index b245575441..fa1ddf1508 100644 --- a/tests/testthat/test-expect_true_false_linter.R +++ b/tests/testthat/test-expect_true_false_linter.R @@ -5,8 +5,10 @@ test_that("expect_true_false_linter skips allowed usages", { expect_no_lint("expect_equal(x, y, ignore_attr = TRUE)") - expect_no_lint("42 |> expect_identical(42, ignore_attr = TRUE)", linter) expect_no_lint("42 %>% expect_identical(42, ignore_attr = TRUE)", linter) + + skip_if_not_r_version("4.1.0") + expect_no_lint("42 |> expect_identical(42, ignore_attr = TRUE)", linter) }) test_that("expect_true_false_linter blocks simple disallowed usages", { @@ -25,8 +27,10 @@ test_that("expect_true_false_linter blocks simple disallowed usages", { # also caught when TRUE/FALSE is the first argument expect_lint("expect_equal(TRUE, foo(x))", lint_msg, linter) - expect_lint("42 |> expect_equal(TRUE)", lint_msg, linter) expect_lint("42 %T>% expect_equal(TRUE)", lint_msg, linter) + + skip_if_not_r_version("4.1.0") + expect_lint("42 |> expect_equal(TRUE)", lint_msg, linter) }) test_that("lints vectorize", { From 2fad41eaaa4b4da22b48de4f99a9b3c649bd7795 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 3 Mar 2025 23:28:10 -0800 Subject: [PATCH 3/3] extra test without kwarg --- tests/testthat/test-expect_true_false_linter.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-expect_true_false_linter.R b/tests/testthat/test-expect_true_false_linter.R index fa1ddf1508..8afc0edfb2 100644 --- a/tests/testthat/test-expect_true_false_linter.R +++ b/tests/testthat/test-expect_true_false_linter.R @@ -6,6 +6,7 @@ test_that("expect_true_false_linter skips allowed usages", { expect_no_lint("expect_equal(x, y, ignore_attr = TRUE)") expect_no_lint("42 %>% expect_identical(42, ignore_attr = TRUE)", linter) + expect_no_lint("42 %>% expect_identical(42, TRUE)", linter) skip_if_not_r_version("4.1.0") expect_no_lint("42 |> expect_identical(42, ignore_attr = TRUE)", linter)