# styler: off
test_that("styles are correctly identified", {
do_style_check <- function(nms) lapply(unname(style_regexes), lintr:::check_style, nms = nms)
# symbl UpC lowC snake SNAKE dot alllow ALLUP
expect_identical(do_style_check("x"), list(FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE))
expect_identical(do_style_check(".x"), list(FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE))
expect_identical(do_style_check("X"), list(FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE))
expect_identical(do_style_check("x."), list(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("X."), list(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("x_"), list(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("X_"), list(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("xy"), list(FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE))
expect_identical(do_style_check("xY"), list(FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("Xy"), list(FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("XY"), list(FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE))
expect_identical(do_style_check("x1"), list(FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE))
expect_identical(do_style_check("X1"), list(FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE))
expect_identical(do_style_check("x_y"), list(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("X_Y"), list(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("X.Y"), list(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("x_2"), list(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("X_2"), list(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("x.2"), list(FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE))
expect_identical(do_style_check("X.2"), list(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
# symbl UpC lowC snake SNAKE dot alllow ALLUP
expect_identical(do_style_check("IHave1Cat"), list(FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("iHave1Cat"), list(FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("i_have_1_cat"), list(FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("I_HAVE_1_CAT"), list(FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("i.have.1.cat"), list(FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE))
expect_identical(do_style_check("ihave1cat"), list(FALSE, FALSE, TRUE, TRUE, FALSE, TRUE, TRUE, FALSE))
expect_identical(do_style_check("IHAVE1CAT"), list(FALSE, TRUE, FALSE, FALSE, TRUE, FALSE, FALSE, TRUE))
expect_identical(do_style_check("I.HAVE_ONECAT"), list(FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("."), list(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
expect_identical(do_style_check("%^%"), list(TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE))
})
# styler: on
test_that("linter ignores some objects", {
# names for which style check is ignored
expect_lint("`%X%` <- t", NULL, object_name_linter("SNAKE_CASE")) # operator
expect_lint("`%x%` <- t", NULL, object_name_linter("snake_case")) # operator
expect_lint("`t.test` <- t", NULL, object_name_linter("UPPERCASE")) # std pkg
expect_lint(".Deprecated('x')", NULL, object_name_linter("lowercase")) # std pkg
expect_lint("print.foo <- t", NULL, object_name_linter("CamelCase")) # S3 generic
expect_lint("names.foo <- t", NULL, object_name_linter("CamelCase")) # int generic
expect_lint("sapply(x,f,USE.NAMES=T)", NULL, object_name_linter("snake_case")) # defined elsewhere
expect_lint(".onLoad <- function(...) TRUE", NULL, object_name_linter("snake_case")) # namespace hooks, #500
expect_lint(".First <- function(...) TRUE", NULL, object_name_linter("snake_case")) # namespace hooks
expect_lint("`%++%` <- `+`", NULL, object_name_linter("symbols")) # all-symbol operator
expect_lint("`%<-%` <- `+`", NULL, object_name_linter("symbols")) # all-symbol operator #495
# S3 group generic, #1841
expect_lint(
"`==.snake_case` <- function(a, b) unclass(a) == unclass(b)",
NULL,
object_name_linter("snake_case")
)
})
test_that("linter returns correct linting", {
lint_msg <- "Variable and function name style should match camelCase."
linter <- object_name_linter("camelCase")
expect_lint("myObject <- 123", NULL, linter)
expect_lint("`myObject` <- 123", NULL, linter)
expect_lint("my.confused_NAME <- 1;", list(message = lint_msg, line_number = 1L, column_number = 1L), linter)
expect_lint("1 ->> read.data.frame;", list(message = lint_msg, line_number = 1L, column_number = 7L), linter)
expect_lint(
"object_name_linter <- function(...) {}",
list(message = lint_msg, line_number = 1L, column_number = 1L), linter
)
expect_lint(
"Z = sapply('function', function(x=function(x){1}, b.a.z=F, ...){identity(b.a.z)}, USE.NAMES=TRUE)",
list(
list(message = lint_msg, line_number = 1L, column_number = 1L),
list(message = lint_msg, line_number = 1L, column_number = 51L)
),
linter
)
expect_lint("blah", NULL, linter)
expect_lint("invokeRestartInteractively", NULL, linter)
expect_lint("camelCase", NULL, linter)
expect_lint("camelCase()", NULL, linter)
expect_lint("pack::camelCase", NULL, linter)
expect_lint("pack:::camelCase", NULL, linter)
expect_lint("a(camelCase = 1)", NULL, linter)
expect_lint("a$b <- 1", NULL, linter)
})
test_that("linter accepts vector of styles", {
lint_msg <- "Variable and function name style should match camelCase or dotted.case."
linter <- object_name_linter(styles = c("camelCase", "dotted.case"))
expect_lint(
"var.one <- 1\nvarTwo <- 2\nvar_three <- 3",
list(message = lint_msg, line_number = 3L, column_number = 1L),
linter
)
})
test_that("dollar subsetting only lints the first expression", {
# Regression test for #582
linter <- object_name_linter()
lint_msg <- rex::rex("Variable and function name style should match snake_case or symbols.")
expect_lint("my_var$MY_COL <- 42L", NULL, linter)
expect_lint("MY_VAR$MY_COL <- 42L", lint_msg, linter)
expect_lint("my_var@MY_SUB <- 42L", NULL, linter)
expect_lint("MY_VAR@MY_SUB <- 42L", lint_msg, linter)
})
patrick::with_parameters_test_that(
"nested extraction only lints on the first symbol",
expect_lint(
sprintf("%s%sMY_SUB%sMY_COL <- 42L", if (should_lint) "MY_VAR" else "my_var", op1, op2),
if (should_lint) rex::rex("Variable and function name style should match snake_case or symbols."),
object_name_linter()
),
.cases = within(
expand.grid(should_lint = c(TRUE, FALSE), op1 = c("$", "@"), op2 = c("$", "@"), stringsAsFactors = FALSE),
{
.test_name <- sprintf("(should lint? %s, op1=%s, op2=%s)", should_lint, op1, op2)
}
)
)
test_that("assignment targets of compound lhs are correctly identified", {
linter <- object_name_linter()
lint_msg <- "Variable and function name style should match snake_case or symbols."
# (recursive) [, $, and [[ subsetting
expect_lint("good_name[badName] <- badName2", NULL, linter)
expect_lint("good_name[1L][badName] <- badName2", NULL, linter)
expect_lint("good_name[[badName]] <- badName2", NULL, linter)
expect_lint("good_name[[1L]][[badName]] <- badName2", NULL, linter)
expect_lint("good_name[[fun(badName)]] <- badName2", NULL, linter)
expect_lint("good_name[[badName]]$badName2 <- badName3", NULL, linter)
expect_lint("good_name$badName[[badName2]][badName3]$badName4 <- badName5", NULL, linter)
expect_lint("badName[badName] <- badName2", lint_msg, linter)
expect_lint("badName[1L][badName] <- badName2", lint_msg, linter)
expect_lint("badName[[badName]] <- badName2", lint_msg, linter)
expect_lint("badName[[1L]][[badName]] <- badName2", lint_msg, linter)
expect_lint("badName[[fun(badName)]] <- badName2", lint_msg, linter)
expect_lint("badName[[badName]]$badName2 <- badName3", lint_msg, linter)
expect_lint("badName$badName[[badName2]][badName3]$badName4 <- badName5", lint_msg, linter)
# setters
expect_lint("setter(badName) <- good_name", lint_msg, linter)
expect_lint("setter(good_name[[badName]]) <- good_name2", NULL, linter)
# quotation
expect_lint("\"good_name\" <- 42", NULL, linter)
expect_lint("\"badName\" <- 42", lint_msg, linter)
expect_lint("'good_name' <- 42", NULL, linter)
expect_lint("'badName' <- 42", lint_msg, linter)
expect_lint("`good_name` <- 42", NULL, linter)
expect_lint("`badName` <- 42", lint_msg, linter)
# subsetting with quotation
expect_lint("good_name$\"badName\" <- 42", NULL, linter)
expect_lint("good_name$'badName' <- 42", NULL, linter)
expect_lint("badName$\"good_name\" <- 42", lint_msg, linter)
expect_lint("badName$'good_name' <- 42", lint_msg, linter)
expect_lint("`badName`$\"good_name\" <- 42", lint_msg, linter)
expect_lint("`badName`$'good_name' <- 42", lint_msg, linter)
})
test_that("object_name_linter won't fail if an imported namespace is unavailable", {
expect_length(
lint_package(test_path("dummy_packages", "missing_dep"), linters = object_name_linter(), parse_settings = FALSE),
3L
)
})
test_that("object_name_linter supports custom regexes", {
# disables default styles
linter <- object_name_linter(
regexes = c(shinyModule = rex::rex(start, lower, zero_or_more(alnum), "UI" %or% "Server", end))
)
msg <- rex::rex("Variable and function name style should match shinyModule.")
linter2 <- object_name_linter(
styles = c("snake_case", "symbols"),
regexes = c(shinyModule = rex::rex(start, lower, zero_or_more(alnum), "UI" %or% "Server", end))
)
msg2 <- rex::rex("Variable and function name style should match snake_case, symbols or shinyModule.")
# Can't allow 0 styles
expect_error(
object_name_linter(NULL),
rex::rex("At least one style must be specified using `styles` or `regexes`.")
)
expect_lint(
trim_some('
snake_case <- 42L
"%+%" <- function(...) ..1 + ..2
myModuleUI <- function(id) {
# blah
}
myModuleServer <- function(id) {
# blah
}
myBadName <- 20L
'),
list(
list(line_number = 1L, message = msg),
list(line_number = 2L, message = msg),
# argument "id" is linted if we only allow shinyModule names
list(line_number = 4L, column_number = 24L, message = msg),
list(line_number = 8L, column_number = 28L, message = msg),
list(line_number = 12L, message = msg)
),
linter
)
expect_lint(
trim_some('
snake_case <- 42L
"%+%" <- function(...) ..1 + ..2
myModuleUI <- function(id) {
# blah
}
myModuleServer <- function(id) {
# blah
}
myBadName <- 20L
'),
list(line_number = 12L, message = msg2),
linter2
)
# Default regex naming works
expect_lint(
trim_some("
a <- 42L
b <- 1L
c <- 2L
"),
list(line_number = 3L, message = rex::rex("Variable and function name style should match /^a$/ or /^b$/.")),
object_name_linter(regexes = c("^a$", "^b$"))
)
expect_lint(
trim_some("
a <- 42L
b <- 1L
c <- 2L
"),
list(line_number = 3L, message = rex::rex("Variable and function name style should match a or /^b$/.")),
object_name_linter(regexes = c(a = "^a$", "^b$"))
)
})
test_that("complex LHS of := doesn't cause false positive", {
# "_l" would be included under previous logic which tried ancestor::expr[ASSIGN] for STR_CONST,
# but only parent::expr[ASSIGN] is needed for strings.
expect_lint('dplyr::mutate(df, !!paste0(v, "_l") := df$a * 2)', NULL, object_name_linter())
})
test_that("function shorthand also lints", {
skip_if_not_r_version("4.1.0")
expect_lint("aBc <- \\() NULL", "function name style", object_name_linter())
})
test_that("capture groups in style are fine", {
expect_lint("a <- 1\nab <- 2", NULL, object_name_linter(regexes = c(capture = "^(a)")))
expect_lint("ab <- 1\nabc <- 2", NULL, object_name_linter(regexes = c(capture = "^(a)(b)")))
})
test_that("rlang name injection is handled", {
linter <- object_name_linter()
expect_lint('tibble("{name}" := 2)', NULL, linter)
expect_lint('x %>% mutate("{name}" := 2)', NULL, linter)
expect_lint('DT[, "{name}" := 2]', "style should match snake_case", linter)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.