New allow_escaped for fixed_regex_linter (#2091)

* new allow_escaped for fixed_regex_linter

* configurable tag

* tighter wording

* invert cto correct

NEWS.md

@@ -27,6 +27,7 @@
 * `conjunct_test_linter()` also lints usage like `dplyr::filter(x, A & B)` in favor of using `dplyr::filter(x, A, B)` (part of #884, @MichaelChirico).
 * `sort_linter()` checks for code like `x == sort(x)` which is better served by using the function `is.unsorted()` (part of #884, @MichaelChirico).
 * `paste_linter()` gains detection for file paths that are better constructed with `file.path()`, e.g. `paste0(dir, "/", file)` would be better as `file.path(dir, file)` (part of #884, @MichaelChirico).
+* `fixed_regex_linter()` gains an option `allow_unescaped` (default `FALSE`) to toggle linting regexes not requiring any escapes or character classes (#1689, @MichaelChirico). Thus `fixed_regex_linter(allow_unescaped = TRUE)` would lint on `grepl("[$]", x)` but not on `grepl("a", x)` since the latter does not use any regex special characters.
 
 ### New linters
 

R/fixed_regex_linter.R

@@ -10,6 +10,8 @@
 #'   likely cases. It should _never_ report false positives, however; please
 #'   report false positives as an error.
 #'
+#' @param allow_unescaped Logical, default `FALSE`. If `TRUE`, only patterns that
+#'   require regex escapes (e.g. `"\\$"` or `"[$]"`) will be linted. See examples.
 #' @examples
 #' # will produce lints
 #' code_lines <- 'gsub("\\\\.", "", x)'
@@ -24,6 +26,11 @@
 #'   linters = fixed_regex_linter()
 #' )
 #'
+#' lint(
+#'   text = 'grepl("a[*]b", x)',
+#'   linters = fixed_regex_linter(allow_unescaped = TRUE)
+#' )
+#'
 #' code_lines <- 'stringr::str_subset(x, "\\\\$")'
 #' writeLines(code_lines)
 #' lint(
@@ -59,10 +66,15 @@
 #'   linters = fixed_regex_linter()
 #' )
 #'
+#' lint(
+#'   text = 'grepl("Munich", address)',
+#'   linters = fixed_regex_linter(allow_unescaped = TRUE)
+#' )
+#'
 #' @evalRd rd_tags("fixed_regex_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-fixed_regex_linter <- function() {
+fixed_regex_linter <- function(allow_unescaped = FALSE) {
   # regular expression pattern is the first argument
   pos_1_regex_funs <- xp_text_in_table(c(
     "grep", "gsub", "sub", "regexec", "grepl", "regexpr", "gregexpr"
@@ -116,7 +128,7 @@ fixed_regex_linter <- function() {
 
     patterns <- xml_find_all(xml, xpath)
     pattern_strings <- get_r_string(patterns)
-    is_static <- is_not_regex(pattern_strings)
+    is_static <- is_not_regex(pattern_strings, allow_unescaped)
 
     fixed_equivalent <- encodeString(get_fixed_string(pattern_strings[is_static]), quote = '"', justify = "none")
     call_name <- xml_find_chr(patterns[is_static], "string(preceding-sibling::expr[last()]/SYMBOL_FUNCTION_CALL)")

R/shared_constants.R

@@ -31,6 +31,7 @@ rx_static_token <- local({
   ))
 })
 
+rx_unescaped_regex <- paste0("(?s)", rex(start, zero_or_more(rx_non_active_char), end))
 rx_static_regex <- paste0("(?s)", rex(start, zero_or_more(rx_static_token), end))
 rx_first_static_token <- paste0("(?s)", rex(start, zero_or_more(rx_non_active_char), rx_static_escape))
 
@@ -47,9 +48,13 @@ rx_first_static_token <- paste0("(?s)", rex(start, zero_or_more(rx_non_active_ch
 #' @return A logical vector, `TRUE` wherever `str` could be replaced by a
 #'   string with `fixed = TRUE`.
 #' @noRd
-is_not_regex <- function(str) {
+is_not_regex <- function(str, allow_unescaped = FALSE) {
   # need to add single-line option to allow literal newlines
-  grepl(rx_static_regex, str, perl = TRUE)
+  if (allow_unescaped) {
+    !grepl(rx_unescaped_regex, str, perl = TRUE)
+  } else {
+    grepl(rx_static_regex, str, perl = TRUE)
+  }
 }
 
 #' Compute a fixed string equivalent to a static regular expression

inst/lintr/linters.csv

@@ -29,7 +29,7 @@ expect_s4_class_linter,package_development best_practices pkg_testthat
 expect_true_false_linter,package_development best_practices readability pkg_testthat
 expect_type_linter,package_development best_practices pkg_testthat
 extraction_operator_linter,style best_practices
-fixed_regex_linter,best_practices readability efficiency
+fixed_regex_linter,best_practices readability efficiency configurable
 for_loop_index_linter,best_practices readability robustness
 function_argument_linter,style consistency best_practices
 function_left_parentheses_linter,style readability default

tests/testthat/test-fixed_regex_linter.R

@@ -345,3 +345,11 @@ patrick::with_parameters_test_that("fixed replacements are correct", {
   "[\\xa]",               "[\\xa]",               "\\n"
 ))
 # styler: on
+
+test_that("'unescaped' regex can optionally be skipped", {
+  linter <- fixed_regex_linter(allow_unescaped = TRUE)
+
+  expect_lint("grepl('a', x)", NULL, linter)
+  expect_lint("str_detect(x, 'a')", NULL, linter)
+  expect_lint("grepl('[$]', x)", rex::rex('Here, you can use "$"'), linter)
+})