object_name_linter: add regexes= argument for custom style regexes

R/object_name_linters.R

@@ -47,11 +47,13 @@ object_name_xpath <- local({
 #' @param regexes A (possibly named) character vector specifying a custom naming convention.
 #'   If named, the names will be used in the lint message. Otherwise, "custom" will be used as a name for the style.
 #'   Quotes (`` `"' ``) and specials (`%` and trailing `<-`) are not considered part of the name to be matched.
+#'   Note that specifying `regexes` overrides the default `styles`. So if you want to combine `regexes` and `styles`,
+#'   both need to be explicitly specified.
 #' @evalRd rd_tags("object_name_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 object_name_linter <- function(styles = c("snake_case", "symbols"), regexes = character()) {
-  if (length(styles) > 0L) {
+  if ((!missing(styles) || missing(regexes)) && length(styles) > 0L) {
     # Allow `object_name_linter(NULL, "my_regex")`
     styles <- match.arg(styles, names(style_regexes), several.ok = TRUE)
     style_list <- style_regexes[styles]
@@ -62,9 +64,10 @@ object_name_linter <- function(styles = c("snake_case", "symbols"), regexes = ch
     if (!is.character(regexes)) {
       stop("`regexes` must be a character vector.")
     }
-    if (is.null(names(regexes))) {
-      names(regexes) <- "custom"
-    }
+    rx_names <- names2(regexes)
+    rx_names[!nzchar(rx_names)] <- "custom"
+    names(regexes) <- rx_names
+
     style_list <- c(style_list, as.list(regexes))
   }
   if (length(style_list) == 0L) {

tests/testthat/test-linter_tags.R

@@ -59,7 +59,7 @@ test_that("available_linters matches the set of linters available from lintr", {
   # ensure that the contents of inst/lintr/linters.csv covers all _linter objects in our namespace
   expect_identical(sort(lintr_db$linter), sort(linters_in_namespace))
   # ensure that all _linter objects in our namespace are also exported
-  exported_linters <- grep("_linter$", getNamespaceExports("lintr"), value = TRUE)
+  exported_linters <- setdiff(grep("_linter$", getNamespaceExports("lintr"), value = TRUE), "is_linter")
   expect_identical(sort(linters_in_namespace), sort(exported_linters))
 })
 

tests/testthat/test-object_name_linter.R

@@ -152,16 +152,16 @@ test_that("object_name_linter won't fail if an imported namespace is unavailable
 })
 
 test_that("object_name_linter supports custom regexes", {
-  # snake_case and symbols also allowed
+  # disables default styles
   linter <- object_name_linter(
     regexes = c("shinyModule" = rex(start, lower, zero_or_more(alnum), "UI" %or% "Server", end))
   )
-  msg <- rex::rex("Variable and function name style should be snake_case, symbols or shinyModule.")
+  msg <- rex::rex("Variable and function name style should be shinyModule.")
   linter2 <- object_name_linter(
-    styles = NULL,
+    styles = c("snake_case", "symbols"),
     regexes = c("shinyModule" = rex(start, lower, zero_or_more(alnum), "UI" %or% "Server", end))
   )
-  msg2 <- rex::rex("Variable and function name style should be shinyModule.")
+  msg2 <- rex::rex("Variable and function name style should be snake_case, symbols or shinyModule.")
 
   # Can't allow 0 styles
   expect_error(
@@ -184,7 +184,14 @@ test_that("object_name_linter supports custom regexes", {
 
       myBadName <- 20L
     "),
-    list(line_number = 12L, message = msg),
+    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
   )
 
@@ -203,14 +210,28 @@ test_that("object_name_linter supports custom regexes", {
 
       myBadName <- 20L
     "),
-    list(
-      list(line_number = 1L, message = msg2),
-      list(line_number = 2L, message = msg2),
-      # argument "id" is linted if we only allow shinyModule names
-      list(line_number = 4L, column_number = 24L, message = msg2),
-      list(line_number = 8L, column_number = 28L, message = msg2),
-      list(line_number = 12L, message = msg2)
-    ),
+    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 be custom.")),
+    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 be a or custom.")),
+    object_name_linter(regexes = c(a = "^a$", "^b$"))
+  )
 })