Skip to content

Commit 68aaebf

Browse files
MichaelChiricoMichaelChirico
authored
Merge e6f282a into 8414018 
2 parents 8414018 + e6f282a commit 68aaebf

File tree

4 files changed

+216
-20
lines changed

4 files changed

+216
-20
lines changed

‎NEWS.md

Lines changed: 3 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -18,7 +18,9 @@
1818
## New and improved features
1919

2020
* More helpful errors for invalid configs (#2253, @MichaelChirico).
21-
* `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).
21+
* `library_call_linter()` is extended
22+
+ 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).
23+
+ to discourage many consecutive calls to `suppressMessages()` or `suppressPackageStartupMessages()` (part of #884, @MichaelChirico).
2224

2325
### New linters
2426

‎R/library_call_linter.R

Lines changed: 69 additions & 18 deletions
Original file line numberDiff line numberDiff line change
@@ -5,6 +5,9 @@
55
#' - Enforce such calls to all be at the top of the script.
66
#' - Block usage of argument `character.only`, in particular
77
#' for loading packages in a loop.
8+
#' - Block consecutive calls to `suppressMessages(library(.))`
9+
#' in favor of using [suppressMessages()] only once to suppress
10+
#' messages from all `library()` calls. Ditto [suppressPackageStartupMessages()].
811
#'
912
#' @param allow_preamble Logical, default `TRUE`. If `FALSE`,
1013
#' no code is allowed to precede the first `library()` call,
@@ -36,6 +39,13 @@
3639
#' linters = library_call_linter()
3740
#' )
3841
#'
42+
#' code <- "suppressMessages(library(dplyr))\nsuppressMessages(library(tidyr))"
43+
#' writeLines(code)
44+
#' lint(
45+
#' text = code,
46+
#' linters = library_call_linter()
47+
#' )
48+
#'
3949
#' # okay
4050
#' code <- "library(dplyr)\nprint('test')"
4151
#' writeLines(code)
@@ -62,30 +72,40 @@
6272
#' linters = library_call_linter()
6373
#' )
6474
#'
75+
#' code <- "suppressMessages({\n library(dplyr)\n library(tidyr)\n})"
76+
#' writeLines(code)
77+
#' lint(
78+
#' text = code,
79+
#' linters = library_call_linter()
80+
#' )
81+
#'
6582
#' @evalRd rd_tags("library_call_linter")
6683
#' @seealso [linters] for a complete list of linters available in lintr.
6784
#' @export
6885
library_call_linter <- function(allow_preamble = TRUE) {
69-
attach_call <- "text() = 'library' or text() = 'require'"
70-
unsuppressed_call <- glue("not( {attach_call} or starts-with(text(), 'suppress'))")
86+
attach_calls <- c("library", "require")
87+
attach_call_cond <- xp_text_in_table(attach_calls)
88+
suppress_call_cond <- xp_text_in_table(c("suppressMessages", "suppressPackageStartupMessages"))
89+
90+
unsuppressed_call_cond <- glue("not( {xp_or(attach_call_cond, suppress_call_cond)} )")
7191
if (allow_preamble) {
72-
unsuppressed_call <- xp_and(
73-
unsuppressed_call,
74-
glue("@line1 > //SYMBOL_FUNCTION_CALL[{ attach_call }][1]/@line1")
92+
unsuppressed_call_cond <- xp_and(
93+
unsuppressed_call_cond,
94+
glue("@line1 > //SYMBOL_FUNCTION_CALL[{ attach_call_cond }][1]/@line1")
7595
)
7696
}
7797
upfront_call_xpath <- glue("
78-
//SYMBOL_FUNCTION_CALL[{ attach_call }][last()]
98+
//SYMBOL_FUNCTION_CALL[{ attach_call_cond }][last()]
7999
/preceding::expr
80-
/SYMBOL_FUNCTION_CALL[{ unsuppressed_call }][last()]
81-
/following::expr[SYMBOL_FUNCTION_CALL[{ attach_call }]]
100+
/SYMBOL_FUNCTION_CALL[{ unsuppressed_call_cond }][last()]
101+
/following::expr[SYMBOL_FUNCTION_CALL[{ attach_call_cond }]]
82102
/parent::expr
83103
")
84104

85105
# STR_CONST: block library|require("..."), i.e., supplying a string literal
86106
# ancestor::expr[FUNCTION]: Skip usages inside functions a la {knitr}
87-
char_only_direct_xpath <- "
88-
//SYMBOL_FUNCTION_CALL[text() = 'library' or text() = 'require']
107+
char_only_direct_xpath <- glue("
108+
//SYMBOL_FUNCTION_CALL[{attach_call_cond}]
89109
/parent::expr
90110
/parent::expr[
91111
expr[2][STR_CONST]
@@ -94,13 +114,13 @@ library_call_linter <- function(allow_preamble = TRUE) {
94114
and not(ancestor::expr[FUNCTION])
95115
)
96116
]
97-
"
117+
")
98118

99119
bad_indirect_funs <- c("do.call", "lapply", "sapply", "map", "walk")
100-
call_symbol_cond <- "
101-
SYMBOL[text() = 'library' or text() = 'require']
102-
or STR_CONST[text() = '\"library\"' or text() = '\"require\"']
103-
"
120+
call_symbol_cond <- glue("
121+
SYMBOL[{attach_call_cond}]
122+
or STR_CONST[{ xp_text_in_table(dQuote(attach_calls, '\"')) }]
123+
")
104124
char_only_indirect_xpath <- glue("
105125
//SYMBOL_FUNCTION_CALL[{ xp_text_in_table(bad_indirect_funs) }]
106126
/parent::expr
@@ -111,6 +131,23 @@ library_call_linter <- function(allow_preamble = TRUE) {
111131
")
112132
call_symbol_path <- glue("./expr[{call_symbol_cond}]")
113133

134+
attach_expr_cond <- glue("expr[expr[SYMBOL_FUNCTION_CALL[{attach_call_cond}]]]")
135+
136+
# Use `calls` in the first condition, not in the second, to prevent, e.g.,
137+
# the first call matching calls[1] but the second matching calls[2].
138+
# That is, ensure that calls[i] only matches a following call to calls[i].
139+
# match on the expr, not the SYMBOL_FUNCTION_CALL, to ensure
140+
# namespace-qualified calls only match if the namespaces do.
141+
consecutive_suppress_xpath <- glue("
142+
//SYMBOL_FUNCTION_CALL[{ suppress_call_cond }]
143+
/parent::expr
144+
/parent::expr[
145+
expr[SYMBOL_FUNCTION_CALL[{ suppress_call_cond }]] =
146+
following-sibling::expr[1][{attach_expr_cond}]/expr
147+
and {attach_expr_cond}
148+
]
149+
")
150+
114151
Linter(function(source_expression) {
115152
if (!is_lint_level(source_expression, "file")) {
116153
return(list())
@@ -120,12 +157,12 @@ library_call_linter <- function(allow_preamble = TRUE) {
120157

121158
upfront_call_expr <- xml_find_all(xml, upfront_call_xpath)
122159

123-
call_name <- xp_call_name(upfront_call_expr)
160+
upfront_call_name <- xp_call_name(upfront_call_expr)
124161

125162
upfront_call_lints <- xml_nodes_to_lints(
126163
upfront_call_expr,
127164
source_expression = source_expression,
128-
lint_message = sprintf("Move all %s calls to the top of the script.", call_name),
165+
lint_message = sprintf("Move all %s calls to the top of the script.", upfront_call_name),
129166
type = "warning"
130167
)
131168

@@ -161,6 +198,20 @@ library_call_linter <- function(allow_preamble = TRUE) {
161198
type = "warning"
162199
)
163200

164-
c(upfront_call_lints, char_only_direct_lints, char_only_indirect_lints)
201+
consecutive_suppress_expr <- xml_find_all(xml, consecutive_suppress_xpath)
202+
consecutive_suppress_call_text <- xp_call_name(consecutive_suppress_expr)
203+
consecutive_suppress_message <- glue(
204+
"Unify consecutive calls to {consecutive_suppress_call_text}(). ",
205+
"You can do so by writing all of the calls in one braced expression ",
206+
"like {consecutive_suppress_call_text}({{...}})."
207+
)
208+
consecutive_suppress_lints <- xml_nodes_to_lints(
209+
consecutive_suppress_expr,
210+
source_expression = source_expression,
211+
lint_message = consecutive_suppress_message,
212+
type = "warning"
213+
)
214+
215+
c(upfront_call_lints, char_only_direct_lints, char_only_indirect_lints, consecutive_suppress_lints)
165216
})
166217
}

‎man/library_call_linter.Rd

Lines changed: 17 additions & 0 deletions
Some generated files are not rendered by default. Learn more about customizing how changed files appear on GitHub.

‎tests/testthat/test-library_call_linter.R

Lines changed: 127 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -114,10 +114,16 @@ test_that("library_call_linter warns on disallowed usages", {
114114
trim_some("
115115
library(dplyr)
116116
print('test')
117+
suppressMessages(library('lubridate', character.only = TRUE))
117118
suppressMessages(library(tidyr))
118119
print('test')
119120
"),
120-
lint_message,
121+
list(
122+
list(rex::rex("Unify consecutive calls to suppressMessages()"), line_number = 3L),
123+
list(lint_message, line_number = 3L),
124+
list(rex::rex("Use symbols in library calls to avoid the need for 'character.only'"), line_number = 3L),
125+
list(lint_message, line_number = 4L)
126+
),
121127
linter
122128
)
123129
})
@@ -311,3 +317,123 @@ test_that("multiple lints are generated correctly", {
311317
library_call_linter()
312318
)
313319
})
320+
321+
patrick::with_parameters_test_that(
322+
"library_call_linter skips allowed usages",
323+
{
324+
linter <- library_call_linter()
325+
326+
expect_lint(sprintf("%s(x)", call), NULL, linter)
327+
expect_lint(sprintf("%s(x, y, z)", call), NULL, linter)
328+
329+
# intervening expression
330+
expect_lint(sprintf("%1$s(x); y; %1$s(z)", call), NULL, linter)
331+
332+
# inline or potentially with gaps don't matter
333+
lines <- c(
334+
sprintf("%s(x)", call),
335+
"y",
336+
"",
337+
"stopifnot(z)"
338+
)
339+
expect_lint(lines, NULL, linter)
340+
341+
# only suppressing calls with library()
342+
lines_consecutive <- c(
343+
sprintf("%s(x)", call),
344+
sprintf("%s(y)", call)
345+
)
346+
expect_lint(lines_consecutive, NULL, linter)
347+
},
348+
.test_name = c("suppressMessages", "suppressPackageStartupMessages"),
349+
call = c("suppressMessages", "suppressPackageStartupMessages")
350+
)
351+
352+
patrick::with_parameters_test_that(
353+
"library_call_linter blocks simple disallowed usages",
354+
{
355+
linter <- library_call_linter()
356+
message <- sprintf("Unify consecutive calls to %s\\(\\)\\.", call)
357+
358+
# one test of inline usage
359+
expect_lint(sprintf("%1$s(library(x)); %1$s(library(y))", call), message, linter)
360+
361+
lines_gap <- c(
362+
sprintf("%s(library(x))", call),
363+
"",
364+
sprintf("%s(library(y))", call)
365+
)
366+
expect_lint(lines_gap, message, linter)
367+
368+
lines_consecutive <- c(
369+
sprintf("%s(require(x))", call),
370+
sprintf("%s(require(y))", call)
371+
)
372+
expect_lint(lines_consecutive, message, linter)
373+
374+
lines_comment <- c(
375+
sprintf("%s(library(x))", call),
376+
"# a comment on y",
377+
sprintf("%s(library(y))", call)
378+
)
379+
expect_lint(lines_comment, message, linter)
380+
},
381+
.test_name = c("suppressMessages", "suppressPackageStartupMessages"),
382+
call = c("suppressMessages", "suppressPackageStartupMessages")
383+
)
384+
385+
test_that("Namespace differences are detected", {
386+
linter <- library_call_linter()
387+
388+
# totally different namespaces
389+
expect_lint(
390+
"ns::suppressMessages(library(x)); base::suppressMessages(library(y))",
391+
NULL,
392+
linter
393+
)
394+
395+
# one namespaced, one not
396+
expect_lint(
397+
"ns::suppressMessages(library(x)); suppressMessages(library(y))",
398+
NULL,
399+
linter
400+
)
401+
})
402+
403+
test_that("Consecutive calls to different blocked calls is OK", {
404+
expect_lint(
405+
"suppressPackageStartupMessages(library(x)); suppressMessages(library(y))",
406+
NULL,
407+
library_call_linter()
408+
)
409+
})
410+
411+
test_that("Multiple violations across different calls are caught", {
412+
linter <- library_call_linter()
413+
414+
expect_lint(
415+
trim_some("
416+
suppressPackageStartupMessages(library(x))
417+
suppressPackageStartupMessages(library(x))
418+
suppressMessages(library(x))
419+
suppressMessages(library(x))
420+
"),
421+
list(
422+
"Unify consecutive calls to suppressPackageStartupMessages",
423+
"Unify consecutive calls to suppressMessages"
424+
),
425+
linter
426+
)
427+
428+
expect_lint(
429+
trim_some("
430+
suppressMessages(library(A))
431+
suppressPackageStartupMessages(library(A))
432+
suppressMessages(library(A))
433+
suppressPackageStartupMessages(library(A))
434+
suppressPackageStartupMessages(library(A))
435+
"),
436+
list("Unify consecutive calls to suppressPackageStartupMessages", line_number = 4L),
437+
linter
438+
)
439+
})

0 commit comments

Comments
 (0)