1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
|
test_that("function_return_linter skips allowed usages", {
lines_simple <- trim_some("
foo <- function(x) {
x <- x + 1
return(x)
}
")
expect_lint(lines_simple, NULL, function_return_linter())
# arguably an expression as complicated as this should also be assigned,
# but for now that's out of the scope of this linter
lines_subassignment <- trim_some("
foo <- function(x) {
return(x[, {
col <- col + 1
.(grp, col)
}])
}
")
expect_lint(lines_subassignment, NULL, function_return_linter())
})
test_that("function_return_linter blocks simple disallowed usages", {
linter <- function_return_linter()
lint_msg <- rex::rex("Move the assignment outside of the return() clause")
expect_lint(
trim_some("
foo <- function(x) {
return(x <- x + 1)
}
"),
lint_msg,
linter
)
expect_lint(
trim_some("
foo <- function(x) {
return(x <<- x + 1)
}
"),
lint_msg,
linter
)
expect_lint(
trim_some("
foo <- function(x) {
return(x + 1 ->> x)
}
"),
lint_msg,
linter
)
expect_lint(
trim_some("
foo <- function(x) {
return(x + 1 -> x)
}
"),
lint_msg,
linter
)
side_effect_lines <- expect_lint(
trim_some("
e <- new.env()
foo <- function(x) {
return(e$val <- x + 1)
}
"),
lint_msg,
linter
)
})
test_that("lints vectorize", {
linter <- function_return_linter()
lint_msg <- rex::rex("Move the assignment outside of the return() clause")
expect_lint(
trim_some("{
function() {
return(x <- 1)
}
function() {
return(y <- 2)
}
}"),
list(
list(lint_msg, line_number = 3L),
list(lint_msg, line_number = 6L)
),
function_return_linter()
)
})
|
