Merge branch 'main' into f-2386-use-cli

.github/workflows/repo-meta-tests.yaml

@@ -22,6 +22,9 @@ jobs:
  use-public-rspm: true
 
  - uses: r-lib/actions/setup-r-dependencies@v2
+ with:
+ extra-packages: |
+ any::roxygen2
 
  - name: Ensure lint metadata is tested
  run: |

.lintr

@@ -5,12 +5,9 @@ linters: all_linters(
  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, "-")
- )),
+ # GitHub issue number #1234, possibly from another repo org/repo#5678
+ maybe(one_or_more(character_class("a-zA-Z0-9-")), "/", one_or_more(character_class("a-zA-Z0-9._-"))),
+ "#", one_or_more(digit),
  ")"
  )
  ),

DESCRIPTION

@@ -56,7 +56,7 @@ Config/Needs/development: pkgload, cli, testthat, patrick
 Config/testthat/edition: 3
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.1
 Collate:
  'make_linter_from_xpath.R'
  'xp_utils.R'

NEWS.md

@@ -62,7 +62,7 @@
 * `print_linter()` for discouraging usage of `print()` on string literals like `print("Reached here")` or `print(paste("Found", nrow(DF), "rows."))` (#1894, @MichaelChirico).
 * `unnecessary_nesting_linter()` for discouraging overly-nested code where an early return or eliminated sub-expression (inside '{') is preferable (#2317 and part of #884, @MichaelChirico).
 * `consecutive_mutate_linter()` for encouraging consecutive calls to `dplyr::mutate()` to be combined (part of #884, @MichaelChirico).
-* `if_switch_linter()` for encouraging `switch()` over repeated `if`/`else` tests (part of #884, @MichaelChirico).
+* `if_switch_linter()` for encouraging `switch()` over repeated `if`/`else` tests (#2322 and part of #884, @MichaelChirico).
 * `nested_pipe_linter()` for discouraging pipes within pipes, e.g. `df1 %>% inner_join(df2 %>% select(a, b))` (part of #884, @MichaelChirico).
 * `nrow_subset_linter()` for discouraging usage like `nrow(subset(x, conditions))` in favor of something like `with(x, sum(conditions))` which doesn't require a full subset of `x` (#2313, #2314 and part of #884, @MichaelChirico).
 * `pipe_return_linter()` for discouraging usage of `return()` inside a {magrittr} pipeline (part of #884, @MichaelChirico).

R/boolean_arithmetic_linter.R

@@ -63,7 +63,7 @@ boolean_arithmetic_linter <- function() {
  xml_nodes_to_lints(
  any_expr,
  source_expression = source_expression,
- # TODO(michaelchirico): customize this?
+ # TODO(#2464): customize this?
  lint_message = paste(
  "Use any() to express logical aggregations.",
  "For example, replace length(which(x == y)) == 0 with !any(x == y)."

R/expect_length_linter.R

@@ -21,7 +21,7 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 expect_length_linter <- function() {
- # TODO(michaelchirico): also catch expect_true(length(x) == 1)
+ # TODO(#2465): also catch expect_true(length(x) == 1)
  xpath <- sprintf("
  parent::expr
  /following-sibling::expr[

R/get_source_expressions.R

@@ -54,9 +54,11 @@
 #' \item{lines}{The [readLines()] output for this file.}
 #' }
 #'
-#' @examplesIf requireNamespace("withr", quietly = TRUE)
-#' tmp <- withr::local_tempfile(lines = c("x <- 1", "y <- x + 1"))
+#' @examples
+#' tmp <- tempfile()
+#' writeLines(c("x <- 1", "y <- x + 1"), tmp)
 #' get_source_expressions(tmp)
+#' unlink(tmp)
 #' @export
 get_source_expressions <- function(filename, lines = NULL) {
  source_expression <- srcfile(filename, encoding = settings$encoding)

R/ids_with_token.R

@@ -17,11 +17,13 @@
 #' the `token` column of `parsed_content`. Typically `==` or `%in%`.
 #' @param source_file (DEPRECATED) Same as `source_expression`. Will be removed.
 #'
-#' @examplesIf requireNamespace("withr", quietly = TRUE)
-#' tmp <- withr::local_tempfile(lines = c("x <- 1", "y <- x + 1"))
+#' @examples
+#' tmp <- tempfile()
+#' writeLines(c("x <- 1", "y <- x + 1"), tmp)
 #' source_exprs <- get_source_expressions(tmp)
 #' ids_with_token(source_exprs$expressions[[1L]], value = "SYMBOL")
 #' with_id(source_exprs$expressions[[1L]], 2L)
+#' unlink(tmp)
 #'
 #' @return `ids_with_token`: The indices of the `parsed_content` data frame
 #' entry of the list of source expressions. Indices correspond to the

R/if_switch_linter.R

@@ -14,13 +14,77 @@
 #' approach is roughly linear in the number of conditions that need to
 #' be evaluated, here up to 3 times).
 #'
+#' @param max_branch_lines,max_branch_expressions Integer, default 0 indicates "no maximum".
+#' If set any `if`/`else if`/.../`else` chain where any branch occupies more than
+#' this number of lines (resp. expressions) will not be linted. The conjugate
+#' applies to `switch()` statements -- if these parameters are set, any `switch()`
+#' statement with any overly-complicated branches will be linted. See examples.
+#'
 #' @examples
 #' # will produce lints
 #' lint(
 #' text = "if (x == 'a') 1 else if (x == 'b') 2 else 3",
 #' linters = if_switch_linter()
 #' )
 #'
+#' code <- paste(
+#' "if (x == 'a') {",
+#' " 1",
+#' "} else if (x == 'b') {",
+#' " 2",
+#' "} else if (x == 'c') {",
+#' " y <- x",
+#' " z <- sqrt(match(y, letters))",
+#' " z",
+#' "}",
+#' sep = "\n"
+#' )
+#' writeLines(code)
+#' lint(
+#' text = code,
+#' linters = if_switch_linter()
+#' )
+#'
+#' code <- paste(
+#' "if (x == 'a') {",
+#' " 1",
+#' "} else if (x == 'b') {",
+#' " 2",
+#' "} else if (x == 'c') {",
+#' " y <- x",
+#' " z <- sqrt(",
+#' " match(y, letters)",
+#' " )",
+#' " z",
+#' "}",
+#' sep = "\n"
+#' )
+#' writeLines(code)
+#' lint(
+#' text = code,
+#' linters = if_switch_linter()
+#' )
+#'
+#' code <- paste(
+#' "switch(x,",
+#' " a = {",
+#' " 1",
+#' " 2",
+#' " 3",
+#' " },",
+#' " b = {",
+#' " 1",
+#' " 2",
+#' " }",
+#' ")",
+#' sep = "\n"
+#' )
+#' writeLines(code)
+#' lint(
+#' text = code,
+#' linters = if_switch_linter(max_branch_lines = 2L)
+#' )
+#'
 #' # okay
 #' lint(
 #' text = "switch(x, a = 1, b = 2, 3)",
@@ -33,18 +97,105 @@
 #' linters = if_switch_linter()
 #' )
 #'
+#' code <- paste(
+#' "if (x == 'a') {",
+#' " 1",
+#' "} else if (x == 'b') {",
+#' " 2",
+#' "} else if (x == 'c') {",
+#' " y <- x",
+#' " z <- sqrt(match(y, letters))",
+#' " z",
+#' "}",
+#' sep = "\n"
+#' )
+#' writeLines(code)
+#' lint(
+#' text = code,
+#' linters = if_switch_linter(max_branch_lines = 2L)
+#' )
+#'
+#' code <- paste(
+#' "if (x == 'a') {",
+#' " 1",
+#' "} else if (x == 'b') {",
+#' " 2",
+#' "} else if (x == 'c') {",
+#' " y <- x",
+#' " z <- sqrt(",
+#' " match(y, letters)",
+#' " )",
+#' " z",
+#' "}",
+#' sep = "\n"
+#' )
+#' writeLines(code)
+#' lint(
+#' text = code,
+#' linters = if_switch_linter(max_branch_expressions = 2L)
+#' )
+#'
+#' code <- paste(
+#' "switch(x,",
+#' " a = {",
+#' " 1",
+#' " 2",
+#' " 3",
+#' " },",
+#' " b = {",
+#' " 1",
+#' " 2",
+#' " }",
+#' ")",
+#' sep = "\n"
+#' )
+#' writeLines(code)
+#' lint(
+#' text = code,
+#' linters = if_switch_linter(max_branch_lines = 3L)
+#' )
+#'
 #' @evalRd rd_tags("if_switch_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-if_switch_linter <- function() {
- equal_str_cond <- "expr[1][EQ and expr[STR_CONST]]"
+if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L) {
+ equal_str_cond <- "expr[1][EQ and expr/STR_CONST]"
+
+ if (max_branch_lines > 0L || max_branch_expressions > 0L) {
+ complexity_cond <- xp_or(c(
+ if (max_branch_lines > 0L) paste("OP-RIGHT-BRACE/@line2 - OP-LEFT-BRACE/@line1 > 1 +", max_branch_lines),
+ if (max_branch_expressions > 0L) paste("count(expr) >", max_branch_expressions)
+ ))
+ branch_expr_cond <- xp_and(c(
+ xp_or(
+ # if (x) { <this expr> } ...
+ xp_and("preceding-sibling::IF", "position() = 2"),
+ # if (x) { ... } else { <this expr> }
+ xp_and("preceding-sibling::ELSE", "not(IF)")
+ ),
+ complexity_cond
+ ))
+ max_lines_cond <- glue(".//expr[{branch_expr_cond}]")
+
+ switch_xpath <- glue("
+ parent::expr
+ /parent::expr[expr[
+ position() > 2
+ and {complexity_cond}
+ ]]
+ ")
+ } else {
+ max_lines_cond <- "false"
+
+ switch_xpath <- NULL
+ }
 
  # NB: IF AND {...} AND ELSE/... implies >= 3 equality conditions are present
  # .//expr/IF/...: the expr in `==` that's _not_ the STR_CONST
  # not(preceding::IF): prevent nested matches which might be incorrect globally
  # not(. != .): don't match if there are _any_ expr which _don't_ match the top
  # expr
- xpath <- glue("
+ if_xpath <- glue("
  //IF
  /parent::expr[
  not(preceding-sibling::IF)
@@ -58,15 +209,16 @@ if_switch_linter <- function() {
  .//expr/IF/following-sibling::{equal_str_cond}/expr[not(STR_CONST)]
  != expr[1][EQ]/expr[not(STR_CONST)]
  )
+ and not({ max_lines_cond })
  ]
  ")
 
  Linter(linter_level = "expression", function(source_expression) {
  xml <- source_expression$xml_parsed_content
 
- bad_expr <- xml_find_all(xml, xpath)
+ bad_expr <- xml_find_all(xml, if_xpath)
 
- xml_nodes_to_lints(
+ lints <- xml_nodes_to_lints(
  bad_expr,
  source_expression = source_expression,
  lint_message = paste(
@@ -76,5 +228,19 @@ if_switch_linter <- function() {
  ),
  type = "warning"
  )
+
+ if (!is.null(switch_xpath)) {
+ xml_calls <- source_expression$xml_find_function_calls("switch")
+ switch_expr <- xml_find_all(xml_calls, switch_xpath)
+
+ lints <- c(lints, xml_nodes_to_lints(
+ switch_expr,
+ source_expression = source_expression,
+ lint_message = "Prefer repeated if/else statements over overly-complicated switch() statements.",
+ type = "warning"
+ ))
+ }
+
+ lints
  })
 }

R/indentation_linter.R

@@ -292,8 +292,7 @@ indentation_linter <- function(indent = 2L, hanging_indent_style = c("tidy", "al
  type = "style",
  message = lint_messages,
  line = unname(source_expression$file_lines[bad_lines]),
- # TODO(AshesITR) when updating supported R version to R >= 4.1:
- # replace by ranges = apply(lint_ranges, 1L, list, simplify = FALSE)
+ # TODO(#2467): Use ranges = apply(lint_ranges, 1L, list, simplify = FALSE).
  ranges = lapply(
  seq_along(bad_lines),
  function(i) {

R/inner_combine_linter.R

@@ -36,10 +36,7 @@ inner_combine_linter <- function() {
  "sqrt", "abs"
  )
 
- # TODO(michaelchirico): the need to spell out specific arguments is pretty brittle,
- # but writing the xpath for the alternative case was proving too tricky.
- # It's messy enough as is -- it may make sense to take another pass at
- # writing the xpath from scratch to see if it can't be simplified.
+ # TODO(#2468): Try and make this XPath less brittle/more extensible.
 
  # See ?as.Date, ?as.POSIXct. tryFormats is not explicitly in any default
  # POSIXct method, but it is in as.Date.character and as.POSIXlt.character --

R/is_lint_level.R

@@ -9,13 +9,15 @@
 #' means an individual expression, while `"file"` means all expressions
 #' in the current file are available.
 #'
-#' @examplesIf requireNamespace("withr", quietly = TRUE)
-#' tmp <- withr::local_tempfile(lines = c("x <- 1", "y <- x + 1"))
+#' @examples
+#' tmp <- tempfile()
+#' writeLines(c("x <- 1", "y <- x + 1"), tmp)
 #' source_exprs <- get_source_expressions(tmp)
 #' is_lint_level(source_exprs$expressions[[1L]], level = "expression")
 #' is_lint_level(source_exprs$expressions[[1L]], level = "file")
 #' is_lint_level(source_exprs$expressions[[3L]], level = "expression")
 #' is_lint_level(source_exprs$expressions[[3L]], level = "file")
+#' unlink(tmp)
 #'
 #' @export
 is_lint_level <- function(source_expression, level = c("expression", "file")) {

R/is_numeric_linter.R

@@ -34,11 +34,9 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 is_numeric_linter <- function() {
- # TODO(michaelchirico): this should also cover is.double(x) || is.integer(x)
- # TODO(#1636): is.numeric(x) || is.integer(x) || is.factor(x) is also redundant
- # TODO(michaelchirico): consdier capturing any(class(x) == "numeric/integer")
- # here directly; currently we rely on class_equals_linter() also active
- # TODO(michaelchirico): also catch inherits(x, c("numeric", "integer"))
+ # TODO(#2469): This should also cover is.double(x) || is.integer(x).
+ # TODO(#1636): is.numeric(x) || is.integer(x) || is.factor(x) is also redundant.
+ # TODO(#2470): Consider usages with class(), typeof(), or inherits().
  is_numeric_expr <- "expr[1][SYMBOL_FUNCTION_CALL[text() = 'is.numeric']]"
  is_integer_expr <- "expr[1][SYMBOL_FUNCTION_CALL[text() = 'is.integer']]"
 
@@ -55,7 +53,6 @@ is_numeric_linter <- function() {
  ")
 
  # testing class(x) %in% c("numeric", "integer")
- # TODO(michaelchirico): include typeof(x) %in% c("integer", "double")
  class_xpath <- "
  //SPECIAL[
  text() = '%in%'

R/keyword_quote_linter.R

@@ -46,11 +46,6 @@
 #' @evalRd rd_tags("keyword_quote_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-# TODO(michaelchirico): offer a stricter version of this that
-# requires backticks to be used for non-syntactic names (i.e., not quotes).
-# Here are the relevant xpaths:
-# //expr[expr[SYMBOL_FUNCTION_CALL]]/SYMBOL_SUB[starts-with(text(), '`')]
-# //expr[expr[SYMBOL_FUNCTION_CALL]]/STR_CONST[{is_quoted(text())}]
 keyword_quote_linter <- function() {
  # Check if a string could be assigned as an R variable.
  #