except_regex argument for todo_comment_linter() to skip valid TODO comments

.lintr

@@ -2,6 +2,18 @@ linters: all_linters(
     backport_linter("3.6.0", except = c("R_user_dir", "deparse1", "...names")),
     line_length_linter(120L),
     object_overwrite_linter(allow_names = c("line", "lines", "pipe", "symbols")),
+    todo_comment_linter(
+      except_regex = rex::rex(
+        "TODO(",
+        group(or(
+          # GitHub issue number #1234, possibly from another repo org/repo#5678
+          list(maybe(one_or_more(alnum, "-"), "/", one_or_more(alnum, ".", "-", "_")), "#", one_or_more(digit)),
+          # GitHub user. TODO(#2450): remove this temporary immunity
+          one_or_more(alnum, "-")
+        )),
+        ")"
+      )
+    ),
     undesirable_function_linter(modify_defaults(
       defaults = default_undesirable_functions,
       library = NULL,

NEWS.md

@@ -43,6 +43,7 @@
 * `format()` and `print()` methods for `lint` and `lints` classes get a new option `width` to control the printing width of lint messages (#1884, @MichaelChirico). The default is controlled by a new option `lintr.format_width`; if unset, no wrapping occurs (matching earlier behavior).
 * `implicit_assignment_linter()` gets a custom message for the case of using `(` to induce printing like `(x <- foo())`; use an explicit call to `print()` for clarity (#2257, @MichaelChirico).
 * New function node caching for big efficiency gains to most linters (e.g. overall `lint_package()` improvement of 14-27% and core linting improvement up to 30%; #2357, @AshesITR). Most linters are written around function usage, and XPath performance searching for many functions is poor. The new `xml_find_function_calls()` entry in the `get_source_expressions()` output caches all function call nodes instead. See the vignette on creating linters for more details on how to use it.
+* `todo_comment_linter()` has a new argument `except_regex` for setting _valid_ TODO comments, e.g. for forcing TODO comments to be linked to GitHub issues like `TODO(#154)` (#2047, @MichaelChirico).
 * `vector_logic_linter()` is extended to recognize incorrect usage of scalar operators `&&` and `||` inside subsetting expressions like `dplyr::filter(x, A && B)` (#2166, @MichaelChirico).
 * `any_is_na_linter()` is extended to catch the unusual usage `NA %in% x` (#2113, @MichaelChirico).
 

R/brace_linter.R

@@ -74,7 +74,7 @@ brace_linter <- function(allow_single_line = FALSE) {
     )")
   ))
 
-  # TODO (AshesITR): if c_style_braces is TRUE, invert the preceding-sibling condition
+  # TODO(#1103): if c_style_braces is TRUE, invert the preceding-sibling condition
   xp_open_curly <- glue("//OP-LEFT-BRACE[
     { xp_cond_open }
     and (
@@ -109,7 +109,7 @@ brace_linter <- function(allow_single_line = FALSE) {
     )"
   ))
 
-  # TODO (AshesITR): if c_style_braces is TRUE, skip the not(ELSE) condition
+  # TODO(#1103): if c_style_braces is TRUE, skip the not(ELSE) condition
   xp_closed_curly <- glue("//OP-RIGHT-BRACE[
     { xp_cond_closed }
     and (
@@ -121,7 +121,7 @@ brace_linter <- function(allow_single_line = FALSE) {
   xp_else_closed_curly <- "preceding-sibling::IF/following-sibling::expr[2]/OP-RIGHT-BRACE"
   # need to (?) repeat previous_curly_path since != will return true if there is
   #   no such node. ditto for approach with not(@line1 = ...).
-  # TODO (AshesITR): if c_style_braces is TRUE, this needs to be @line2 + 1
+  # TODO(#1103): if c_style_braces is TRUE, this needs to be @line2 + 1
   xp_else_same_line <- glue("//ELSE[{xp_else_closed_curly} and @line1 != {xp_else_closed_curly}/@line2]")
 
   xp_function_brace <- "(//FUNCTION | //OP-LAMBDA)/parent::expr[@line1 != @line2 and not(expr[OP-LEFT-BRACE])]"

R/lint.R

@@ -24,8 +24,6 @@
 #' @param text Optional argument for supplying a string or lines directly, e.g. if the file is already in memory or
 #'   linting is being done ad hoc.
 #'
-#' @aliases lint_file
-# TODO(next release after 3.0.0): remove the alias
 #' @return An object of class `c("lints", "list")`, each element of which is a `"list"` object.
 #'
 #' @examplesIf requireNamespace("withr", quietly = TRUE)

R/missing_argument_linter.R

@@ -58,7 +58,7 @@ missing_argument_linter <- function(except = c("alist", "quote", "switch"), allo
     named_idx <- xml_name(missing_args) == "EQ_SUB"
     arg_id <- character(length(missing_args))
     arg_id[named_idx] <- sQuote(xml_find_chr(missing_args[named_idx], "string(preceding-sibling::SYMBOL_SUB[1])"), "'")
-    # TODO(r-lib/xml2#412-->CRAN): use xml_find_int() instead
+    # TODO(#2452): use xml_find_int() instead
     arg_id[!named_idx] <- xml_find_num(missing_args[!named_idx], "count(preceding-sibling::OP-COMMA)") + 1.0
 
     xml_nodes_to_lints(

R/object_usage_linter.R

@@ -87,8 +87,6 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) {
         skip_with = skip_with
       )
 
-      # TODO handle assignment functions properly
-      # e.g. `not_existing<-`(a, b)
       res$name <- re_substitutes(res$name, rex("<-"), "")
 
       lintable_symbols <- xml_find_all(fun_assignment, xpath_culprit_symbol)
@@ -211,7 +209,7 @@ parse_check_usage <- function(expression,
   # nocov start
   is_missing <- is.na(res$message)
   if (any(is_missing)) {
-    # TODO (AshesITR): Remove this in the future, if no bugs arise from this safeguard
+    # TODO(AshesITR): Remove this in the future, if no bugs arise from this safeguard
     warning(
       "Possible bug in lintr: Couldn't parse usage message ", sQuote(vals[is_missing][[1L]]), ". ",
       "Ignoring ", sum(is_missing), " usage warnings. Please report an issue at https://github.com/r-lib/lintr/issues.",

R/shared_constants.R

@@ -243,18 +243,7 @@ extract_glued_symbols <- function(expr, interpret_glue) {
   if (!isTRUE(interpret_glue)) {
     return(character())
   }
-  # TODO support more glue functions
-  # Package glue:
-  #  - glue_sql
-  #  - glue_safe
-  #  - glue_col
-  #  - glue_data
-  #  - glue_data_sql
-  #  - glue_data_safe
-  #  - glue_data_col
-  #
-  # Package stringr:
-  #  - str_interp
+  # TODO(#2448): support more glue functions
   # NB: position() > 1 because position=1 is <expr><SYMBOL_FUNCTION_CALL>
   glue_call_xpath <- "
     descendant::SYMBOL_FUNCTION_CALL[text() = 'glue']

R/todo_comment_linter.R

@@ -3,22 +3,24 @@
 #' Check that the source contains no TODO comments (case-insensitive).
 #'
 #' @param todo Vector of case-insensitive strings that identify TODO comments.
+#' @param except_regex Vector of case-sensitive regular expressions that identify
+#'    _valid_ TODO comments.
 #'
 #' @examples
 #' # will produce lints
 #' lint(
-#'   text = "x + y # TODO",
-#'   linters = todo_comment_linter()
+#'   text = "x + y # TOODOO",
+#'   linters = todo_comment_linter(todo = "toodoo")
 #' )
 #'
 #' lint(
-#'   text = "pi <- 1.0 # FIXME",
-#'   linters = todo_comment_linter()
+#'   text = "pi <- 1.0 # FIIXMEE",
+#'   linters = todo_comment_linter(todo = "fiixmee")
 #' )
 #'
 #' lint(
-#'   text = "x <- TRUE # hack",
-#'   linters = todo_comment_linter(todo = c("todo", "fixme", "hack"))
+#'   text = "x <- TRUE # TOODOO(#1234): Fix this hack.",
+#'   linters = todo_comment_linter()
 #' )
 #'
 #' # okay
@@ -37,20 +39,31 @@
 #'   linters = todo_comment_linter()
 #' )
 #'
+#' lint(
+#'   text = "x <- TRUE # TODO(#1234): Fix this hack.",
+#'   linters = todo_comment_linter(except_regex = "TODO\\(#[0-9]+\\):")
+#' )
+#'
 #' @evalRd rd_tags("todo_comment_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-todo_comment_linter <- function(todo = c("todo", "fixme")) {
+todo_comment_linter <- function(todo = c("todo", "fixme"), except_regex = NULL) {
   todo_comment_regex <- rex(one_or_more("#"), any_spaces, or(todo))
+  valid_todo_regex <-
+    if (!is.null(except_regex)) paste0("#+", rex::shortcuts$any_spaces, "(?:", paste(except_regex, collapse = "|"), ")")
 
   Linter(linter_level = "expression", function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     comment_expr <- xml_find_all(xml, "//COMMENT")
-    are_todo <- re_matches(xml_text(comment_expr), todo_comment_regex, ignore.case = TRUE)
+    comment_text <- xml_text(comment_expr)
+    invalid_todo <- re_matches(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)
+    }
 
     xml_nodes_to_lints(
-      comment_expr[are_todo],
+      comment_expr[invalid_todo],
       source_expression = source_expression,
       lint_message = "Remove TODO comments.",
       type = "style"

R/xp_utils.R

@@ -118,7 +118,7 @@ xp_find_location <- function(xml, xpath) {
 #'   way to XPath 2.0-ish support by writing this simple function to remove comments.
 #'
 #' @noRd
-xpath_comment_re <- rex::rex(
+xpath_comment_re <- rex(
   "(:",
   zero_or_more(not(":)")),
   ":)"

tests/testthat/test-todo_comment_linter.R

@@ -1,8 +1,8 @@
 test_that("returns the correct linting", {
-  linter <- todo_comment_linter(todo = c("todo", "fixme"))
+  linter <- todo_comment_linter()
   lint_msg <- rex::rex("Remove TODO comments.")
 
-  expect_lint("a <- \"you#need#to#fixme\"", NULL, linter)
+  expect_lint('a <- "you#need#to#fixme"', NULL, linter)
   expect_lint("# something todo", NULL, linter)
   expect_lint(
     "cat(x) ### fixme",
@@ -15,11 +15,46 @@ test_that("returns the correct linting", {
     linter
   )
   expect_lint(
-    "function() {\n# TODO\n  function() {\n  # fixme\n  }\n}",
+    trim_some("
+      function() {
+        # TODO
+        function() {
+          # fixme
+        }
+      }
+    "),
     list(
-      list(message = lint_msg, line_number = 2L, column_number = 1L),
-      list(message = lint_msg, line_number = 4L, column_number = 3L)
+      list(message = lint_msg, line_number = 2L, column_number = 3L),
+      list(message = lint_msg, line_number = 4L, column_number = 5L)
     ),
     linter
   )
 })
+
+test_that("except_regex= excludes valid TODO", {
+  linter <- todo_comment_linter(except_regex = "TODO\\(#[0-9]+\\):")
+  lint_msg <- rex::rex("Remove TODO comments.")
+
+  expect_lint("foo() # TODO(#1234): Deprecate foo.", NULL, linter)
+  # Non-excepted lints
+  expect_lint(
+    trim_some("
+      foo() # TODO()
+      bar() # TODO(#567): Deprecate bar.
+    "),
+    list(lint_msg, line_number = 1L),
+    linter
+  )
+  # Only TODO() is excepted
+  mixed_lines <- trim_some("
+    foo() # TODO(#1234): Deprecate foo.
+    bar() # fixme(#567): Deprecate bar.
+  ")
+
+  expect_lint(mixed_lines, list(lint_msg, line_number = 2L), linter)
+  expect_lint(
+    mixed_lines,
+    NULL,
+    todo_comment_linter(except_regex = c("TODO\\(#[0-9]+\\):", "fixme\\(#[0-9]+\\):"))
+  )
+})