From 4328f19c736d5135bb5d0775b7145f0c72be9080 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Fri, 25 Mar 2022 22:31:09 +0000 Subject: [PATCH 1/7] New stop_paste_linter --- DESCRIPTION | 1 + NAMESPACE | 1 + NEWS.md | 1 + R/stop_paste_linter.R | 52 ++++++++++++++++++++++++ inst/lintr/linters.csv | 1 + man/best_practices_linters.Rd | 1 + man/consistency_linters.Rd | 1 + man/linters.Rd | 5 ++- man/stop_paste_linter.Rd | 18 +++++++++ tests/testthat/test-stop_paste_linter.R | 54 +++++++++++++++++++++++++ 10 files changed, 133 insertions(+), 2 deletions(-) create mode 100644 R/stop_paste_linter.R create mode 100644 man/stop_paste_linter.Rd create mode 100644 tests/testthat/test-stop_paste_linter.R diff --git a/DESCRIPTION b/DESCRIPTION index c6ef4b59d..9ec76e53b 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -114,6 +114,7 @@ Collate: 'spaces_inside_linter.R' 'spaces_left_parentheses_linter.R' 'sprintf_linter.R' + 'stop_paste_linter.R' 'trailing_blank_lines_linter.R' 'trailing_whitespace_linter.R' 'tree-utils.R' diff --git a/NAMESPACE b/NAMESPACE index d040f4a69..83f7eb671 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -78,6 +78,7 @@ export(single_quotes_linter) export(spaces_inside_linter) export(spaces_left_parentheses_linter) export(sprintf_linter) +export(stop_paste_linter) export(todo_comment_linter) export(trailing_blank_lines_linter) export(trailing_whitespace_linter) diff --git a/NEWS.md b/NEWS.md index 00030b22a..4f82de3a9 100644 --- a/NEWS.md +++ b/NEWS.md @@ -105,6 +105,7 @@ function calls. (#850, #851, @renkun-ken) * `numeric_leading_zero_linter()` Require a leading `0` in fractional numeric constants, e.g. `0.1` instead of `.1` * `paste_sep_linter()` Require usage of `paste0()` over `paste(sep = "")` * `nested_ifelse_linter()` Prevent nested calls to `ifelse()` like `ifelse(A, x, ifelse(B, y, z))`, and similar + * `stop_paste_linter` Prevent error messages (and similar) from being constructed like `stop(paste(...))` (where just `stop(...)` is preferable) * `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) * `infix_spaces_linter()` gains argument `exclude_operators` to disable lints on selected infix operators. By default, all "low-precedence" operators throw lints; see `?infix_spaces_linter` for an enumeration of these. (#914 @michaelchirico) * `infix_spaces_linter()` now throws a lint on `a~b` and `function(a=1) {}` (#930, @michaelchirico) diff --git a/R/stop_paste_linter.R b/R/stop_paste_linter.R new file mode 100644 index 000000000..fd74704be --- /dev/null +++ b/R/stop_paste_linter.R @@ -0,0 +1,52 @@ +#' Block usage of paste() and paste0() with messaging functions using ... +#' +#' `stop(paste0(...))` is strictly redundant -- `stop(...)` is equivalent. +#' `stop(...)` is also preferable to `stop(paste(...))`. +#' +#' @evalRd rd_tags("stop_paste_linter") +#' @seealso [linters] for a complete list of linters available in lintr. +#' @export +stop_paste_linter <- function() { + Linter(function(source_file) { + if (length(source_file$xml_parsed_content) == 0L) { + return(list()) + } + + xml <- source_file$xml_parsed_content + + translators <- c("packageStartupMessage", "message", "warning", "stop") + xpath <- glue::glue("//expr[ + expr[SYMBOL_FUNCTION_CALL[ {xp_text_in_table(translators)} ]] + and expr[ + expr[SYMBOL_FUNCTION_CALL[text() = 'paste' or text() = 'paste0']] + and not(SYMBOL_SUB[ + text() = 'collapse' + or ( + text() = 'sep' + and not(following-sibling::expr[1][STR_CONST[text() = '\"\"' or text() = '\" \"']]) + ) + ]) + ] + ]") + + bad_expr <- xml2::xml_find_all(xml, xpath) + + return(lapply( + bad_expr, + xml_nodes_to_lint, + source_file = source_file, + lint_message = function(expr) { + outer_call <- xml2::xml_text(xml2::xml_find_first(expr, "expr/SYMBOL_FUNCTION_CALL")) + inner_call <- xml2::xml_text(xml2::xml_find_first(expr, "expr/expr/SYMBOL_FUNCTION_CALL")) + + message <- sprintf("Don't use %s to build %s strings.", inner_call, outer_call) + paste( + message, + "Instead use the fact that these functions build strings from their input", + '(using "" as a separator). For translateable strings, prefer using gettextf().' + ) + }, + type = "warning" + )) + }) +} diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 7f7b411a8..45e081f24 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -51,6 +51,7 @@ single_quotes_linter,style consistency readability default spaces_inside_linter,style readability default spaces_left_parentheses_linter,style readability default sprintf_linter,correctness common_mistakes +stop_paste_linter,best_practices consistency T_and_F_symbol_linter,style readability robustness consistency best_practices default todo_comment_linter,style configurable trailing_blank_lines_linter,style default diff --git a/man/best_practices_linters.Rd b/man/best_practices_linters.Rd index 6f04346c0..dc3575053 100644 --- a/man/best_practices_linters.Rd +++ b/man/best_practices_linters.Rd @@ -33,6 +33,7 @@ The following linters are tagged with 'best_practices': \item{\code{\link{outer_negation_linter}}} \item{\code{\link{paste_sep_linter}}} \item{\code{\link{seq_linter}}} +\item{\code{\link{stop_paste_linter}}} \item{\code{\link{T_and_F_symbol_linter}}} \item{\code{\link{undesirable_function_linter}}} \item{\code{\link{undesirable_operator_linter}}} diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 4b47d38cd..677c9582c 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -22,6 +22,7 @@ The following linters are tagged with 'consistency': \item{\code{\link{paste_sep_linter}}} \item{\code{\link{seq_linter}}} \item{\code{\link{single_quotes_linter}}} +\item{\code{\link{stop_paste_linter}}} \item{\code{\link{T_and_F_symbol_linter}}} } } diff --git a/man/linters.Rd b/man/linters.Rd index 86641f2cd..08cb65472 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -17,10 +17,10 @@ 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} (24 linters)} +\item{\link[=best_practices_linters]{best_practices} (26 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (5 linters)} \item{\link[=configurable_linters]{configurable} (16 linters)} -\item{\link[=consistency_linters]{consistency} (9 linters)} +\item{\link[=consistency_linters]{consistency} (11 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (27 linters)} \item{\link[=efficiency_linters]{efficiency} (8 linters)} @@ -85,6 +85,7 @@ The following linters exist: \item{\code{\link{spaces_inside_linter}} (tags: default, readability, style)} \item{\code{\link{spaces_left_parentheses_linter}} (tags: default, readability, style)} \item{\code{\link{sprintf_linter}} (tags: common_mistakes, correctness)} +\item{\code{\link{stop_paste_linter}} (tags: best_practices, consistency)} \item{\code{\link{T_and_F_symbol_linter}} (tags: best_practices, consistency, default, readability, robustness, style)} \item{\code{\link{todo_comment_linter}} (tags: configurable, style)} \item{\code{\link{trailing_blank_lines_linter}} (tags: default, style)} diff --git a/man/stop_paste_linter.Rd b/man/stop_paste_linter.Rd new file mode 100644 index 000000000..0d0aeb2b1 --- /dev/null +++ b/man/stop_paste_linter.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/stop_paste_linter.R +\name{stop_paste_linter} +\alias{stop_paste_linter} +\title{Block usage of paste() and paste0() with messaging functions using ...} +\usage{ +stop_paste_linter() +} +\description{ +\code{stop(paste0(...))} is strictly redundant -- \code{stop(...)} is equivalent. +\code{stop(...)} is also preferable to \code{stop(paste(...))}. +} +\seealso{ +\link{linters} for a complete list of linters available in lintr. +} +\section{Tags}{ +\link[=best_practices_linters]{best_practices}, \link[=consistency_linters]{consistency} +} diff --git a/tests/testthat/test-stop_paste_linter.R b/tests/testthat/test-stop_paste_linter.R new file mode 100644 index 000000000..1b0822f33 --- /dev/null +++ b/tests/testthat/test-stop_paste_linter.R @@ -0,0 +1,54 @@ +test_that("stop_paste_linter skips allowed usages", { + expect_lint("stop('a string', 'another')", NULL, stop_paste_linter()) + expect_lint("warning('a string', 'another')", NULL, stop_paste_linter()) + expect_lint("message('a string', 'another')", NULL, stop_paste_linter()) + + # paste/paste0 allowed when using other seps and/or collapse + expect_lint("stop(paste(x, collapse = ''))", NULL, stop_paste_linter()) + expect_lint("message(paste(x, sep = '-'))", NULL, stop_paste_linter()) + + # sprintf is OK (really should be gettextf but offering translations + # at google internally is not likely to happen any time soon) + expect_lint("stop(sprintf('A %s!', 'string'))", NULL, stop_paste_linter()) +}) + +test_that("stop_paste_linter blocks simple disallowed usages", { + expect_lint( + "stop(paste('a string', 'another'))", + rex::rex("Don't use paste to build stop strings."), + stop_paste_linter() + ) + + expect_lint( + "warning(paste0('a string ', 'another'))", + rex::rex("Don't use paste0 to build warning strings."), + stop_paste_linter() + ) + + # not thrown off by named arguments + expect_lint( + "stop(paste('a', 'b'), call. = FALSE)", + rex::rex("Don't use paste to build stop strings."), + stop_paste_linter() + ) + + expect_lint( + "warning(paste0('a', 'b'), immediate. = TRUE)", + rex::rex("Don't use paste0 to build warning strings."), + stop_paste_linter() + ) +}) + +test_that("packageStartupMessage usages are also matched", { + expect_lint( + "packageStartupMessage(paste('a string', 'another'))", + rex::rex("Don't use paste to build packageStartupMessage strings."), + stop_paste_linter() + ) + + expect_lint( + "packageStartupMessage(paste0('a string ', 'another'))", + rex::rex("Don't use paste0 to build packageStartupMessage strings."), + stop_paste_linter() + ) +}) From 20689390c5a968a2ace33ce3f50ea464fe5c36d4 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Sat, 26 Mar 2022 18:16:22 +0000 Subject: [PATCH 2/7] remove double-negative logic; add TODO --- R/stop_paste_linter.R | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) diff --git a/R/stop_paste_linter.R b/R/stop_paste_linter.R index fd74704be..10d9812f1 100644 --- a/R/stop_paste_linter.R +++ b/R/stop_paste_linter.R @@ -15,17 +15,19 @@ stop_paste_linter <- function() { xml <- source_file$xml_parsed_content translators <- c("packageStartupMessage", "message", "warning", "stop") + # TODO: refactor to work for raw-string equivalents xpath <- glue::glue("//expr[ expr[SYMBOL_FUNCTION_CALL[ {xp_text_in_table(translators)} ]] and expr[ expr[SYMBOL_FUNCTION_CALL[text() = 'paste' or text() = 'paste0']] - and not(SYMBOL_SUB[ - text() = 'collapse' - or ( + and not(SYMBOL_SUB[text() = 'collapse']) + and ( + not(SYMBOL_SUB[text() = 'sep']) + or SYMBOL_SUB[ text() = 'sep' - and not(following-sibling::expr[1][STR_CONST[text() = '\"\"' or text() = '\" \"']]) - ) - ]) + and following-sibling::expr[1]/STR_CONST[text() = '\"\"' or text() = '\" \"'] + ] + ) ] ]") From f62336fddae6c0a251f0d1c6d275917df060cd38 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 28 Mar 2022 16:24:50 +0000 Subject: [PATCH 3/7] rename to condition_message_linter --- DESCRIPTION | 2 +- NAMESPACE | 2 +- ...te_linter.R => condition_message_linter.R} | 8 ++++-- man/condition_message_linter.Rd | 20 +++++++++++++ man/stop_paste_linter.Rd | 18 ------------ ...nter.R => test-condition_message_linter.R} | 28 +++++++++---------- 6 files changed, 41 insertions(+), 37 deletions(-) rename R/{stop_paste_linter.R => condition_message_linter.R} (83%) create mode 100644 man/condition_message_linter.Rd delete mode 100644 man/stop_paste_linter.Rd rename tests/testthat/{test-stop_paste_linter.R => test-condition_message_linter.R} (57%) diff --git a/DESCRIPTION b/DESCRIPTION index 0241816ed..4319d81ad 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -60,6 +60,7 @@ Collate: 'commas_linter.R' 'comment_linters.R' 'comments.R' + 'condition_message_linter.R' 'conjunct_expectation_linter.R' 'consecutive_stopifnot_linter.R' 'cyclocomp_linter.R' @@ -120,7 +121,6 @@ Collate: 'spaces_inside_linter.R' 'spaces_left_parentheses_linter.R' 'sprintf_linter.R' - 'stop_paste_linter.R' 'system_file_linter.R' 'trailing_blank_lines_linter.R' 'trailing_whitespace_linter.R' diff --git a/NAMESPACE b/NAMESPACE index 05d9ca728..b9ab5dbe4 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -24,6 +24,7 @@ export(clear_cache) export(closed_curly_linter) export(commas_linter) export(commented_code_linter) +export(condition_message_linter) export(conjunct_expectation_linter) export(consecutive_stopifnot_linter) export(cyclocomp_linter) @@ -83,7 +84,6 @@ export(single_quotes_linter) export(spaces_inside_linter) export(spaces_left_parentheses_linter) export(sprintf_linter) -export(stop_paste_linter) export(system_file_linter) export(todo_comment_linter) export(trailing_blank_lines_linter) diff --git a/R/stop_paste_linter.R b/R/condition_message_linter.R similarity index 83% rename from R/stop_paste_linter.R rename to R/condition_message_linter.R index 10d9812f1..5be19835d 100644 --- a/R/stop_paste_linter.R +++ b/R/condition_message_linter.R @@ -1,12 +1,14 @@ #' Block usage of paste() and paste0() with messaging functions using ... #' #' `stop(paste0(...))` is strictly redundant -- `stop(...)` is equivalent. -#' `stop(...)` is also preferable to `stop(paste(...))`. +#' `stop(...)` is also preferable to `stop(paste(...))`. The same applies to +#' all default condition functions, i.e., [stop()], [warning()], [message()], +#' and [packageStartupMessage()]. #' #' @evalRd rd_tags("stop_paste_linter") #' @seealso [linters] for a complete list of linters available in lintr. #' @export -stop_paste_linter <- function() { +condition_message_linter <- function() { Linter(function(source_file) { if (length(source_file$xml_parsed_content) == 0L) { return(list()) @@ -44,7 +46,7 @@ stop_paste_linter <- function() { message <- sprintf("Don't use %s to build %s strings.", inner_call, outer_call) paste( message, - "Instead use the fact that these functions build strings from their input", + "Instead use the fact that these functions build condition message strings from their input", '(using "" as a separator). For translateable strings, prefer using gettextf().' ) }, diff --git a/man/condition_message_linter.Rd b/man/condition_message_linter.Rd new file mode 100644 index 000000000..c78f1ae71 --- /dev/null +++ b/man/condition_message_linter.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/condition_message_linter.R +\name{condition_message_linter} +\alias{condition_message_linter} +\title{Block usage of paste() and paste0() with messaging functions using ...} +\usage{ +condition_message_linter() +} +\description{ +\code{stop(paste0(...))} is strictly redundant -- \code{stop(...)} is equivalent. +\code{stop(...)} is also preferable to \code{stop(paste(...))}. The same applies to +all default condition functions, i.e., \code{\link[=stop]{stop()}}, \code{\link[=warning]{warning()}}, \code{\link[=message]{message()}}, +and \code{\link[=packageStartupMessage]{packageStartupMessage()}}. +} +\seealso{ +\link{linters} for a complete list of linters available in lintr. +} +\section{Tags}{ +\link[=best_practices_linters]{best_practices}, \link[=consistency_linters]{consistency} +} diff --git a/man/stop_paste_linter.Rd b/man/stop_paste_linter.Rd deleted file mode 100644 index 0d0aeb2b1..000000000 --- a/man/stop_paste_linter.Rd +++ /dev/null @@ -1,18 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/stop_paste_linter.R -\name{stop_paste_linter} -\alias{stop_paste_linter} -\title{Block usage of paste() and paste0() with messaging functions using ...} -\usage{ -stop_paste_linter() -} -\description{ -\code{stop(paste0(...))} is strictly redundant -- \code{stop(...)} is equivalent. -\code{stop(...)} is also preferable to \code{stop(paste(...))}. -} -\seealso{ -\link{linters} for a complete list of linters available in lintr. -} -\section{Tags}{ -\link[=best_practices_linters]{best_practices}, \link[=consistency_linters]{consistency} -} diff --git a/tests/testthat/test-stop_paste_linter.R b/tests/testthat/test-condition_message_linter.R similarity index 57% rename from tests/testthat/test-stop_paste_linter.R rename to tests/testthat/test-condition_message_linter.R index 1b0822f33..f8e9424dc 100644 --- a/tests/testthat/test-stop_paste_linter.R +++ b/tests/testthat/test-condition_message_linter.R @@ -1,41 +1,41 @@ -test_that("stop_paste_linter skips allowed usages", { - expect_lint("stop('a string', 'another')", NULL, stop_paste_linter()) - expect_lint("warning('a string', 'another')", NULL, stop_paste_linter()) - expect_lint("message('a string', 'another')", NULL, stop_paste_linter()) +test_that("condition_message_linter skips allowed usages", { + expect_lint("stop('a string', 'another')", NULL, condition_message_linter()) + expect_lint("warning('a string', 'another')", NULL, condition_message_linter()) + expect_lint("message('a string', 'another')", NULL, condition_message_linter()) # paste/paste0 allowed when using other seps and/or collapse - expect_lint("stop(paste(x, collapse = ''))", NULL, stop_paste_linter()) - expect_lint("message(paste(x, sep = '-'))", NULL, stop_paste_linter()) + expect_lint("stop(paste(x, collapse = ''))", NULL, condition_message_linter()) + expect_lint("message(paste(x, sep = '-'))", NULL, condition_message_linter()) # sprintf is OK (really should be gettextf but offering translations # at google internally is not likely to happen any time soon) - expect_lint("stop(sprintf('A %s!', 'string'))", NULL, stop_paste_linter()) + expect_lint("stop(sprintf('A %s!', 'string'))", NULL, condition_message_linter()) }) -test_that("stop_paste_linter blocks simple disallowed usages", { +test_that("condition_message_linter blocks simple disallowed usages", { expect_lint( "stop(paste('a string', 'another'))", rex::rex("Don't use paste to build stop strings."), - stop_paste_linter() + condition_message_linter() ) expect_lint( "warning(paste0('a string ', 'another'))", rex::rex("Don't use paste0 to build warning strings."), - stop_paste_linter() + condition_message_linter() ) # not thrown off by named arguments expect_lint( "stop(paste('a', 'b'), call. = FALSE)", rex::rex("Don't use paste to build stop strings."), - stop_paste_linter() + condition_message_linter() ) expect_lint( "warning(paste0('a', 'b'), immediate. = TRUE)", rex::rex("Don't use paste0 to build warning strings."), - stop_paste_linter() + condition_message_linter() ) }) @@ -43,12 +43,12 @@ test_that("packageStartupMessage usages are also matched", { expect_lint( "packageStartupMessage(paste('a string', 'another'))", rex::rex("Don't use paste to build packageStartupMessage strings."), - stop_paste_linter() + condition_message_linter() ) expect_lint( "packageStartupMessage(paste0('a string ', 'another'))", rex::rex("Don't use paste0 to build packageStartupMessage strings."), - stop_paste_linter() + condition_message_linter() ) }) From c7452ca00c59b37459dbc714b689e1ab1ec45406 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 28 Mar 2022 16:25:35 +0000 Subject: [PATCH 4/7] NEWS --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index 9bc601862..0ebabc536 100644 --- a/NEWS.md +++ b/NEWS.md @@ -116,7 +116,7 @@ function calls. (#850, #851, @renkun-ken) * `literal_coercion_linter()` Require using correctly-typed literals instead of direct coercion, e.g. `1L` instead of `as.numeric(1)` * `paste_sep_linter()` Require usage of `paste0()` over `paste(sep = "")` * `nested_ifelse_linter()` Prevent nested calls to `ifelse()` like `ifelse(A, x, ifelse(B, y, z))`, and similar - * `stop_paste_linter` Prevent error messages (and similar) from being constructed like `stop(paste(...))` (where just `stop(...)` is preferable) + * `condition_message_linter` Prevent condition messages from being constructed like `stop(paste(...))` (where just `stop(...)` is preferable) * `unreachable_code_linter()` Prevent code after `return()` and `stop()` statements that will never be reached * `regex_subset_linter()` Require usage of `grep(ptn, x, value = TRUE)` over `x[grep(ptn, x)]` and similar * `consecutive_stopifnot_linter()` Require consecutive calls to `stopifnot()` to be unified into one From e15dc3268a81ef0b877746113937f0b4696ba187 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 28 Mar 2022 17:01:04 +0000 Subject: [PATCH 5/7] fix name in inst/linters --- inst/lintr/linters.csv | 2 +- man/best_practices_linters.Rd | 2 +- man/condition_message_linter.Rd | 2 +- man/consistency_linters.Rd | 2 +- man/linters.Rd | 2 +- 5 files changed, 5 insertions(+), 5 deletions(-) diff --git a/inst/lintr/linters.csv b/inst/lintr/linters.csv index 6db01e03e..4ff342a3f 100644 --- a/inst/lintr/linters.csv +++ b/inst/lintr/linters.csv @@ -8,6 +8,7 @@ class_equals_linter,best_practices robustness consistency closed_curly_linter,style readability default configurable commas_linter,style readability default commented_code_linter,style readability best_practices default +condition_message_linter,best_practices consistency conjunct_expectation_linter,package_development best_practices readability consecutive_stopifnot_linter,style readability consistency cyclocomp_linter,style readability best_practices default configurable @@ -56,7 +57,6 @@ single_quotes_linter,style consistency readability default spaces_inside_linter,style readability default spaces_left_parentheses_linter,style readability default sprintf_linter,correctness common_mistakes -stop_paste_linter,best_practices consistency system_file_linter,consistency readability best_practices T_and_F_symbol_linter,style readability robustness consistency best_practices default todo_comment_linter,style configurable diff --git a/man/best_practices_linters.Rd b/man/best_practices_linters.Rd index 78f3fb302..57ca4e756 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{any_is_na_linter}}} \item{\code{\link{class_equals_linter}}} \item{\code{\link{commented_code_linter}}} +\item{\code{\link{condition_message_linter}}} \item{\code{\link{conjunct_expectation_linter}}} \item{\code{\link{cyclocomp_linter}}} \item{\code{\link{expect_comparison_linter}}} @@ -36,7 +37,6 @@ The following linters are tagged with 'best_practices': \item{\code{\link{paste_sep_linter}}} \item{\code{\link{regex_subset_linter}}} \item{\code{\link{seq_linter}}} -\item{\code{\link{stop_paste_linter}}} \item{\code{\link{system_file_linter}}} \item{\code{\link{T_and_F_symbol_linter}}} \item{\code{\link{undesirable_function_linter}}} diff --git a/man/condition_message_linter.Rd b/man/condition_message_linter.Rd index c78f1ae71..09008194c 100644 --- a/man/condition_message_linter.Rd +++ b/man/condition_message_linter.Rd @@ -16,5 +16,5 @@ and \code{\link[=packageStartupMessage]{packageStartupMessage()}}. \link{linters} for a complete list of linters available in lintr. } \section{Tags}{ -\link[=best_practices_linters]{best_practices}, \link[=consistency_linters]{consistency} +No tags are given. } diff --git a/man/consistency_linters.Rd b/man/consistency_linters.Rd index 57892d92a..6d9af3a57 100644 --- a/man/consistency_linters.Rd +++ b/man/consistency_linters.Rd @@ -15,6 +15,7 @@ The following linters are tagged with 'consistency': \itemize{ \item{\code{\link{assignment_linter}}} \item{\code{\link{class_equals_linter}}} +\item{\code{\link{condition_message_linter}}} \item{\code{\link{consecutive_stopifnot_linter}}} \item{\code{\link{implicit_integer_linter}}} \item{\code{\link{literal_coercion_linter}}} @@ -24,7 +25,6 @@ The following linters are tagged with 'consistency': \item{\code{\link{paste_sep_linter}}} \item{\code{\link{seq_linter}}} \item{\code{\link{single_quotes_linter}}} -\item{\code{\link{stop_paste_linter}}} \item{\code{\link{system_file_linter}}} \item{\code{\link{T_and_F_symbol_linter}}} } diff --git a/man/linters.Rd b/man/linters.Rd index 9e75addce..5dfdf1d56 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -42,6 +42,7 @@ The following linters exist: \item{\code{\link{closed_curly_linter}} (tags: configurable, default, readability, style)} \item{\code{\link{commas_linter}} (tags: default, readability, style)} \item{\code{\link{commented_code_linter}} (tags: best_practices, default, readability, style)} +\item{\code{\link{condition_message_linter}} (tags: best_practices, consistency)} \item{\code{\link{conjunct_expectation_linter}} (tags: best_practices, package_development, readability)} \item{\code{\link{consecutive_stopifnot_linter}} (tags: consistency, readability, style)} \item{\code{\link{cyclocomp_linter}} (tags: best_practices, configurable, default, readability, style)} @@ -90,7 +91,6 @@ The following linters exist: \item{\code{\link{spaces_inside_linter}} (tags: default, readability, style)} \item{\code{\link{spaces_left_parentheses_linter}} (tags: default, readability, style)} \item{\code{\link{sprintf_linter}} (tags: common_mistakes, correctness)} -\item{\code{\link{stop_paste_linter}} (tags: best_practices, consistency)} \item{\code{\link{system_file_linter}} (tags: best_practices, consistency, readability)} \item{\code{\link{T_and_F_symbol_linter}} (tags: best_practices, consistency, default, readability, robustness, style)} \item{\code{\link{todo_comment_linter}} (tags: configurable, style)} From 71e1337ba5a9929860b3ddf6d72d4fb731445130 Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 28 Mar 2022 17:56:51 +0000 Subject: [PATCH 6/7] roxygenize --- man/linters.Rd | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/man/linters.Rd b/man/linters.Rd index 07b59e4cb..1990bbe53 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -17,13 +17,13 @@ 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} (32 linters)} +\item{\link[=best_practices_linters]{best_practices} (34 linters)} \item{\link[=common_mistakes_linters]{common_mistakes} (5 linters)} \item{\link[=configurable_linters]{configurable} (16 linters)} -\item{\link[=consistency_linters]{consistency} (14 linters)} +\item{\link[=consistency_linters]{consistency} (15 linters)} \item{\link[=correctness_linters]{correctness} (7 linters)} \item{\link[=default_linters]{default} (28 linters)} -\item{\link[=efficiency_linters]{efficiency} (12 linters)} +\item{\link[=efficiency_linters]{efficiency} (13 linters)} \item{\link[=package_development_linters]{package_development} (14 linters)} \item{\link[=readability_linters]{readability} (35 linters)} \item{\link[=robustness_linters]{robustness} (11 linters)} From 97ecb57aa272c424cc7a3e1fde6e8d9fa1a725cc Mon Sep 17 00:00:00 2001 From: Michael Chirico Date: Mon, 28 Mar 2022 19:24:31 +0000 Subject: [PATCH 7/7] fix naming in docs --- R/condition_message_linter.R | 2 +- man/condition_message_linter.Rd | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/condition_message_linter.R b/R/condition_message_linter.R index 5be19835d..4fab88581 100644 --- a/R/condition_message_linter.R +++ b/R/condition_message_linter.R @@ -5,7 +5,7 @@ #' all default condition functions, i.e., [stop()], [warning()], [message()], #' and [packageStartupMessage()]. #' -#' @evalRd rd_tags("stop_paste_linter") +#' @evalRd rd_tags("condition_message_linter") #' @seealso [linters] for a complete list of linters available in lintr. #' @export condition_message_linter <- function() { diff --git a/man/condition_message_linter.Rd b/man/condition_message_linter.Rd index 09008194c..c78f1ae71 100644 --- a/man/condition_message_linter.Rd +++ b/man/condition_message_linter.Rd @@ -16,5 +16,5 @@ and \code{\link[=packageStartupMessage]{packageStartupMessage()}}. \link{linters} for a complete list of linters available in lintr. } \section{Tags}{ -No tags are given. +\link[=best_practices_linters]{best_practices}, \link[=consistency_linters]{consistency} }