From 55c1acaefdd060290bccc729059f4c9ce4c78782 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Apr 2023 22:49:09 +0000 Subject: [PATCH 1/6] Rename no_tab_linter to whitespace_linter --- DESCRIPTION | 2 +- NAMESPACE | 1 + R/lintr-deprecated.R | 13 +++++++++ R/utils.R | 2 +- R/{no_tab_linter.R => whitespace_linter.R} | 19 +++++++------ R/zzz.R | 4 +-- inst/lintr/linters.csv | 3 +- man/consistency_linters.Rd | 1 + man/default_linters.Rd | 2 +- man/deprecated_linters.Rd | 1 + man/linters.Rd | 9 +++--- man/lintr-deprecated.Rd | 3 ++ man/style_linters.Rd | 1 + ...{no_tab_linter.Rd => whitespace_linter.Rd} | 24 +++++++++------- ..._tab_linter.R => test-whitespace_linter.R} | 28 +++++++++++++------ 15 files changed, 77 insertions(+), 36 deletions(-) rename R/{no_tab_linter.R => whitespace_linter.R} (55%) rename man/{no_tab_linter.Rd => whitespace_linter.Rd} (52%) rename tests/testthat/{test-no_tab_linter.R => test-whitespace_linter.R} (62%) diff --git a/DESCRIPTION b/DESCRIPTION index 2301435ba..dcaf4fa43 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -127,7 +127,6 @@ Collate: 'namespace.R' 'namespace_linter.R' 'nested_ifelse_linter.R' - 'no_tab_linter.R' 'nonportable_path_linter.R' 'numeric_leading_zero_linter.R' 'object_length_linter.R' @@ -169,6 +168,7 @@ Collate: 'unused_import_linter.R' 'use_lintr.R' 'vector_logic_linter.R' + 'whitespace_linter.R' 'with.R' 'with_id.R' 'xml_nodes_to_lints.R' diff --git a/NAMESPACE b/NAMESPACE index 157c3c467..e33eaf469 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -135,6 +135,7 @@ export(unreachable_code_linter) export(unused_import_linter) export(use_lintr) export(vector_logic_linter) +export(whitespace_linter) export(with_defaults) export(with_id) export(xml_nodes_to_lints) diff --git a/R/lintr-deprecated.R b/R/lintr-deprecated.R index 43662a198..60594f6e0 100644 --- a/R/lintr-deprecated.R +++ b/R/lintr-deprecated.R @@ -226,3 +226,16 @@ single_quotes_linter <- function() { ) quotes_linter() } + +#' No tabs linter +#' @rdname lintr-deprecated +#' @export +no_tab_linter <- function() { + lintr_deprecated( + old = "no_tab_linter", + new = "whitespace_linter", + version = "3.1.0", + type = "Linter" + ) + whitespace_linter() +} diff --git a/R/utils.R b/R/utils.R index ef6de0e77..05d010696 100644 --- a/R/utils.R +++ b/R/utils.R @@ -281,7 +281,7 @@ get_r_code <- function(xml) { #' #' [xml2::xml_text()] is deceptively close to obviating this helper, but it collapses #' text across lines. R is _mostly_ whitespace-agnostic, so this only matters in some edge cases, -#' in particular when there are comments within an expression ( node). See #1919. +#' in particular when there are comments within an expression (`` node). See #1919. #' #' @noRd xml2lang <- function(x) { diff --git a/R/no_tab_linter.R b/R/whitespace_linter.R similarity index 55% rename from R/no_tab_linter.R rename to R/whitespace_linter.R index 12afa302b..0fcb53d36 100644 --- a/R/no_tab_linter.R +++ b/R/whitespace_linter.R @@ -1,8 +1,11 @@ -#' No tab linter +#' Whitespace linter #' -#' Check that only spaces are used for indentation, not tabs. Much ink has been -#' spilled on this topic, and we encourage you to check out references for more -#' information. +#' Check that the correct character is used for indentation. +#' +#' Currently, only supports linting in the presence of tabs. +#' +#' Much ink has been spilled on this topic, and we encourage you to check +#' out references for more information. #' #' @include make_linter_from_regex.R #' @@ -10,23 +13,23 @@ #' # will produce lints #' lint( #' text = "\tx", -#' linters = no_tab_linter() +#' linters = whitespace_linter() #' ) #' #' # okay #' lint( #' text = " x", -#' linters = no_tab_linter() +#' linters = whitespace_linter() #' ) #' -#' @evalRd rd_tags("no_tab_linter") +#' @evalRd rd_tags("whitespace_linter") #' @seealso [linters] for a complete list of linters available in lintr. #' #' @references #' - https://www.jwz.org/doc/tabs-vs-spaces.html #' - https://blog.codinghorror.com/death-to-the-space-infidels/ #' @export -no_tab_linter <- make_linter_from_regex( +whitespace_linter <- make_linter_from_regex( regex = rex(start, zero_or_more(regex("\\s")), one_or_more("\t")), lint_type = "style", lint_msg = "Use spaces to indent, not tabs." diff --git a/R/zzz.R b/R/zzz.R index 4e312613b..8198a6477 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -23,7 +23,6 @@ default_linters <- modify_defaults( indentation_linter(), infix_spaces_linter(), line_length_linter(), - no_tab_linter(), object_length_linter(), object_name_linter(), object_usage_linter(), @@ -37,7 +36,8 @@ default_linters <- modify_defaults( T_and_F_symbol_linter(), trailing_blank_lines_linter(), trailing_whitespace_linter(), - vector_logic_linter() + vector_logic_linter(), + whitespace_linter() ) #' Default undesirable functions and operators diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 48d052cf7..592f79a6f 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -48,7 +48,7 @@ missing_argument_linter,correctness common_mistakes configurable missing_package_linter,robustness common_mistakes namespace_linter,correctness robustness configurable executing nested_ifelse_linter,efficiency readability -no_tab_linter,style consistency default +no_tab_linter,style consistency deprecated nonportable_path_linter,robustness best_practices configurable numeric_leading_zero_linter,style consistency readability object_length_linter,style readability default configurable executing @@ -92,4 +92,5 @@ unneeded_concatenation_linter,style readability efficiency configurable deprecat unreachable_code_linter,best_practices readability unused_import_linter,best_practices common_mistakes configurable executing vector_logic_linter,default efficiency best_practices +whitespace_linter,style consistency default yoda_test_linter,package_development best_practices readability diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 78fb5feca..c73bf873e 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -32,5 +32,6 @@ The following linters are tagged with 'consistency': \item{\code{\link{single_quotes_linter}}} \item{\code{\link{system_file_linter}}} \item{\code{\link{T_and_F_symbol_linter}}} +\item{\code{\link{whitespace_linter}}} } } diff --git a/man/default_linters.Rd b/man/default_linters.Rd index 0b1f9c3f2..fa1839fcd 100644 --- a/man/default_linters.Rd +++ b/man/default_linters.Rd @@ -35,7 +35,6 @@ The following linters are tagged with 'default': \item{\code{\link{indentation_linter}}} \item{\code{\link{infix_spaces_linter}}} \item{\code{\link{line_length_linter}}} -\item{\code{\link{no_tab_linter}}} \item{\code{\link{object_length_linter}}} \item{\code{\link{object_name_linter}}} \item{\code{\link{object_usage_linter}}} @@ -50,5 +49,6 @@ The following linters are tagged with 'default': \item{\code{\link{trailing_blank_lines_linter}}} \item{\code{\link{trailing_whitespace_linter}}} \item{\code{\link{vector_logic_linter}}} +\item{\code{\link{whitespace_linter}}} } } diff --git a/man/deprecated_linters.Rd b/man/deprecated_linters.Rd index ffedebb44..bc26e412e 100644 --- a/man/deprecated_linters.Rd +++ b/man/deprecated_linters.Rd @@ -14,6 +14,7 @@ These linters will be excluded from \code{linters_with_tags()} by default. The following linters are tagged with 'deprecated': \itemize{ \item{\code{\link{closed_curly_linter}}} +\item{\code{\link{no_tab_linter}}} \item{\code{\link{open_curly_linter}}} \item{\code{\link{paren_brace_linter}}} \item{\code{\link{semicolon_terminator_linter}}} diff --git a/man/linters.Rd b/man/linters.Rd index f041b945a..28ab1ede6 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -20,16 +20,16 @@ The following tags exist: \item{\link[=best_practices_linters]{best_practices} (50 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (7 linters)} \item{\link[=configurable_linters]{configurable} (33 linters)} -\item{\link[=consistency_linters]{consistency} (19 linters)} +\item{\link[=consistency_linters]{consistency} (20 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (25 linters)} -\item{\link[=deprecated_linters]{deprecated} (6 linters)} +\item{\link[=deprecated_linters]{deprecated} (7 linters)} \item{\link[=efficiency_linters]{efficiency} (24 linters)} \item{\link[=executing_linters]{executing} (5 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} \item{\link[=readability_linters]{readability} (53 linters)} \item{\link[=robustness_linters]{robustness} (14 linters)} -\item{\link[=style_linters]{style} (40 linters)} +\item{\link[=style_linters]{style} (41 linters)} } } \section{Linters}{ @@ -84,7 +84,7 @@ The following linters exist: \item{\code{\link{missing_package_linter}} (tags: common_mistakes, robustness)} \item{\code{\link{namespace_linter}} (tags: configurable, correctness, executing, robustness)} \item{\code{\link{nested_ifelse_linter}} (tags: efficiency, readability)} -\item{\code{\link{no_tab_linter}} (tags: consistency, default, style)} +\item{\code{\link{no_tab_linter}} (tags: consistency, deprecated, style)} \item{\code{\link{nonportable_path_linter}} (tags: best_practices, configurable, robustness)} \item{\code{\link{numeric_leading_zero_linter}} (tags: consistency, readability, style)} \item{\code{\link{object_length_linter}} (tags: configurable, default, executing, readability, style)} @@ -128,6 +128,7 @@ The following linters exist: \item{\code{\link{unreachable_code_linter}} (tags: best_practices, readability)} \item{\code{\link{unused_import_linter}} (tags: best_practices, common_mistakes, configurable, executing)} \item{\code{\link{vector_logic_linter}} (tags: best_practices, default, efficiency)} +\item{\code{\link{whitespace_linter}} (tags: consistency, default, style)} \item{\code{\link{yoda_test_linter}} (tags: best_practices, package_development, readability)} } } diff --git a/man/lintr-deprecated.Rd b/man/lintr-deprecated.Rd index 1c678ad86..ace13c0a2 100644 --- a/man/lintr-deprecated.Rd +++ b/man/lintr-deprecated.Rd @@ -8,6 +8,7 @@ \alias{semicolon_terminator_linter} \alias{unneeded_concatenation_linter} \alias{single_quotes_linter} +\alias{no_tab_linter} \title{Deprecated functions in lintr} \usage{ closed_curly_linter(allow_single_line = FALSE) @@ -21,6 +22,8 @@ semicolon_terminator_linter(semicolon = c("compound", "trailing")) unneeded_concatenation_linter(allow_single_expression = TRUE) single_quotes_linter() + +no_tab_linter() } \arguments{ \item{allow_single_line}{if \code{TRUE}, allow an open and closed curly pair on the same line.} diff --git a/man/style_linters.Rd b/man/style_linters.Rd index ca6bf6fc8..582a8fbe4 100644 --- a/man/style_linters.Rd +++ b/man/style_linters.Rd @@ -52,5 +52,6 @@ The following linters are tagged with 'style': \item{\code{\link{undesirable_operator_linter}}} \item{\code{\link{unnecessary_concatenation_linter}}} \item{\code{\link{unneeded_concatenation_linter}}} +\item{\code{\link{whitespace_linter}}} } } diff --git a/man/no_tab_linter.Rd b/man/whitespace_linter.Rd similarity index 52% rename from man/no_tab_linter.Rd rename to man/whitespace_linter.Rd index fd87c6e35..af1d36fe8 100644 --- a/man/no_tab_linter.Rd +++ b/man/whitespace_linter.Rd @@ -1,27 +1,31 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/no_tab_linter.R -\name{no_tab_linter} -\alias{no_tab_linter} -\title{No tab linter} +% Please edit documentation in R/whitespace_linter.R +\name{whitespace_linter} +\alias{whitespace_linter} +\title{Whitespace linter} \usage{ -no_tab_linter() +whitespace_linter() } \description{ -Check that only spaces are used for indentation, not tabs. Much ink has been -spilled on this topic, and we encourage you to check out references for more -information. +Check that the correct character is used for indentation. +} +\details{ +Currently, only supports linting in the presence of tabs. + +Much ink has been spilled on this topic, and we encourage you to check +out references for more information. } \examples{ # will produce lints lint( text = "\tx", - linters = no_tab_linter() + linters = whitespace_linter() ) # okay lint( text = " x", - linters = no_tab_linter() + linters = whitespace_linter() ) } diff --git a/tests/testthat/test-no_tab_linter.R b/tests/testthat/test-whitespace_linter.R similarity index 62% rename from tests/testthat/test-no_tab_linter.R rename to tests/testthat/test-whitespace_linter.R index 6ee85eaeb..9ddfc4eba 100644 --- a/tests/testthat/test-no_tab_linter.R +++ b/tests/testthat/test-whitespace_linter.R @@ -1,5 +1,5 @@ -test_that("no_tab_linter skips allowed usages", { - linter <- no_tab_linter() +test_that("whitespace_linter skips allowed usages", { + linter <- whitespace_linter() expect_lint("blah", NULL, linter) expect_lint(" blah", NULL, linter) @@ -7,8 +7,8 @@ test_that("no_tab_linter skips allowed usages", { expect_lint("#\tblah", NULL, linter) }) -test_that("no_tab_linter skips allowed tab usages inside strings", { - linter <- no_tab_linter() +test_that("whitespace_linter skips allowed tab usages inside strings", { + linter <- whitespace_linter() expect_lint( 'lint_msg <- "dont flag tabs if\tthey are inside a string."', @@ -23,8 +23,8 @@ test_that("no_tab_linter skips allowed tab usages inside strings", { ) }) -test_that("no_tab_linter blocks disallowed usages", { - linter <- no_tab_linter() +test_that("whitespace_linter blocks disallowed usages", { + linter <- whitespace_linter() lint_msg <- rex::rex("Use spaces to indent, not tabs.") expect_lint( @@ -40,10 +40,10 @@ test_that("no_tab_linter blocks disallowed usages", { ) }) -test_that("no_tab_linter blocks disallowed usages with a pipe", { +test_that("whitespace_linter blocks disallowed usages with a pipe", { skip_if_not_r_version("4.1.0") - linter <- no_tab_linter() + linter <- whitespace_linter() lint_msg <- rex::rex("Use spaces to indent, not tabs.") expect_lint( @@ -58,3 +58,15 @@ test_that("no_tab_linter blocks disallowed usages with a pipe", { linter ) }) + +test_that("no_tab_linter id deprecated", { + expect_warning( + { + old_linter <- no_tab_linter() + }, + "Use whitespace_linter instead", + fixed = TRUE + ) + expect_lint(" a b c", NULL, old_linter) + expect_lint("\ta\tb\tc", "not tabs", old_linter) +}) From ed1aa0e39faa86fd4f39a7065e55aa92c1c0bdec Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Apr 2023 22:53:47 +0000 Subject: [PATCH 2/6] NEWS --- NEWS.md | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/NEWS.md b/NEWS.md index 16c0916fa..d9bb75a35 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,7 @@ * `single_quotes_linter()` is deprecated in favor of the more generalizable `quotes_linter()` (#1729, @MichaelChirico). * `unneeded_concatentation_linter()` is deprecated in favor of `unnecessary_concatenation_linter()` for naming consistency (#1707, @IndrajeetPatil). * `consecutive_stopifnot_linter()` is deprecated in favor of the more general (see below) `consecutive_assertion_linter()` (#1604, @MichaelChirico). +* `no_tab_linter()` is deprecated in favor of `whitespace_linter()` for naming consistency and future generalization (#1954, @MichaelChirico). ## Bug fixes @@ -65,6 +66,7 @@ + `indentation_linter()` + `quotes_linter()` + `unnecessary_concatenation_linter()` + + `whitespace_linter()` ## New and improved features @@ -152,6 +154,8 @@ * `consecutive_assertion_linter()` (f.k.a. `consecutive_stopifnot_linter()`) now lints for consecutive calls to `assertthat::assert_that()` (as long as the `msg=` argument is not used; #1604, @MichaelChirico). +* `whitespace_linter()` is simply `no_tab_linter()`, renamed. In the future, we plan to extend it to work for different whitespace preferences. + ## Notes * {lintr} now depends on R version 3.5.0, in line with the tidyverse policy for R version compatibility. From 339664d86ba9a85023577f67d6624d5cadb541d6 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Apr 2023 23:24:29 +0000 Subject: [PATCH 3/6] syntax error in test --- tests/testthat/test-whitespace_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-whitespace_linter.R b/tests/testthat/test-whitespace_linter.R index 9ddfc4eba..2ef50aea7 100644 --- a/tests/testthat/test-whitespace_linter.R +++ b/tests/testthat/test-whitespace_linter.R @@ -67,6 +67,6 @@ test_that("no_tab_linter id deprecated", { "Use whitespace_linter instead", fixed = TRUE ) - expect_lint(" a b c", NULL, old_linter) + expect_lint(" f(a, b, c)", NULL, old_linter) expect_lint("\ta\tb\tc", "not tabs", old_linter) }) From 822b0bc3b24d9a1761ae7f9fdbc33f57daceecd6 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Apr 2023 23:43:16 +0000 Subject: [PATCH 4/6] rename other references to no_tab_linter --- tests/testthat/test-expect_lint.R | 4 ++-- tests/testthat/test-with.R | 12 ++++++------ vignettes/lintr.Rmd | 4 ++-- 3 files changed, 10 insertions(+), 10 deletions(-) diff --git a/tests/testthat/test-expect_lint.R b/tests/testthat/test-expect_lint.R index 10517b3d3..075711167 100644 --- a/tests/testthat/test-expect_lint.R +++ b/tests/testthat/test-expect_lint.R @@ -26,7 +26,7 @@ test_that("single check", { expect_error(expect_lint("a=1", c(message = lint_msg, lineXXX = 1L), linter), "invalid field") expect_failure(expect_lint("foo ()", list(ranges = list(c(2L, 2L))), function_left_parentheses_linter())) - expect_success(expect_lint("\t1", list(ranges = list(c(1L, 1L))), no_tab_linter())) + expect_success(expect_lint("\t1", list(ranges = list(c(1L, 1L))), whitespace_linter())) expect_success(expect_lint("a=1", list(message = lint_msg, line_number = 1L), linter)) expect_failure(expect_lint("a=1", list(2L, lint_msg), linter)) @@ -48,7 +48,7 @@ test_that("multiple checks", { expect_success(expect_lint("a=1; b=2", list(list(line_number = 1L), list(line_number = 2L)), linter)) expect_failure(expect_lint("a=1; b=2", list(list(line_number = 2L), list(line_number = 2L)), linter)) expect_success( - expect_lint("\t1\n\t2", list("tabs", list(column_number = 1L, ranges = list(c(1L, 1L)))), no_tab_linter()) + expect_lint("\t1\n\t2", list("tabs", list(column_number = 1L, ranges = list(c(1L, 1L)))), whitespace_linter()) ) }) diff --git a/tests/testthat/test-with.R b/tests/testthat/test-with.R index d9ab3896f..b5beb473c 100644 --- a/tests/testthat/test-with.R +++ b/tests/testthat/test-with.R @@ -76,10 +76,10 @@ test_that("with_defaults is supported with a deprecation warning", { expect_identical(defaults, old_defaults) # linters_with_defaults only accepts `defaults = list()` to start from blank - defaults <- linters_with_defaults(defaults = list(), no_tab_linter()) + defaults <- linters_with_defaults(defaults = list(), whitespace_linter()) expect_warning( { - old_defaults <- with_defaults(default = NULL, no_tab_linter()) + old_defaults <- with_defaults(default = NULL, whitespace_linter()) }, rex::rex("Use linters_with_defaults or modify_defaults instead.") ) @@ -99,17 +99,17 @@ test_that("modify_defaults works", { test_that("linters_with_defaults(default = .) is supported with a deprecation warning", { expect_warning( { - linters <- linters_with_defaults(default = list(), no_tab_linter()) + linters <- linters_with_defaults(default = list(), whitespace_linter()) }, "'default'" ) - expect_named(linters, "no_tab_linter") + expect_named(linters, "whitespace_linter") # the same warning is not triggered in modify_defaults expect_silent({ - linters <- modify_defaults(defaults = list(), default = list(), no_tab_linter()) + linters <- modify_defaults(defaults = list(), default = list(), whitespace_linter()) }) - expect_named(linters, c("default", "no_tab_linter")) + expect_named(linters, c("default", "whitespace_linter")) # if default= is explicitly provided alongside defaults=, assume that was intentional default <- Linter(function(.) list()) diff --git a/vignettes/lintr.Rmd b/vignettes/lintr.Rmd index a413433bb..aecb36d70 100644 --- a/vignettes/lintr.Rmd +++ b/vignettes/lintr.Rmd @@ -151,12 +151,12 @@ If an Encoding is found in a `.Rproj` file or a `DESCRIPTION` file, that encodin If you only want to customize some linters, you can use the helper function `linters_with_defaults()`, which will keep all unnamed linters with the default settings. Disable a linter by passing `NULL`. -For example, to set the line length limit to 120 characters and globally disable the `no_tab_linter`, you can put this into your `.lintr`: +For example, to set the line length limit to 120 characters and globally disable the `whitespace_linter()`, you can put this into your `.lintr`: ``` r linters: linters_with_defaults( line_length_linter = line_length_linter(120L), - no_tab_linter = NULL + whitespace_linter = NULL ) ``` From 2e0b0da8ddcecf5cea4e25bf19d9b02b62ee9827 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 7 Apr 2023 23:52:03 +0000 Subject: [PATCH 5/6] syntax in one more test --- tests/testthat/test-whitespace_linter.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-whitespace_linter.R b/tests/testthat/test-whitespace_linter.R index 2ef50aea7..61b01f8d2 100644 --- a/tests/testthat/test-whitespace_linter.R +++ b/tests/testthat/test-whitespace_linter.R @@ -68,5 +68,5 @@ test_that("no_tab_linter id deprecated", { fixed = TRUE ) expect_lint(" f(a, b, c)", NULL, old_linter) - expect_lint("\ta\tb\tc", "not tabs", old_linter) + expect_lint("\tf(a, b, c)", "not tabs", old_linter) }) From 34efc8ab4a1193ae321348c70755a7720f16e9d1 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 8 Apr 2023 00:06:38 +0000 Subject: [PATCH 6/6] trailing blank line --- R/lintr-deprecated.R | 1 - 1 file changed, 1 deletion(-) diff --git a/R/lintr-deprecated.R b/R/lintr-deprecated.R index 50729ea31..27f3a4383 100644 --- a/R/lintr-deprecated.R +++ b/R/lintr-deprecated.R @@ -252,4 +252,3 @@ no_tab_linter <- function() { ) whitespace_linter() } -