Skip to content

Commit 38db1ac

Browse files
MichaelChiricoMichaelChirico
authored
Fix linters where strange comments produce garbled metadata (#2897)
* Improve robustness to comments * need strip_comments_from_subtree * fix linter logic producing garbled metadata * also need the new NAMESPACE entry
1 parent dadcf3c commit 38db1ac

10 files changed

+128
-73
lines changed

‎NAMESPACE‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -196,4 +196,5 @@ importFrom(xml2,xml_find_first)
196196
importFrom(xml2,xml_find_lgl)
197197
importFrom(xml2,xml_find_num)
198198
importFrom(xml2,xml_name)
199+
importFrom(xml2,xml_parent)
199200
importFrom(xml2,xml_text)

‎R/comparison_negation_linter.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -65,13 +65,13 @@ comparison_negation_linter <- function() {
6565

6666
bad_expr <- xml_find_all(xml, xpath)
6767

68-
comparator_node <- xml_find_first(bad_expr, "expr/expr/*[2]")
68+
comparator_node <- xml_find_first(bad_expr, "expr/expr/*[not(self::COMMENT)][2]")
6969
comparator_name <- xml_name(comparator_node)
7070

7171
# "typical" case is assumed to be !(x == y), so try that first, and back
7272
# up to the less nested case. there may be a cleaner way to do this...
7373
unnested <- !comparator_name %in% names(comparator_inverses)
74-
comparator_node[unnested] <- xml_find_first(bad_expr[unnested], "expr/*[2]")
74+
comparator_node[unnested] <- xml_find_first(bad_expr[unnested], "expr/*[not(self::COMMENT)][2]")
7575
comparator_name[unnested] <- xml_name(comparator_node[unnested])
7676

7777
comparator_text <- xml_text(comparator_node)

‎R/ifelse_censor_linter.R‎

Lines changed: 5 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -36,20 +36,19 @@
3636
#' @export
3737
ifelse_censor_linter <- function() {
3838
xpath <- glue("
39-
following-sibling::expr[
39+
self::*[expr[
4040
(LT or GT or LE or GE)
4141
and expr[1] = following-sibling::expr
4242
and expr[2] = following-sibling::expr
43-
]
44-
/parent::expr
45-
")
43+
]]")
4644

4745
Linter(linter_level = "expression", function(source_expression) {
48-
ifelse_calls <- source_expression$xml_find_function_calls(ifelse_funs)
46+
ifelse_calls <- xml_parent(source_expression$xml_find_function_calls(ifelse_funs))
47+
ifelse_calls <- strip_comments_from_subtree(ifelse_calls)
4948
bad_expr <- xml_find_all(ifelse_calls, xpath)
5049

5150
matched_call <- xp_call_name(bad_expr)
52-
operator <- xml_find_chr(bad_expr, "string(expr[2]/*[2])")
51+
operator <- xml_find_chr(bad_expr, "string(expr[2]/*[not(self::COMMENT)][2])")
5352
match_first <- !is.na(xml_find_first(bad_expr, "expr[2][expr[1] = following-sibling::expr[1]]"))
5453
optimizer <- ifelse((operator %in% c("<", "<=")) == match_first, "pmin", "pmax")
5554
first_var <- rep_len("x", length(match_first))

‎R/lintr-package.R‎

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -15,7 +15,8 @@
1515
#' @importFrom tools R_user_dir
1616
#' @importFrom utils capture.output getParseData globalVariables head relist tail
1717
#' @importFrom xml2 as_list
18-
#' xml_attr xml_children xml_find_all xml_find_chr xml_find_lgl xml_find_num xml_find_first xml_name xml_text
18+
#' xml_attr xml_children xml_find_all xml_find_chr xml_find_lgl xml_find_num
19+
#' xml_find_first xml_name xml_parent xml_text
1920
## lintr namespace: end
2021
NULL
2122

‎R/nzchar_linter.R‎

Lines changed: 3 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -112,8 +112,9 @@ nzchar_linter <- function() {
112112
# its "opposite" (not inverse) if the bad usage is on the RHS,
113113
# e.g. 0 < nchar(x) has to be treated as nchar(x) > 0.
114114
op_for_msg <- function(expr, const) {
115-
op <- xml_name(xml_find_first(expr, "*[2]"))
116-
maybe_needs_flip <- !is.na(xml_find_first(expr, sprintf("*[1][%s]", const)))
115+
op <- xml_name(xml_find_first(expr, "*[not(self::COMMENT)][2]"))
116+
maybe_needs_flip <-
117+
!is.na(xml_find_first(expr, sprintf("*[not(self::COMMENT)][1][%s]", const)))
117118

118119
ordered_ops <- c("GT", "GE", "LE", "LT")
119120
ordered_idx <- match(op, ordered_ops)

‎R/vector_logic_linter.R‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -77,7 +77,7 @@ vector_logic_linter <- function() {
7777
and preceding-sibling::*[
7878
self::IF
7979
or self::WHILE
80-
or self::expr[SYMBOL_FUNCTION_CALL[text() = 'expect_true' or text() = 'expect_false']]
80+
or self::expr/SYMBOL_FUNCTION_CALL[text() = 'expect_true' or text() = 'expect_false']
8181
]
8282
]
8383
and not(ancestor::expr[
@@ -100,7 +100,7 @@ vector_logic_linter <- function() {
100100
and not(preceding-sibling::OP-LEFT-BRACKET)
101101
and not(preceding-sibling::*[not(self::COMMENT)][2][self::SYMBOL_SUB and text() = 'circular'])
102102
]
103-
/*[2]
103+
/*[not(self::COMMENT)][2]
104104
"
105105

106106
Linter(linter_level = "expression", function(source_expression) {

‎tests/testthat/test-comparison_negation_linter.R‎

Lines changed: 16 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -2,16 +2,16 @@ test_that("comparison_negation_linter skips allowed usages", {
22
linter <- comparison_negation_linter()
33

44
# doesn't apply to joint statements
5-
expect_lint("!(x == y | y == z)", NULL, linter)
5+
expect_no_lint("!(x == y | y == z)", linter)
66
# don't force de Morgan's laws
7-
expect_lint("!(x & y)", NULL, linter)
7+
expect_no_lint("!(x & y)", linter)
88

99
# naive xpath will include !foo(x) cases
10-
expect_lint("!any(x > y)", NULL, linter)
10+
expect_no_lint("!any(x > y)", linter)
1111
# ditto for tidyeval cases
12-
expect_lint("!!target == 1 ~ 'target'", NULL, linter)
12+
expect_no_lint("!!target == 1 ~ 'target'", linter)
1313
# ditto for !x[f == g]
14-
expect_lint("!passes.test[stage == 1]", NULL, linter)
14+
expect_no_lint("!passes.test[stage == 1]", linter)
1515
})
1616

1717
local({
@@ -61,3 +61,14 @@ test_that("Lints vectorize", {
6161
comparison_negation_linter()
6262
)
6363
})
64+
65+
test_that("logic survives adversarial comments", {
66+
expect_lint(
67+
trim_some("
68+
!(x #
69+
> y)
70+
"),
71+
rex::rex("Use x <= y, not !(x > y)"),
72+
comparison_negation_linter()
73+
)
74+
})

‎tests/testthat/test-ifelse_censor_linter.R‎

Lines changed: 25 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
11
test_that("ifelse_censor_linter skips allowed usages", {
22
linter <- ifelse_censor_linter()
33

4-
expect_lint("ifelse(x == 2, x, y)", NULL, linter)
5-
expect_lint("ifelse(x > 2, x, y)", NULL, linter)
4+
expect_no_lint("ifelse(x == 2, x, y)", linter)
5+
expect_no_lint("ifelse(x > 2, x, y)", linter)
66
})
77

88
test_that("ifelse_censor_linter blocks simple disallowed usages", {
@@ -56,13 +56,30 @@ test_that("ifelse_censor_linter blocks simple disallowed usages", {
5656
)
5757

5858
# more complicated expression still matches
59-
lines <- trim_some("
60-
ifelse(2 + p + 104 + 1 > ncols,
61-
ncols, 2 + p + 104 + 1
62-
)
63-
")
6459
expect_lint(
65-
lines,
60+
trim_some("
61+
ifelse(2 + p + 104 + 1 > ncols,
62+
ncols, 2 + p + 104 + 1
63+
)
64+
"),
65+
rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"),
66+
linter
67+
)
68+
69+
# including with comments
70+
expect_lint(
71+
trim_some("
72+
ifelse(2 + p + 104 + 1 #comment
73+
> ncols, ncols, 2 + p + 104 + 1)
74+
"),
75+
rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"),
76+
linter
77+
)
78+
expect_lint(
79+
trim_some("
80+
ifelse(2 + p + 104 + # comment
81+
1 > ncols, ncols, 2 + p + 104 + 1)
82+
"),
6683
rex::rex("pmin(x, y) is preferable to ifelse(x > y, y, x)"),
6784
linter
6885
)

‎tests/testthat/test-nzchar_linter.R‎

Lines changed: 13 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -33,13 +33,22 @@ test_that("nzchar_linter skips as appropriate for other nchar args", {
3333

3434
test_that("nzchar_linter blocks simple disallowed usages", {
3535
linter <- nzchar_linter()
36-
lint_msg_quote <- rex::rex('Use !nzchar(x) instead of x == ""')
37-
lint_msg_nchar <- rex::rex("Use nzchar() instead of comparing nchar(x) to 0")
36+
lint_msg <- rex::rex("Use !nzchar(x) instead of nchar(x) == 0")
3837

39-
expect_lint("which(x == '')", lint_msg_quote, linter)
38+
expect_lint("which(x == '')", rex::rex('Use !nzchar(x) instead of x == ""'), linter)
4039
expect_lint("any(nchar(x) >= 0)", rex::rex("nchar(x) >= 0 is always true, maybe you want nzchar(x)?"), linter)
41-
expect_lint("all(nchar(x) == 0L)", rex::rex("Use !nzchar(x) instead of nchar(x) == 0"), linter)
40+
expect_lint("all(nchar(x) == 0L)", lint_msg, linter)
4241
expect_lint("sum(0.0 < nchar(x))", rex::rex("Use nzchar(x) instead of nchar(x) > 0"), linter)
42+
43+
# adversarial comment
44+
expect_lint(
45+
trim_some("
46+
all(nchar(x) #comment
47+
== 0L)
48+
"),
49+
lint_msg,
50+
linter
51+
)
4352
})
4453

4554
test_that("nzchar_linter skips comparison to '' in if/while statements", {

‎tests/testthat/test-vector_logic_linter.R‎

Lines changed: 59 additions & 43 deletions
Original file line numberDiff line numberDiff line change
@@ -1,30 +1,31 @@
11
test_that("vector_logic_linter skips allowed usages", {
22
linter <- vector_logic_linter()
33

4-
expect_lint("if (TRUE) 5 else if (TRUE) 2", NULL, linter)
5-
expect_lint("if (TRUE || FALSE) 1; while (TRUE && FALSE) 2", NULL, linter)
4+
expect_no_lint("if (TRUE) 5 else if (TRUE) 2", linter)
5+
expect_no_lint("if (TRUE || FALSE) 1; while (TRUE && FALSE) 2", linter)
66

77
# function calls and extractions may aggregate to scalars -- only catch
88
# usages at the highest logical level
9-
expect_lint("if (agg_function(x & y)) 1", NULL, linter)
10-
expect_lint("if (DT[x | y, cond]) 1", NULL, linter)
9+
expect_no_lint("if (agg_function(x & y)) 1", linter)
10+
expect_no_lint("if (DT[x | y, cond]) 1", linter)
1111

1212
# don't match potentially OK usages nested within calls
13-
expect_lint("if (TRUE && any(TRUE | FALSE)) 4", NULL, linter)
13+
expect_no_lint("if (TRUE && any(TRUE | FALSE)) 4", linter)
1414
# even if the usage is nested in those calls (b/181915948)
15-
expect_lint("if (TRUE && any(TRUE | FALSE | TRUE)) 4", NULL, linter)
15+
expect_no_lint("if (TRUE && any(TRUE | FALSE | TRUE)) 4", linter)
1616

1717
# don't match potentially OK usages in the branch itself
18-
lines <- trim_some("
19-
if (TRUE) {
20-
x | y
21-
}
22-
")
23-
expect_lint(lines, NULL, linter)
24-
18+
expect_no_lint(
19+
trim_some("
20+
if (TRUE) {
21+
x | y
22+
}
23+
"),
24+
linter
25+
)
2526

2627
# valid nested usage within aggregator
27-
expect_lint("testthat::expect_false(any(TRUE | TRUE))", NULL, linter)
28+
expect_no_lint("testthat::expect_false(any(TRUE | TRUE))", linter)
2829
})
2930

3031
test_that("vector_logic_linter blocks simple disallowed usages", {
@@ -63,41 +64,40 @@ test_that("vector_logic_linter catches usages in expect_true()/expect_false()",
6364
})
6465

6566
test_that("vector_logic_linter doesn't get mixed up from complex usage", {
66-
expect_lint(
67+
expect_no_lint(
6768
trim_some("
6869
if (a) {
6970
expect_true(ok)
7071
x <- 2
7172
a | b
7273
}
7374
"),
74-
NULL,
7575
vector_logic_linter()
7676
)
7777
})
7878

7979
test_that("vector_logic_linter recognizes some false positves around bitwise &/|", {
8080
linter <- vector_logic_linter()
8181

82-
expect_lint("if (info & as.raw(12)) { }", NULL, linter)
83-
expect_lint("if (as.raw(12) & info) { }", NULL, linter)
84-
expect_lint("if (info | as.raw(12)) { }", NULL, linter)
85-
expect_lint("if (info & as.octmode('100')) { }", NULL, linter)
86-
expect_lint("if (info | as.octmode('011')) { }", NULL, linter)
87-
expect_lint("if (info & as.hexmode('100')) { }", NULL, linter)
88-
expect_lint("if (info | as.hexmode('011')) { }", NULL, linter)
82+
expect_no_lint("if (info & as.raw(12)) { }", linter)
83+
expect_no_lint("if (as.raw(12) & info) { }", linter)
84+
expect_no_lint("if (info | as.raw(12)) { }", linter)
85+
expect_no_lint("if (info & as.octmode('100')) { }", linter)
86+
expect_no_lint("if (info | as.octmode('011')) { }", linter)
87+
expect_no_lint("if (info & as.hexmode('100')) { }", linter)
88+
expect_no_lint("if (info | as.hexmode('011')) { }", linter)
8989
# implicit as.octmode() coercion
90-
expect_lint("if (info & '100') { }", NULL, linter)
91-
expect_lint("if (info | '011') { }", NULL, linter)
92-
expect_lint("if ('011' | info) { }", NULL, linter)
90+
expect_no_lint("if (info & '100') { }", linter)
91+
expect_no_lint("if (info | '011') { }", linter)
92+
expect_no_lint("if ('011' | info) { }", linter)
9393

9494
# further nesting
95-
expect_lint("if ((info & as.raw(12)) == as.raw(12)) { }", NULL, linter)
96-
expect_lint("if ((info | as.raw(12)) == as.raw(12)) { }", NULL, linter)
97-
expect_lint('if ((mode & "111") != as.octmode("111")) { }', NULL, linter)
98-
expect_lint('if ((mode | "111") != as.octmode("111")) { }', NULL, linter)
99-
expect_lint('if ((mode & "111") != as.hexmode("111")) { }', NULL, linter)
100-
expect_lint('if ((mode | "111") != as.hexmode("111")) { }', NULL, linter)
95+
expect_no_lint("if ((info & as.raw(12)) == as.raw(12)) { }", linter)
96+
expect_no_lint("if ((info | as.raw(12)) == as.raw(12)) { }", linter)
97+
expect_no_lint('if ((mode & "111") != as.octmode("111")) { }', linter)
98+
expect_no_lint('if ((mode | "111") != as.octmode("111")) { }', linter)
99+
expect_no_lint('if ((mode & "111") != as.hexmode("111")) { }', linter)
100+
expect_no_lint('if ((mode | "111") != as.hexmode("111")) { }', linter)
101101
})
102102

103103
test_that("incorrect subset/filter usage is caught", {
@@ -128,46 +128,62 @@ test_that("subsetting logic handles nesting", {
128128
expect_lint("filter(x, a & b || c)", or_msg, linter)
129129
expect_lint("filter(x, a && b | c)", and_msg, linter)
130130

131+
# adversarial commenting
132+
expect_lint(
133+
trim_some("
134+
filter(x, a #comment
135+
&& b | c)
136+
"),
137+
and_msg,
138+
linter
139+
)
140+
141+
expect_lint(
142+
trim_some("
143+
filter(x, a && #comment
144+
b | c)
145+
"),
146+
and_msg,
147+
linter
148+
)
149+
131150
# but not valid usage
132-
expect_lint("filter(x, y < mean(y, na.rm = AA && BB))", NULL, linter)
133-
expect_lint("subset(x, y < mean(y, na.rm = AA && BB) & y > 0)", NULL, linter)
134-
expect_lint("subset(x, y < x[y > 0, drop = AA && BB, y])", NULL, linter)
151+
expect_no_lint("filter(x, y < mean(y, na.rm = AA && BB))", linter)
152+
expect_no_lint("subset(x, y < mean(y, na.rm = AA && BB) & y > 0)", linter)
153+
expect_no_lint("subset(x, y < x[y > 0, drop = AA && BB, y])", linter)
135154
})
136155

137156
test_that("filter() handling is conservative about stats::filter()", {
138157
linter <- vector_logic_linter()
139158
and_msg <- rex::rex("Use `&` in subsetting expressions")
140159

141160
# NB: this should be invalid, filter= is a vector argument
142-
expect_lint("stats::filter(x, y && z)", NULL, linter)
161+
expect_no_lint("stats::filter(x, y && z)", linter)
143162
# The only logical argument to stats::filter(), exclude by keyword
144-
expect_lint("filter(x, circular = y && z)", NULL, linter)
163+
expect_no_lint("filter(x, circular = y && z)", linter)
145164
# But presence of circular= doesn't invalidate lint
146165
expect_lint("filter(x, circular = TRUE, y && z)", and_msg, linter)
147166
expect_lint("filter(x, y && z, circular = TRUE)", and_msg, linter)
148-
expect_lint(
167+
expect_no_lint(
149168
trim_some("
150169
filter(x, circular # comment
151170
= y && z)
152171
"),
153-
NULL,
154172
linter
155173
)
156-
expect_lint(
174+
expect_no_lint(
157175
trim_some("
158176
filter(x, circular = # comment
159177
y && z)
160178
"),
161-
NULL,
162179
linter
163180
)
164-
expect_lint(
181+
expect_no_lint(
165182
trim_some("
166183
filter(x, circular # comment
167184
= # comment
168185
y && z)
169186
"),
170-
NULL,
171187
linter
172188
)
173189
})

0 commit comments

Comments
 (0)