re_matches_logical helper ensures logical output of re_matches_logical (

#2679)

* re_matches_logical helper ensures logical output of re_matches_logical

* fix broken test

* Tests

* missed roxygenize()

* add NEWS item

* Change in expect_lint() is also user-visible, so tweak NEWS

NAMESPACE

@@ -176,6 +176,7 @@ importFrom(rex,re_matches)
 importFrom(rex,re_substitutes)
 importFrom(rex,regex)
 importFrom(rex,rex)
+importFrom(stats,complete.cases)
 importFrom(stats,na.omit)
 importFrom(tools,R_user_dir)
 importFrom(utils,capture.output)

NEWS.md

@@ -94,6 +94,7 @@
 * All user-facing messages are now prepared using the `{cli}` package (#2418, @IndrajeetPatil). All messages have been reviewed and updated to be more informative and consistent.
 * File locations in lints and error messages contain clickable hyperlinks to improve code navigation (#2645, #2588, @olivroy).
 * {lintr} now depends on R version 4.0.0. It already does so implicitly due to recursive upstream dependencies requiring this version; we've simply made that dependency explicit and up-front (#2569, @MichaelChirico).
+* Some code with parameters accepting regular expressions is less strict about whether there are capture groups  (#2678, @MichaelChirico). In particular, this affects `unreachable_code_linter(allow_comment_regex=)` and `expect_lint(checks=)`.
 
 # lintr 3.1.2
 

R/expect_lint.R

@@ -105,16 +105,10 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en") {
           )
           # deparse ensures that NULL, list(), etc are handled gracefully
           ok <- if (field == "message") {
-            re_matches(value, check)
+            re_matches_logical(value, check)
           } else {
             isTRUE(all.equal(value, check))
           }
-          if (!is.logical(ok)) {
-            cli_abort(c(
-              x = "Invalid regex result. Did you mistakenly have a capture group in the regex?",
-              i = "You can match parentheses with a character class, i.e. inside `[]`."
-            ))
-          }
           testthat::expect(ok, msg)
         })
       },

R/lintr-package.R

@@ -11,7 +11,7 @@
 #' @importFrom cli cli_inform cli_abort cli_warn
 #' @importFrom glue glue glue_collapse
 #' @importFrom rex rex regex re_matches re_substitutes character_class
-#' @importFrom stats na.omit
+#' @importFrom stats complete.cases na.omit
 #' @importFrom tools R_user_dir
 #' @importFrom utils capture.output getParseData getTxtProgressBar globalVariables head relist
 #'   setTxtProgressBar tail txtProgressBar

R/object_name_linter.R

