feat: argument to disable linting of ( for auto-printing

.github/workflows/test-coverage.yaml

@@ -57,7 +57,7 @@ jobs:
 
       - name: Upload test results
         if: failure()
-        uses: actions/upload-artifact@v4
+        uses: actions/upload-artifact@v5
         with:
           name: coverage-test-failures
           path: ${{ runner.temp }}/package

NEWS.md

@@ -49,14 +49,17 @@
 * New argument `include_s4_slots` for the `xml_find_function_calls()` entry in the `get_source_expressions()` to govern whether calls of the form `s4Obj@fun()` are included in the result (#2820, @MichaelChirico).
 * `sprintf_linter()` lints `sprintf()` and `gettextf()` calls when a constant string is passed to `fmt` (#2894, @Bisaloo).
 * `use_lintr()` adds the created `.lintr` file to the `.Rbuildignore` if run in a package (#2926, initial work by @MEO265, finalized by @Bisaloo).
+* `implicit_assignment_linter()` gains argument `allow_print` to disable lints for the use of `(` for auto-printing (#2919, @TimTaylor).
+* `length_test_linter()` is extended to check incorrect usage of `nrow()`, `ncol()`, `NROW()`, `NCOL()` (#2933, @mcol).
+* `implicit_assignment_linter()` gains argument `allow_paren_print` to disable lints for the use of `(` for auto-printing (#2919, @TimTaylor).
 
 ### New linters
 
 * `all_equal_linter()` warns about incorrect use of `all.equal()` in `if` clauses or preceded by `!` (#2885, @Bisaloo).
 * `download_file_linter()` encourages the use of `mode = "wb"` (or `mode = "ab"`) when using `download.file()`, rather than `mode = "w"` or `mode = "a"`, as the latter can produce broken
 files in Windows (#2882, @Bisaloo).
 * `lint2df_linter()` encourages the use of the `list2DF()` function, or the `data.frame()` function when recycling is required, over the slower and less readable `do.call(cbind.data.frame, )` alternative (#2834, @Bisaloo).
-* `coalesce_linter()` encourages the use of the infix operator `x %||% y`, which is equivalent to `if (is.null(x)) y else x` (#2246, @MichaelChirico). While this has long been used in many tidyverse packages (it was added to {ggplot2} in 2008), it became part of every R installation from R 4.4.0.
+* `coalesce_linter()` encourages the use of the infix operator `x %||% y`, which is equivalent to `if (is.null(x)) y else x` (#2246, @MichaelChirico). While this has long been used in many tidyverse packages (it was added to {ggplot2} in 2008), it became part of every R installation from R 4.4.0. Thanks also to @emmanuel-ferdman for fixing a false positive before release.
 
 ### Lint accuracy fixes: removing false positives
 
@@ -73,6 +76,7 @@ files in Windows (#2882, @Bisaloo).
 * `assignment_linter()` with `operator = "="` does a better job of skipping implicit assignments, which are intended to be governed by `implicit_assignment_linter()` (#2765, @MichaelChirico).
 * `expect_true_false_linter()` is pipe-aware, so that `42 |> expect_identical(x, ignore_attr = TRUE)` no longer lints (#1520, @MichaelChirico).
 * `T_and_F_symbol_linter()` ignores `T` and `F` used as symbols in formulas (`y ~ T + F`), which can represent variables in data not controlled by the author (#2637, @MichaelChirico).
+* `T_and_F_symbol_linter()` ignores `T` and `F` if followed by `[` or `[[` (#2944, @mcol).
 * `implicit_assignment_linter()` with `allow_scoped=TRUE` doesn't lint for `if (a <- 1) print(a)` (#2913, @MichaelChirico).
 
 ### Lint accuracy fixes: removing false negatives

R/T_and_F_symbol_linter.R

@@ -34,7 +34,7 @@
 T_and_F_symbol_linter <- function() { # nolint: object_name.
   symbol_xpath <- "//SYMBOL[
     (text() = 'T' or text() = 'F')
-    and not(parent::expr[OP-DOLLAR or OP-AT])
+    and not(parent::expr[OP-DOLLAR or OP-AT or following-sibling::OP-LEFT-BRACKET or following-sibling::LBB])
     and (
       not(ancestor::expr[OP-TILDE])
       or parent::expr/preceding-sibling::*[not(self::COMMENT)][1][self::EQ_SUB]

R/absolute_path_linter.R

@@ -11,7 +11,7 @@
 #' @examples
 #' # will produce lints
 #' lint(
-#'   text = 'R"--[/blah/file.txt]--"',
+#'   text = 'R"(/blah/file.txt)"',
 #'   linters = absolute_path_linter()
 #' )
 #'

R/coalesce_linter.R

@@ -60,6 +60,7 @@ coalesce_linter <- function() {
   parent::expr[
     preceding-sibling::OP-EXCLAMATION
     and parent::expr/preceding-sibling::IF
+    and parent::expr/following-sibling::ELSE
     and (
       expr[2] = parent::expr/following-sibling::expr[1]
       or expr[2] = parent::expr/following-sibling::{braced_expr_cond}

R/cyclocomp_linter.R

@@ -45,8 +45,9 @@ cyclocomp_linter <- function(complexity_limit = 15L) {
       column_number = source_expression[["column"]][1L],
       type = "style",
       message = sprintf(
-        "Reduce the cyclomatic complexity of this expression from %d to at most %d.",
-        complexity, complexity_limit
+        "Reduce the cyclomatic complexity of this expression from %d to at most %d. %s",
+        complexity, complexity_limit,
+        "Consider replacing high-complexity sections like loops and branches with helper functions."
       ),
       ranges = list(rep(col1, 2L)),
       line = source_expression$lines[1L]

R/expect_lint.R

@@ -59,8 +59,10 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno
 
   wrong_number_fmt <- "got %d lints instead of %d%s"
   if (is.null(checks)) {
-    msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_str)
-    return(testthat::expect(n_lints %==% 0L, msg))
+    if (n_lints != 0L) {
+      return(testthat::fail(sprintf(wrong_number_fmt, n_lints, 0L, lint_str)))
+    }
+    return(testthat::succeed())
   }
 
   if (!is.list(checks) || !is.null(names(checks))) { # vector or named list
@@ -69,8 +71,7 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno
   checks[] <- lapply(checks, fix_names, "message")
 
   if (n_lints != length(checks)) {
-    msg <- sprintf(wrong_number_fmt, n_lints, length(checks), lint_str)
-    return(testthat::expect(FALSE, msg))
+    return(testthat::fail(sprintf(wrong_number_fmt, n_lints, length(checks), lint_str)))
   }
 
   if (ignore_order) {
@@ -85,42 +86,47 @@ expect_lint <- function(content, checks, ..., file = NULL, language = "en", igno
     checks <- checks[check_order]
   }
 
-  local({
-    itr_env <- new.env(parent = emptyenv())
-    itr_env$itr <- 0L
-    # valid fields are those from Lint(), plus 'linter'
-    lint_fields <- c(names(formals(Lint)), "linter")
-    Map(
-      function(lint, check) {
-        itr_env$itr <- itr_env$itr + 1L
-        lapply(names(check), function(field) {
-          if (!field %in% lint_fields) {
-            cli_abort(c(
-              x = "Check {.val {itr_env$itr}} has an invalid field: {.field {field}}.",
-              i = "Valid fields are: {.field {lint_fields}}."
-            ))
-          }
-          check <- check[[field]]
-          value <- lint[[field]]
-          msg <- sprintf(
-            "check #%d: %s %s did not match %s",
-            itr_env$itr, field, deparse(value), deparse(check)
-          )
-          # deparse ensures that NULL, list(), etc are handled gracefully
-          ok <- if (field == "message") {
-            re_matches_logical(value, check)
-          } else {
-            isTRUE(all.equal(value, check))
-          }
-          testthat::expect(ok, msg)
-        })
-      },
-      lints,
-      checks
-    )
-  })
+  expect_lint_impl_(lints, checks)
+
+  testthat::succeed()
+}
 
-  invisible(NULL)
+#' NB: must _not_ succeed(), should only fail() or abort()
+#' @noRd
+expect_lint_impl_ <- function(lints, checks) {
+  itr <- 0L
+  # valid fields are those from Lint(), plus 'linter'
+  lint_fields <- c(names(formals(Lint)), "linter")
+
+  for (i in seq_along(lints)) {
+    lint <- lints[[i]]
+    check <- checks[[i]]
+
+    itr <- itr + 1L
+
+    for (field in names(check)) {
+      if (!field %in% lint_fields) {
+        cli_abort(c(
+          x = "Check {.val {itr}} has an invalid field: {.field {field}}.",
+          i = "Valid fields are: {.field {lint_fields}}."
+        ))
+      }
+      check_field <- check[[field]]
+      value <- lint[[field]]
+      ok <- if (field == "message") {
+        re_matches_logical(value, check_field)
+      } else {
+        isTRUE(all.equal(value, check_field))
+      }
+      if (!ok) {
+        return(testthat::fail(sprintf(
+          "check #%d: %s %s did not match %s",
+          # deparse ensures that NULL, list(), etc are handled gracefully
+          itr, field, deparse(value), deparse(check)
+        )))
+      }
+    }
+  }
 }
 
 #' @rdname expect_lint
@@ -162,12 +168,11 @@ expect_lint_free <- function(...) {
   if (has_lints) {
     lint_output <- format(lints)
   }
-  result <- testthat::expect(
-    !has_lints,
-    paste0("Not lint free\n", lint_output)
-  )
 
-  invisible(result)
+  if (has_lints) {
+    return(testthat::fail(paste0("Not lint free\n", lint_output)))
+  }
+  testthat::succeed()
 }
 
 # Helper function to check if testthat is installed.

R/implicit_assignment_linter.R

@@ -9,6 +9,8 @@
 #' @param allow_scoped Logical, default `FALSE`. If `TRUE`, "scoped assignments",
 #'   where the object is assigned in the statement beginning a branch and used only
 #'   within that branch, are skipped.
+#' @param allow_parent_print Logical, default `FALSE`. If `TRUE`, using `(` for auto-printing
+#'   at the top-level is not linted.
 #'
 #' @examples
 #' # will produce lints
@@ -22,6 +24,12 @@
 #'   linters = implicit_assignment_linter()
 #' )
 #'
+#' lint(
+#'   text = "(x <- 1)",
+#'   linters = implicit_assignment_linter()
+#' )
+#'
+#'
 #' # okay
 #' lines <- "x <- 1L\nif (x) TRUE"
 #' writeLines(lines)
@@ -53,6 +61,11 @@
 #'   linters = implicit_assignment_linter(allow_scoped = TRUE)
 #' )
 #'
+#' lint(
+#'   text = "(x <- 1)",
+#'   linters = implicit_assignment_linter(allow_paren_print = TRUE)
+#' )
+#'
 #' @evalRd rd_tags("implicit_assignment_linter")
 #' @seealso
 #' - [linters] for a complete list of linters available in lintr.
@@ -61,7 +74,8 @@
 #' @export
 implicit_assignment_linter <- function(except = c("bquote", "expression", "expr", "quo", "quos", "quote"),
                                        allow_lazy = FALSE,
-                                       allow_scoped = FALSE) {
+                                       allow_scoped = FALSE,
+                                       allow_paren_print = FALSE) {
   stopifnot(is.null(except) || is.character(except))
 
   if (length(except) > 0L) {
@@ -116,6 +130,9 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr"
     bad_expr <- xml_find_all(xml, xpath)
 
     print_only <- !is.na(xml_find_first(bad_expr, "parent::expr[parent::exprlist and *[1][self::OP-LEFT-PAREN]]"))
+    if (allow_paren_print) {
+      bad_expr <- bad_expr[!print_only]
+    }
 
     xml_nodes_to_lints(
       bad_expr,

R/length_test_linter.R

@@ -1,21 +1,44 @@
-#' Check for a common mistake where length is applied in the wrong place
+#' Check for a common mistake where a size check like 'length' is applied in the wrong place
 #'
 #' Usage like `length(x == 0)` is a mistake. If you intended to check `x` is empty,
 #'   use `length(x) == 0`. Other mistakes are possible, but running `length()` on the
 #'   outcome of a logical comparison is never the best choice.
 #'
+#' The linter also checks for similar usage with `nrow()`, `ncol()`, `NROW()`, and `NCOL()`.
+#'
 #' @examples
 #' # will produce lints
 #' lint(
 #'   text = "length(x == 0)",
 #'   linters = length_test_linter()
 #' )
 #'
+#' lint(
+#'   text = "nrow(x > 0) || ncol(x > 0)",
+#'   linters = length_test_linter()
+#' )
+#'
+#' lint(
+#'   text = "NROW(x == 1) && NCOL(y == 1)",
+#'   linters = length_test_linter()
+#' )
+#'
 #' # okay
 #' lint(
 #'   text = "length(x) > 0",
 #'   linters = length_test_linter()
 #' )
+#'
+#' lint(
+#'   text = "nrow(x) > 0 || ncol(x) > 0",
+#'   linters = length_test_linter()
+#' )
+#'
+#' lint(
+#'   text = "NROW(x) == 1 && NCOL(y) == 1",
+#'   linters = length_test_linter()
+#' )
+#'
 #' @evalRd rd_tags("class_equals_linter")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
@@ -26,13 +49,14 @@ length_test_linter <- function() {
   ")
 
   Linter(linter_level = "expression", function(source_expression) {
-    xml_calls <- source_expression$xml_find_function_calls("length")
+    xml_calls <- source_expression$xml_find_function_calls(c("length", "nrow", "ncol", "NROW", "NCOL"))
     bad_expr <- xml_find_all(xml_calls, xpath)
 
+    matched_function <- xp_call_name(bad_expr)
     expr_parts <- vapply(lapply(bad_expr, xml_find_all, "expr[2]/*"), xml_text, character(3L))
     lint_message <- sprintf(
-      "Checking the length of a logical vector is likely a mistake. Did you mean `length(%s) %s %s`?",
-      expr_parts[1L, ], expr_parts[2L, ], expr_parts[3L, ]
+      "Checking the %s of a logical vector is likely a mistake. Did you mean `%s(%s) %s %s`?",
+      matched_function, matched_function, expr_parts[1L, ], expr_parts[2L, ], expr_parts[3L, ]
     )
 
     xml_nodes_to_lints(

R/paren_body_linter.R

@@ -36,7 +36,6 @@ paren_body_linter <- make_linter_from_xpath(
       or preceding-sibling::OP-LAMBDA
       or preceding-sibling::IF
       or preceding-sibling::WHILE
-      or preceding-sibling::OP-LAMBDA
     )
   ]
     /following-sibling::expr[1]

R/repeat_linter.R

@@ -1,6 +1,7 @@
 #' Repeat linter
 #'
-#' Check that `while (TRUE)` is not used for infinite loops.
+#' Check that `while (TRUE)` is not used for infinite loops. While this is valid
+#' R code, using `repeat {}` is more explicit.
 #'
 #' @examples
 #' # will produce lints

R/scalar_in_linter.R

@@ -1,7 +1,10 @@
 #' Block usage like x %in% "a"
 #'
 #' `vector %in% set` is appropriate for matching a vector to a set, but if
-#'   that set has size 1, `==` is more appropriate.
+#'   that set has size 1, `==` is more appropriate. However, if `vector` has
+#'   also size 1 and can be `NA`, the use of `==` should be accompanied by extra
+#'   protection for the missing case (for example, `isTRUE(NA == "arg")` or
+#'   `!is.na(x) && x == "arg"`).
 #'
 #' `scalar %in% vector` is OK, because the alternative (`any(vector == scalar)`)
 #'   is more circuitous & potentially less clear.
@@ -46,7 +49,8 @@ scalar_in_linter <- function(in_operators = NULL) {
     in_op <- xml_find_chr(bad_expr, "string(SPECIAL)")
     lint_msg <- paste0(
       "Use comparison operators (e.g. ==, !=, etc.) to match length-1 scalars instead of ", in_op, ". ",
-      "Note that comparison operators preserve NA where ", in_op, " does not."
+      "Note that if x can be NA, x == 'arg' is NA whereas x ", in_op, " 'arg' is FALSE, ",
+      "so consider extra protection for the missing case in your code."
     )
 
     xml_nodes_to_lints(

R/with.R

@@ -92,6 +92,9 @@ modify_defaults <- function(defaults, ...) {
 #' }
 #' @export
 linters_with_tags <- function(tags, ..., packages = "lintr", exclude_tags = "deprecated") {
+  if (missing(tags)) {
+    cli_abort("{.arg tags} was not specified. Available tags: {available_tags()}")
+  }
   if (!is.character(tags) && !is.null(tags)) {
     cli_abort("{.arg tags} must be a character vector, or {.code NULL}, not {.obj_type_friendly {tags}}.")
   }