diff --git a/NEWS.md b/NEWS.md index f4190a0542..c1587ae0ac 100644 --- a/NEWS.md +++ b/NEWS.md @@ -18,7 +18,9 @@ ## New and improved features * More helpful errors for invalid configs (#2253, @MichaelChirico). -* `library_call_linter()` is extended to encourage all packages to be attached with `library(symbol)`, not `library("symbol", character.only = TRUE)` or "vectorized" approaches looping over package names (part of #884, @MichaelChirico). +* `library_call_linter()` is extended + + to encourage all packages to be attached with `library(symbol)`, not `library("symbol", character.only = TRUE)` or "vectorized" approaches looping over package names (part of #884, @MichaelChirico). + + to discourage many consecutive calls to `suppressMessages()` or `suppressPackageStartupMessages()` (part of #884, @MichaelChirico). ### New linters diff --git a/R/library_call_linter.R b/R/library_call_linter.R index 6617e1bb82..7e4f0bf0d9 100644 --- a/R/library_call_linter.R +++ b/R/library_call_linter.R @@ -5,6 +5,9 @@ #' - Enforce such calls to all be at the top of the script. #' - Block usage of argument `character.only`, in particular #' for loading packages in a loop. +#' - Block consecutive calls to `suppressMessages(library(.))` +#' in favor of using [suppressMessages()] only once to suppress +#' messages from all `library()` calls. Ditto [suppressPackageStartupMessages()]. #' #' @param allow_preamble Logical, default `TRUE`. If `FALSE`, #' no code is allowed to precede the first `library()` call, @@ -36,6 +39,13 @@ #' linters = library_call_linter() #' ) #' +#' code <- "suppressMessages(library(dplyr))\nsuppressMessages(library(tidyr))" +#' writeLines(code) +#' lint( +#' text = code, +#' linters = library_call_linter() +#' ) +#' #' # okay #' code <- "library(dplyr)\nprint('test')" #' writeLines(code) @@ -62,30 +72,40 @@ #' linters = library_call_linter() #' ) #' +#' code <- "suppressMessages({\n library(dplyr)\n library(tidyr)\n})" +#' writeLines(code) +#' lint( +#' text = code, +#' linters = library_call_linter() +#' ) +#' #' @evalRd rd_tags("library_call_linter") #' @seealso [linters] for a complete list of linters available in lintr. #' @export library_call_linter <- function(allow_preamble = TRUE) { - attach_call <- "text() = 'library' or text() = 'require'" - unsuppressed_call <- glue("not( {attach_call} or starts-with(text(), 'suppress'))") + attach_calls <- c("library", "require") + attach_call_cond <- xp_text_in_table(attach_calls) + suppress_call_cond <- xp_text_in_table(c("suppressMessages", "suppressPackageStartupMessages")) + + unsuppressed_call_cond <- glue("not( {xp_or(attach_call_cond, suppress_call_cond)} )") if (allow_preamble) { - unsuppressed_call <- xp_and( - unsuppressed_call, - glue("@line1 > //SYMBOL_FUNCTION_CALL[{ attach_call }][1]/@line1") + unsuppressed_call_cond <- xp_and( + unsuppressed_call_cond, + glue("@line1 > //SYMBOL_FUNCTION_CALL[{ attach_call_cond }][1]/@line1") ) } upfront_call_xpath <- glue(" - //SYMBOL_FUNCTION_CALL[{ attach_call }][last()] + //SYMBOL_FUNCTION_CALL[{ attach_call_cond }][last()] /preceding::expr - /SYMBOL_FUNCTION_CALL[{ unsuppressed_call }][last()] - /following::expr[SYMBOL_FUNCTION_CALL[{ attach_call }]] + /SYMBOL_FUNCTION_CALL[{ unsuppressed_call_cond }][last()] + /following::expr[SYMBOL_FUNCTION_CALL[{ attach_call_cond }]] /parent::expr ") # STR_CONST: block library|require("..."), i.e., supplying a string literal # ancestor::expr[FUNCTION]: Skip usages inside functions a la {knitr} - char_only_direct_xpath <- " - //SYMBOL_FUNCTION_CALL[text() = 'library' or text() = 'require'] + char_only_direct_xpath <- glue(" + //SYMBOL_FUNCTION_CALL[{attach_call_cond}] /parent::expr /parent::expr[ expr[2][STR_CONST] @@ -94,13 +114,13 @@ library_call_linter <- function(allow_preamble = TRUE) { and not(ancestor::expr[FUNCTION]) ) ] - " + ") bad_indirect_funs <- c("do.call", "lapply", "sapply", "map", "walk") - call_symbol_cond <- " - SYMBOL[text() = 'library' or text() = 'require'] - or STR_CONST[text() = '\"library\"' or text() = '\"require\"'] - " + call_symbol_cond <- glue(" + SYMBOL[{attach_call_cond}] + or STR_CONST[{ xp_text_in_table(dQuote(attach_calls, '\"')) }] + ") char_only_indirect_xpath <- glue(" //SYMBOL_FUNCTION_CALL[{ xp_text_in_table(bad_indirect_funs) }] /parent::expr @@ -111,6 +131,23 @@ library_call_linter <- function(allow_preamble = TRUE) { ") call_symbol_path <- glue("./expr[{call_symbol_cond}]") + attach_expr_cond <- glue("expr[expr[SYMBOL_FUNCTION_CALL[{attach_call_cond}]]]") + + # Use `calls` in the first condition, not in the second, to prevent, e.g., + # the first call matching calls[1] but the second matching calls[2]. + # That is, ensure that calls[i] only matches a following call to calls[i]. + # match on the expr, not the SYMBOL_FUNCTION_CALL, to ensure + # namespace-qualified calls only match if the namespaces do. + consecutive_suppress_xpath <- glue(" + //SYMBOL_FUNCTION_CALL[{ suppress_call_cond }] + /parent::expr + /parent::expr[ + expr[SYMBOL_FUNCTION_CALL[{ suppress_call_cond }]] = + following-sibling::expr[1][{attach_expr_cond}]/expr + and {attach_expr_cond} + ] + ") + Linter(function(source_expression) { if (!is_lint_level(source_expression, "file")) { return(list()) @@ -120,12 +157,12 @@ library_call_linter <- function(allow_preamble = TRUE) { upfront_call_expr <- xml_find_all(xml, upfront_call_xpath) - call_name <- xp_call_name(upfront_call_expr) + upfront_call_name <- xp_call_name(upfront_call_expr) upfront_call_lints <- xml_nodes_to_lints( upfront_call_expr, source_expression = source_expression, - lint_message = sprintf("Move all %s calls to the top of the script.", call_name), + lint_message = sprintf("Move all %s calls to the top of the script.", upfront_call_name), type = "warning" ) @@ -161,6 +198,20 @@ library_call_linter <- function(allow_preamble = TRUE) { type = "warning" ) - c(upfront_call_lints, char_only_direct_lints, char_only_indirect_lints) + consecutive_suppress_expr <- xml_find_all(xml, consecutive_suppress_xpath) + consecutive_suppress_call_text <- xp_call_name(consecutive_suppress_expr) + consecutive_suppress_message <- glue( + "Unify consecutive calls to {consecutive_suppress_call_text}(). ", + "You can do so by writing all of the calls in one braced expression ", + "like {consecutive_suppress_call_text}({{...}})." + ) + consecutive_suppress_lints <- xml_nodes_to_lints( + consecutive_suppress_expr, + source_expression = source_expression, + lint_message = consecutive_suppress_message, + type = "warning" + ) + + c(upfront_call_lints, char_only_direct_lints, char_only_indirect_lints, consecutive_suppress_lints) }) } diff --git a/man/library_call_linter.Rd b/man/library_call_linter.Rd index 02b65a5c9e..e34b089e84 100644 --- a/man/library_call_linter.Rd +++ b/man/library_call_linter.Rd @@ -20,6 +20,9 @@ This linter covers several rules related to \code{\link[=library]{library()}} ca \item Enforce such calls to all be at the top of the script. \item Block usage of argument \code{character.only}, in particular for loading packages in a loop. +\item Block consecutive calls to \code{suppressMessages(library(.))} +in favor of using \code{\link[=suppressMessages]{suppressMessages()}} only once to suppress +messages from all \code{library()} calls. Ditto \code{\link[=suppressPackageStartupMessages]{suppressPackageStartupMessages()}}. } } \examples{ @@ -48,6 +51,13 @@ lint( linters = library_call_linter() ) +code <- "suppressMessages(library(dplyr))\nsuppressMessages(library(tidyr))" +writeLines(code) +lint( + text = code, + linters = library_call_linter() +) + # okay code <- "library(dplyr)\nprint('test')" writeLines(code) @@ -74,6 +84,13 @@ lint( linters = library_call_linter() ) +code <- "suppressMessages({\n library(dplyr)\n library(tidyr)\n})" +writeLines(code) +lint( + text = code, + linters = library_call_linter() +) + } \seealso{ \link{linters} for a complete list of linters available in lintr. diff --git a/tests/testthat/test-library_call_linter.R b/tests/testthat/test-library_call_linter.R index 429125e5aa..46843d5285 100644 --- a/tests/testthat/test-library_call_linter.R +++ b/tests/testthat/test-library_call_linter.R @@ -114,10 +114,16 @@ test_that("library_call_linter warns on disallowed usages", { trim_some(" library(dplyr) print('test') + suppressMessages(library('lubridate', character.only = TRUE)) suppressMessages(library(tidyr)) print('test') "), - lint_message, + list( + list(rex::rex("Unify consecutive calls to suppressMessages()"), line_number = 3L), + list(lint_message, line_number = 3L), + list(rex::rex("Use symbols in library calls to avoid the need for 'character.only'"), line_number = 3L), + list(lint_message, line_number = 4L) + ), linter ) }) @@ -311,3 +317,123 @@ test_that("multiple lints are generated correctly", { library_call_linter() ) }) + +patrick::with_parameters_test_that( + "library_call_linter skips allowed usages", + { + linter <- library_call_linter() + + expect_lint(sprintf("%s(x)", call), NULL, linter) + expect_lint(sprintf("%s(x, y, z)", call), NULL, linter) + + # intervening expression + expect_lint(sprintf("%1$s(x); y; %1$s(z)", call), NULL, linter) + + # inline or potentially with gaps don't matter + lines <- c( + sprintf("%s(x)", call), + "y", + "", + "stopifnot(z)" + ) + expect_lint(lines, NULL, linter) + + # only suppressing calls with library() + lines_consecutive <- c( + sprintf("%s(x)", call), + sprintf("%s(y)", call) + ) + expect_lint(lines_consecutive, NULL, linter) + }, + .test_name = c("suppressMessages", "suppressPackageStartupMessages"), + call = c("suppressMessages", "suppressPackageStartupMessages") +) + +patrick::with_parameters_test_that( + "library_call_linter blocks simple disallowed usages", + { + linter <- library_call_linter() + message <- sprintf("Unify consecutive calls to %s\\(\\)\\.", call) + + # one test of inline usage + expect_lint(sprintf("%1$s(library(x)); %1$s(library(y))", call), message, linter) + + lines_gap <- c( + sprintf("%s(library(x))", call), + "", + sprintf("%s(library(y))", call) + ) + expect_lint(lines_gap, message, linter) + + lines_consecutive <- c( + sprintf("%s(require(x))", call), + sprintf("%s(require(y))", call) + ) + expect_lint(lines_consecutive, message, linter) + + lines_comment <- c( + sprintf("%s(library(x))", call), + "# a comment on y", + sprintf("%s(library(y))", call) + ) + expect_lint(lines_comment, message, linter) + }, + .test_name = c("suppressMessages", "suppressPackageStartupMessages"), + call = c("suppressMessages", "suppressPackageStartupMessages") +) + +test_that("Namespace differences are detected", { + linter <- library_call_linter() + + # totally different namespaces + expect_lint( + "ns::suppressMessages(library(x)); base::suppressMessages(library(y))", + NULL, + linter + ) + + # one namespaced, one not + expect_lint( + "ns::suppressMessages(library(x)); suppressMessages(library(y))", + NULL, + linter + ) +}) + +test_that("Consecutive calls to different blocked calls is OK", { + expect_lint( + "suppressPackageStartupMessages(library(x)); suppressMessages(library(y))", + NULL, + library_call_linter() + ) +}) + +test_that("Multiple violations across different calls are caught", { + linter <- library_call_linter() + + expect_lint( + trim_some(" + suppressPackageStartupMessages(library(x)) + suppressPackageStartupMessages(library(x)) + suppressMessages(library(x)) + suppressMessages(library(x)) + "), + list( + "Unify consecutive calls to suppressPackageStartupMessages", + "Unify consecutive calls to suppressMessages" + ), + linter + ) + + expect_lint( + trim_some(" + suppressMessages(library(A)) + suppressPackageStartupMessages(library(A)) + suppressMessages(library(A)) + suppressPackageStartupMessages(library(A)) + suppressPackageStartupMessages(library(A)) + "), + list("Unify consecutive calls to suppressPackageStartupMessages", line_number = 4L), + linter + ) +})