diff --git a/.lintr b/.lintr index a9af68366..0606b645f 100644 --- a/.lintr +++ b/.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, diff --git a/NEWS.md b/NEWS.md index db76f264c..830f8be46 100644 --- a/NEWS.md +++ b/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). diff --git a/R/brace_linter.R b/R/brace_linter.R index eebdb90ec..7eda5a714 100644 --- a/R/brace_linter.R +++ b/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])]" diff --git a/R/lint.R b/R/lint.R index e7915d856..541006dd7 100644 --- a/R/lint.R +++ b/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) diff --git a/R/missing_argument_linter.R b/R/missing_argument_linter.R index 3565ab5db..79b62841b 100644 --- a/R/missing_argument_linter.R +++ b/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( diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index 5d222e232..443c73bc3 100644 --- a/R/object_usage_linter.R +++ b/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.", diff --git a/R/shared_constants.R b/R/shared_constants.R index 8e6255f20..d581c7e35 100644 --- a/R/shared_constants.R +++ b/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 glue_call_xpath <- " descendant::SYMBOL_FUNCTION_CALL[text() = 'glue'] diff --git a/R/todo_comment_linter.R b/R/todo_comment_linter.R index 8b7169bae..16e1de05f 100644 --- a/R/todo_comment_linter.R +++ b/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" diff --git a/R/xp_utils.R b/R/xp_utils.R index 621bc13b4..b96a39f57 100644 --- a/R/xp_utils.R +++ b/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(":)")), ":)" diff --git a/man/lint.Rd b/man/lint.Rd index 54d1bbe48..efc4d2925 100644 --- a/man/lint.Rd +++ b/man/lint.Rd @@ -2,7 +2,6 @@ % Please edit documentation in R/lint.R \name{lint} \alias{lint} -\alias{lint_file} \alias{lint_dir} \alias{lint_package} \title{Lint a file, directory, or package} diff --git a/man/todo_comment_linter.Rd b/man/todo_comment_linter.Rd index e2c92aa68..24b730eab 100644 --- a/man/todo_comment_linter.Rd +++ b/man/todo_comment_linter.Rd @@ -4,10 +4,13 @@ \alias{todo_comment_linter} \title{TODO comment linter} \usage{ -todo_comment_linter(todo = c("todo", "fixme")) +todo_comment_linter(todo = c("todo", "fixme"), except_regex = NULL) } \arguments{ \item{todo}{Vector of case-insensitive strings that identify TODO comments.} + +\item{except_regex}{Vector of case-sensitive regular expressions that identify +\emph{valid} TODO comments.} } \description{ Check that the source contains no TODO comments (case-insensitive). @@ -29,6 +32,11 @@ lint( linters = todo_comment_linter(todo = c("todo", "fixme", "hack")) ) +lint( + text = "x <- TRUE # TODO(#1234): Fix this hack.", + linters = todo_comment_linter() +) + # okay lint( text = "x + y # my informative comment", @@ -45,6 +53,11 @@ lint( linters = todo_comment_linter() ) +lint( + text = "x <- TRUE # TODO(#1234): Fix this hack.", + linters = todo_comment_linter(except_regex = "TODO\\\\(#[0-9]+\\\\):") +) + } \seealso{ \link{linters} for a complete list of linters available in lintr. diff --git a/tests/testthat/test-todo_comment_linter.R b/tests/testthat/test-todo_comment_linter.R index 5a8c8e98f..103f9c8fc 100644 --- a/tests/testthat/test-todo_comment_linter.R +++ b/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]+\\):")) + ) +})