@@ -146,13 +146,8 @@ object_name_linter <- function(styles = c("snake_case", "symbols"), regexes = ch
 }
 
 check_style <- function(nms, style, generics = character()) {
-  conforming <- re_matches(nms, style)
+  conforming <- re_matches_logical(nms, style)
 
-  # style has capture group(s)
-  if (is.data.frame(conforming)) {
-    # if any group is missing, all groups are missing, so just check the first column
-    conforming <- !is.na(conforming[[1L]])
-  }
   # mark empty or NA names as conforming
   conforming <- is.na(nms) | !nzchar(nms) | conforming
 

R/return_linter.R

@@ -147,7 +147,8 @@ return_linter <- function(
     xml <- source_expression$xml_parsed_content
     if (defer_except) {
       assigned_functions <- xml_text(xml_find_all(xml, function_name_xpath))
-      except <- union(except, assigned_functions[re_matches(assigned_functions, except_regex)])
+      except <-
+        union(except, assigned_functions[re_matches_logical(assigned_functions, except_regex)])
       except_xpath <- glue(except_xpath_fmt, except = except)
       body_xpath <- glue(body_xpath_fmt, except_xpath = except_xpath)
     }

R/todo_comment_linter.R

@@ -57,9 +57,9 @@ todo_comment_linter <- function(todo = c("todo", "fixme"), except_regex = NULL)
 
     comment_expr <- xml_find_all(xml, "//COMMENT")
     comment_text <- xml_text(comment_expr)
-    invalid_todo <- re_matches(comment_text, todo_comment_regex, ignore.case = TRUE)
+    invalid_todo <- re_matches_logical(comment_text, todo_comment_regex, ignore.case = TRUE)
     if (!is.null(valid_todo_regex)) {
-      invalid_todo <- invalid_todo & !re_matches(comment_text, valid_todo_regex)
+      invalid_todo <- invalid_todo & !re_matches_logical(comment_text, valid_todo_regex)
     }
 
     xml_nodes_to_lints(

R/unreachable_code_linter.R

@@ -130,7 +130,7 @@ unreachable_code_linter <- function(allow_comment_regex = getOption("covr.exclud
 
   drop_valid_comments <- function(expr, valid_comment_re) {
     is_valid_comment <- xml2::xml_name(expr) == "COMMENT" &
-      re_matches(xml_text(expr), valid_comment_re)
+      re_matches_logical(xml_text(expr), valid_comment_re)
     expr[!is_valid_comment]
   }
 

R/utils.R

@@ -195,6 +195,17 @@ release_bullets <- function() {
 platform_independent_order <- function(x) order(tolower(x), method = "radix")
 platform_independent_sort <- function(x) x[platform_independent_order(x)]
 
+#' re_matches with type-stable logical output
+#' TODO(r-lib/rex#94): Use re_matches() option directly & deprecate this.
+#' @noRd
+re_matches_logical <- function(x, regex, ...) {
+  res <- re_matches(x, regex, ...)
+  if (is.data.frame(res)) {
+    res <- complete.cases(res)
+  }
+  res
+}
+
 #' Extract text from `STR_CONST` nodes
 #'
 #' Convert `STR_CONST` `text()` values into R strings. This is useful to account for arbitrary

tests/testthat/test-expect_lint.R

@@ -30,7 +30,7 @@ test_that("single check", {
   expect_success(expect_lint("a=1", list(message = lint_msg, line_number = 1L), linter))
   expect_failure(expect_lint("a=1", list(2L, lint_msg), linter))
 
-  expect_error(expect_lint("1:nrow(x)", "(group)", seq_linter()), "Invalid regex result", fixed = TRUE)
+  expect_success(expect_lint("1:nrow(x)", "(nrow)", seq_linter()))
 })
 
 test_that("multiple checks", {

tests/testthat/test-return_linter.R

@@ -691,6 +691,20 @@ test_that("except_regex= argument works", {
     list(rex::rex("All functions must have an explicit return()."), line_number = 5L),
     linter
   )
+
+  # capture group doesn't cause issues, #2678
+  expect_lint(
+    trim_some("
+      TestFun <- function() {
+        non_return()
+      }
+      AssertFun <- function() {
+        non_return()
+      }
+    "),
+    NULL,
+    return_linter(return_style = "explicit", except_regex = "^(Test|Assert)")
+  )
 })
 
 test_that("except= and except_regex= combination works", {

tests/testthat/test-todo_comment_linter.R

@@ -57,4 +57,11 @@ test_that("except_regex= excludes valid TODO", {
     NULL,
     todo_comment_linter(except_regex = c("TODO\\(#[0-9]+\\):", "fixme\\(#[0-9]+\\):"))
   )
+
+  # ignore captured groups
+  expect_lint(
+    "# TODO(a)",
+    NULL,
+    todo_comment_linter(except_regex = "TODO\\((a|abc)\\)")
+  )
 })

tests/testthat/test-unreachable_code_linter.R

@@ -687,6 +687,19 @@ test_that("allow_comment_regex= works", {
     NULL,
     linter_x1x2
   )
+
+  # might contain capture groups, #2678
+  expect_lint(
+    trim_some("
+      function() {
+        stop('a')
+        # a
+        # ab
+      }
+    "),
+    NULL,
+    unreachable_code_linter(allow_comment_regex = "#\\s*(a|ab|abc)")
+  )
 })
 
 test_that("allow_comment_regex= obeys covr's custom exclusion when set", {