allow_scoped in implicit_assignment_linter() for scope-limited assign…

…ments (#2171)

* initial work

* simplify implicit_assignment_linter logic, and catch false negatives

* narrow line

* add a simpler test of lints in all call args

* catch parenthetical assignments

* allow_lazy argument for implicit_assignment_linter to skip lazy assignments

* bad NEWS merge

* narrow example

* passing tests

* ensure were actually in a branch; add tests

* typo in example

* indentation

* another example typo

* a test for false positive

* missing )

* comment to explain

* lazy test

R/implicit_assignment_linter.R

@@ -6,6 +6,9 @@
 #' @param except A character vector of functions to be excluded from linting.
 #' @param allow_lazy logical, default `FALSE`. If `TRUE`, assignments that only
 #'   trigger conditionally (e.g. in the RHS of `&&` or `||` expressions) are skipped.
+#' @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.
 #'
 #' @examples
 #' # will produce lints
@@ -20,15 +23,17 @@
 #' )
 #'
 #' # okay
-#' writeLines("x <- 1L\nif (x) TRUE")
+#' lines <- "x <- 1L\nif (x) TRUE"
+#' writeLines(lines)
 #' lint(
-#'   text = "x <- 1L\nif (x) TRUE",
+#'   text = lines,
 #'   linters = implicit_assignment_linter()
 #' )
 #'
-#' writeLines("x <- 1:4\nmean(x)")
+#' lines <- "x <- 1:4\nmean(x)"
+#' writeLines(lines)
 #' lint(
-#'   text = "x <- 1:4\nmean(x)",
+#'   text = lines,
 #'   linters = implicit_assignment_linter()
 #' )
 #'
@@ -37,14 +42,26 @@
 #'   linters = implicit_assignment_linter(allow_lazy = TRUE)
 #' )
 #'
+#' lines <- c(
+#'   "if (any(idx <- x < 0)) {",
+#'   "  stop('negative elements: ', toString(which(idx)))",
+#'   "}"
+#' )
+#' writeLines(lines)
+#' lint(
+#'   text = lines,
+#'   linters = implicit_assignment_linter(allow_scoped = TRUE)
+#' )
+#'
 #' @evalRd rd_tags("implicit_assignment_linter")
 #' @seealso
 #' - [linters] for a complete list of linters available in lintr.
 #' - <https://style.tidyverse.org/syntax.html#assignment>
 #'
 #' @export
 implicit_assignment_linter <- function(except = c("bquote", "expression", "expr", "quo", "quos", "quote"),
-                                       allow_lazy = FALSE) {
+                                       allow_lazy = FALSE,
+                                       allow_scoped = FALSE) {
   stopifnot(is.null(except) || is.character(except))
 
   if (length(except) > 0L) {
@@ -75,6 +92,15 @@ implicit_assignment_linter <- function(except = c("bquote", "expression", "expr"
   if (allow_lazy) {
     xpath <- paste0(xpath, "[not(ancestor::expr/preceding-sibling::*[self::AND2 or self::OR2])]")
   }
+  if (allow_scoped) {
+    # force 2nd preceding to ensure we're in the loop condition, not the loop expression
+    in_branch_cond <- "ancestor::expr[preceding-sibling::*[2][self::IF or self::WHILE]]"
+    xpath <- paste0(
+      xpath,
+      # _if_ we're in an IF/WHILE branch, lint if the assigned SYMBOL appears anywhere later on.
+      glue("[not({in_branch_cond}) or expr[1]/SYMBOL = {in_branch_cond}/parent::expr/following::SYMBOL]")
+    )
+  }
 
   Linter(function(source_expression) {
     # need the full file to also catch usages at the top level

tests/testthat/test-implicit_assignment_linter.R

@@ -383,3 +383,97 @@ test_that("allow_lazy lets lazy assignments through", {
     linter
   )
 })
+
+test_that("allow_scoped skips scoped assignments", {
+  linter <- implicit_assignment_linter(allow_scoped = TRUE)
+  lint_message <- rex::rex("Avoid implicit assignments in function calls.")
+
+  expect_lint(
+    trim_some("
+      if (any(idx <- x < 0)) {
+        stop('negative elements: ', toString(which(idx)))
+      }
+    "),
+    NULL,
+    linter
+  )
+  expect_lint(
+    trim_some("
+      if (any(idx <- x < 0)) {
+        stop('negative elements: ', toString(which(idx)))
+      }
+      print(idx)
+    "),
+    lint_message,
+    linter
+  )
+  # only applies to the branch condition itself -- within the branch, still lint
+  expect_lint(
+    trim_some("
+      if (TRUE) {
+        foo(idx <- bar())
+      }
+    "),
+    lint_message,
+    linter
+  )
+
+  expect_lint(
+    trim_some("
+      obj <- letters
+      while ((n <- length(obj)) > 0) obj <- obj[-n]
+    "),
+    NULL,
+    linter
+  )
+  expect_lint(
+    trim_some("
+      obj <- letters
+      while ((n <- length(obj)) > 0) obj <- obj[-n]
+      if (TRUE) {
+        print(n)
+      }
+    "),
+    lint_message,
+    linter
+  )
+
+  # outside of branching, doesn't matter
+  expect_lint("(idx <- foo()); bar()", lint_message, linter)
+  expect_lint("foo(idx <- bar()); baz()", lint_message, linter)
+  expect_lint("foo(x, idx <- bar()); baz()", lint_message, linter)
+})
+
+test_that("interaction of allow_lazy and allow_scoped", {
+  linter <- implicit_assignment_linter(allow_scoped = TRUE, allow_lazy = TRUE)
+
+  expect_lint(
+    trim_some("
+      if (any(idx <- foo()) && BB) {
+        stop('Invalid foo() output: ', toString(idx))
+      }
+    "),
+    NULL,
+    linter
+  )
+  expect_lint(
+    trim_some("
+      if (any(idx <- foo()) && BB) {
+        stop('Invalid foo() output: ', toString(idx))
+      }
+      print(format(idx))
+    "),
+    rex::rex("Avoid implicit assignments in function calls."),
+    linter
+  )
+  expect_lint(
+    trim_some("
+      if (AA && any(idx <- foo())) {
+        stop('Invalid foo() output: ', toString(idx))
+      }
+      print(format(idx)) # NB: bad code! idx may not exist.
+    "),
+    NULL,
+    linter
+  )
+})