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

NEWS.md

@@ -50,6 +50,7 @@
 * `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).
 * `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 (#2962, @TimTaylor).
 
 ### New linters
 

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_paren_print Logical, default `FALSE`. If `TRUE`, assignments using
+#'   `(` for auto-printing at the top-level are 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,

tests/testthat/test-implicit_assignment_linter.R

@@ -476,3 +476,20 @@ test_that("call-less '(' mentions avoiding implicit printing", {
     linter
   )
 })
+
+test_that("allow_paren_print allows `(` for auto printing", {
+  lint_message <- rex::rex("Avoid implicit assignments in function calls.")
+  linter <- implicit_assignment_linter(allow_paren_print = TRUE)
+  expect_no_lint("(a <- foo())", linter)
+
+  # Doesn't effect other cases
+  lint_message <- rex::rex("Avoid implicit assignments in function calls.")
+  expect_lint("if (x <- 1L) TRUE", lint_message, linter)
+  expect_lint("while (x <- 0L) FALSE", lint_message, linter)
+  expect_lint("for (x in 1:10 -> y) print(x)", lint_message, linter)
+  expect_lint("mean(x <- 1:4)", lint_message, linter)
+
+  # default remains as is
+  print_msg <- rex::rex("Call print() explicitly instead of relying on implicit printing behavior via '('.")
+  expect_lint("(a <- foo())", print_msg, implicit_assignment_linter())
+})