From 930e740841e4f0f5ead32a61bc71bac6781154e8 Mon Sep 17 00:00:00 2001 From: yandere-sliver Date: Thu, 23 May 2024 14:59:55 +0200 Subject: [PATCH 1/7] Add expect_no_lint --- NAMESPACE | 1 + R/expect_lint.R | 12 ++++++++++-- man/expect_lint.Rd | 7 ++++++- 3 files changed, 17 insertions(+), 3 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index b31ed1b49..1b2702104 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -57,6 +57,7 @@ export(expect_length_linter) export(expect_lint) export(expect_lint_free) export(expect_named_linter) +export(expect_no_lint) export(expect_not_linter) export(expect_null_linter) export(expect_s3_class_linter) diff --git a/R/expect_lint.R b/R/expect_lint.R index feb2164ef..c98a9a638 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -1,6 +1,7 @@ #' Lint expectation #' -#' This is an expectation function to test that the lints produced by `lint` satisfy a number of checks. +#' These are expectation function to test that the lints produced by `lint` satisfy a number of checks. +#' `expect_no_lint` is equivalent to `expect_lint` with checks set to NULL. #' #' @param content a character vector for the file content to be linted, each vector element representing a line of #' text. @@ -23,6 +24,7 @@ #' @examples #' # no expected lint #' expect_lint("a", NULL, trailing_blank_lines_linter()) +#' expect_no_lint("a", trailing_blank_lines_linter()) #' #' # one expected lint #' expect_lint("a\n", "trailing blank", trailing_blank_lines_linter()) @@ -42,7 +44,8 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { if (!requireNamespace("testthat", quietly = TRUE)) { stop( # nocov start - "'expect_lint' is designed to work within the 'testthat' testing framework, but 'testthat' is not installed.", + "'expect_lint' and 'expect_no_lint' are designed to work within the 'testthat' testing framework, ", + "but 'testthat' is not installed.", call. = FALSE ) # nocov end } @@ -123,6 +126,11 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") { invisible(NULL) } +#' @rdname expect_lint +#' @export +expect_no_lint <- function(content, ..., file = NULL, language = "en") { + expect_lint(content, NULL, ..., file = file, language = language) +} #' Test that the package is lint free #' diff --git a/man/expect_lint.Rd b/man/expect_lint.Rd index 8b7a22fc1..12c436dc4 100644 --- a/man/expect_lint.Rd +++ b/man/expect_lint.Rd @@ -2,9 +2,12 @@ % Please edit documentation in R/expect_lint.R \name{expect_lint} \alias{expect_lint} +\alias{expect_no_lint} \title{Lint expectation} \usage{ expect_lint(content, checks, ..., file = NULL, language = "en") + +expect_no_lint(content, ..., file = NULL, language = "en") } \arguments{ \item{content}{a character vector for the file content to be linted, each vector element representing a line of @@ -33,11 +36,13 @@ This makes testing them reproducible on all systems irrespective of their native \code{NULL}, invisibly. } \description{ -This is an expectation function to test that the lints produced by \code{lint} satisfy a number of checks. +These are expectation function to test that the lints produced by \code{lint} satisfy a number of checks. +\code{expect_no_lint} is equivalent to \code{expect_lint} with checks set to NULL. } \examples{ # no expected lint expect_lint("a", NULL, trailing_blank_lines_linter()) +expect_no_lint("a", trailing_blank_lines_linter()) # one expected lint expect_lint("a\n", "trailing blank", trailing_blank_lines_linter()) From 7d22b858465b0a70d846e5662dc5f37e444cf18e Mon Sep 17 00:00:00 2001 From: yandere-sliver Date: Thu, 23 May 2024 15:12:21 +0200 Subject: [PATCH 2/7] Add tests for no_lint --- R/expect_lint.R | 2 +- tests/testthat/test-expect_lint.R | 3 +++ 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index c98a9a638..f27098cb8 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -1,6 +1,6 @@ #' Lint expectation #' -#' These are expectation function to test that the lints produced by `lint` satisfy a number of checks. +#' These are expectation function to test that the lints produced by `lint` satisfy a number of checks. #' `expect_no_lint` is equivalent to `expect_lint` with checks set to NULL. #' #' @param content a character vector for the file content to be linted, each vector element representing a line of diff --git a/tests/testthat/test-expect_lint.R b/tests/testthat/test-expect_lint.R index 622882884..d41930f4d 100644 --- a/tests/testthat/test-expect_lint.R +++ b/tests/testthat/test-expect_lint.R @@ -9,6 +9,9 @@ test_that("no checks", { expect_success(expect_lint("a", NULL, linter)) expect_success(expect_lint("a=1", NULL, list())) expect_failure(expect_lint("a=1", NULL, linter)) + expect_success(expect_no_lint("a", linter)) + expect_success(expect_no_lint("a=1", list())) + expect_failure(expect_no_lint("a=1", linter)) }) test_that("single check", { From 3a6a33cabd4d0e41724b595ce069fb843b58f6b1 Mon Sep 17 00:00:00 2001 From: F-Noelle Date: Thu, 23 May 2024 22:18:05 +0200 Subject: [PATCH 3/7] Update NEWS.md --- NEWS.md | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 333fc6396..139779483 100644 --- a/NEWS.md +++ b/NEWS.md @@ -54,7 +54,8 @@ * `vector_logic_linter()` is extended to recognize incorrect usage of scalar operators `&&` and `||` inside subsetting expressions like `dplyr::filter(x, A && B)` (#2166, @MichaelChirico). * `any_is_na_linter()` is extended to catch the unusual usage `NA %in% x` (#2113, @MichaelChirico). * `make_linter_from_xpath()` errors up front when `lint_message` is missing (instead of delaying this error until the linter is used, #2541, @MichaelChirico). -* `paste_linter()` is extended to recommend using `paste()` instead of `paste0()` for simply aggregating a character vector with `collapse=`, i.e., when `sep=` is irrelevant (#1108, @MichaelChirico). +* `paste_linter()` is extended to recommend using `paste()` instead of `paste0()` for simply aggregating a character vector with `collapse=`, i.e., when `sep=` is irrelevant (#1108, @MichaelChirico). +* `expect_no_lint()` was added as new function to cover the typical use case of expecting no lint message (#2580, @F-Noelle). ### New linters From 03c64697bf3c5f44cc79ec3cc345ee712cd6d564 Mon Sep 17 00:00:00 2001 From: yandere-sliver Date: Sat, 25 May 2024 13:58:06 +0200 Subject: [PATCH 4/7] Remove undisired cases from test and examples --- R/expect_lint.R | 1 - man/expect_lint.Rd | 1 - tests/testthat/test-expect_lint.R | 3 --- 3 files changed, 5 deletions(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index f27098cb8..4199c5d11 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -23,7 +23,6 @@ #' @return `NULL`, invisibly. #' @examples #' # no expected lint -#' expect_lint("a", NULL, trailing_blank_lines_linter()) #' expect_no_lint("a", trailing_blank_lines_linter()) #' #' # one expected lint diff --git a/man/expect_lint.Rd b/man/expect_lint.Rd index 12c436dc4..375b4d48a 100644 --- a/man/expect_lint.Rd +++ b/man/expect_lint.Rd @@ -41,7 +41,6 @@ These are expectation function to test that the lints produced by \code{lint} sa } \examples{ # no expected lint -expect_lint("a", NULL, trailing_blank_lines_linter()) expect_no_lint("a", trailing_blank_lines_linter()) # one expected lint diff --git a/tests/testthat/test-expect_lint.R b/tests/testthat/test-expect_lint.R index d41930f4d..00bf44bc6 100644 --- a/tests/testthat/test-expect_lint.R +++ b/tests/testthat/test-expect_lint.R @@ -6,9 +6,6 @@ linter <- assignment_linter() lint_msg <- "Use <-, not =" test_that("no checks", { - expect_success(expect_lint("a", NULL, linter)) - expect_success(expect_lint("a=1", NULL, list())) - expect_failure(expect_lint("a=1", NULL, linter)) expect_success(expect_no_lint("a", linter)) expect_success(expect_no_lint("a=1", list())) expect_failure(expect_no_lint("a=1", linter)) From f1e0972c73522357477d9ae05a1f2f6c0bdc54fa Mon Sep 17 00:00:00 2001 From: yandere-sliver Date: Sat, 25 May 2024 21:04:47 +0200 Subject: [PATCH 5/7] Update vignette --- vignettes/creating_linters.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/creating_linters.Rmd b/vignettes/creating_linters.Rmd index d4025848e..7301ff680 100644 --- a/vignettes/creating_linters.Rmd +++ b/vignettes/creating_linters.Rmd @@ -217,7 +217,7 @@ The main three aspects to test are: 1. Linter returns no lints when there is nothing to lint, e.g. ```r -expect_lint("blah", NULL, assignment_linter()) +expect_no_lint("blah", assignment_linter()) ``` 2. Linter returns a lint when there is something to lint, e.g. From 93a9561fd68e45038bb31880df9aefc9b28c744f Mon Sep 17 00:00:00 2001 From: yandere-sliver Date: Sat, 25 May 2024 21:35:20 +0200 Subject: [PATCH 6/7] Add expect_lint description --- R/expect_lint.R | 5 +++-- man/expect_lint.Rd | 7 +++++-- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/R/expect_lint.R b/R/expect_lint.R index 4199c5d11..c0c9915ae 100644 --- a/R/expect_lint.R +++ b/R/expect_lint.R @@ -1,7 +1,8 @@ #' Lint expectation #' -#' These are expectation function to test that the lints produced by `lint` satisfy a number of checks. -#' `expect_no_lint` is equivalent to `expect_lint` with checks set to NULL. +#' These are expectation functions to test specified linters on sample code in the `testthat` testing framework. +#' * `expect_lint` asserts that specified lints are generated. +#' * `expect_no_lint` asserts that no lints are generated. #' #' @param content a character vector for the file content to be linted, each vector element representing a line of #' text. diff --git a/man/expect_lint.Rd b/man/expect_lint.Rd index 375b4d48a..943cfd1a2 100644 --- a/man/expect_lint.Rd +++ b/man/expect_lint.Rd @@ -36,8 +36,11 @@ This makes testing them reproducible on all systems irrespective of their native \code{NULL}, invisibly. } \description{ -These are expectation function to test that the lints produced by \code{lint} satisfy a number of checks. -\code{expect_no_lint} is equivalent to \code{expect_lint} with checks set to NULL. +These are expectation functions to test specified linters on sample code in the \code{testthat} testing framework. +\itemize{ +\item \code{expect_lint} asserts that specified lints are generated. +\item \code{expect_no_lint} asserts that no lints are generated. +} } \examples{ # no expected lint From f6cdd8b211894c30591ec221130d679880eadfd6 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 27 May 2024 11:17:14 -0700 Subject: [PATCH 7/7] fine-tune NEWS --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 139779483..77ace633f 100644 --- a/NEWS.md +++ b/NEWS.md @@ -55,7 +55,7 @@ * `any_is_na_linter()` is extended to catch the unusual usage `NA %in% x` (#2113, @MichaelChirico). * `make_linter_from_xpath()` errors up front when `lint_message` is missing (instead of delaying this error until the linter is used, #2541, @MichaelChirico). * `paste_linter()` is extended to recommend using `paste()` instead of `paste0()` for simply aggregating a character vector with `collapse=`, i.e., when `sep=` is irrelevant (#1108, @MichaelChirico). -* `expect_no_lint()` was added as new function to cover the typical use case of expecting no lint message (#2580, @F-Noelle). +* `expect_no_lint()` was added as new function to cover the typical use case of expecting no lint message, akin to the recent {testthat} functions like `expect_no_warning()` (#2580, @F-Noelle). ### New linters