Merge branch 'main' into default-pipe

Author: MichaelChirico

NEWS.md

@@ -10,6 +10,7 @@
    + `linter=` argument of `Lint()`.
    + `with_defaults()`.
    + Linters `closed_curly_linter()`, `open_curly_linter()`, `paren_brace_linter()`, and `semicolon_terminator_linter()`.
+* Argument `interpret_glue` to `object_usage_linter()` is deprecated in favor of the more general `interpret_extensions`, in which `"glue"` is present by default (#1472, @MichaelChirico). See the description below.
 * The default for `pipe_consistency_linter()` is changed from `"auto"` (require one pipe style, either magrittr or native) to `"|>"` (R native pipe required) to coincide with the same change in the Tidyverse Style Guide (#2707, @MichaelChirico).
 
 ## Bug fixes
@@ -28,6 +29,7 @@
 * `indentation_linter()` handles `for` un-braced for loops correctly (#2564, @MichaelChirico).
 * Setting `exclusions` supports globs like `knitr*` to exclude files/directories with a pattern (#1554, @MichaelChirico).
 * `object_name_linter()` and `object_length_linter()` apply to objects assigned with `assign()` or generics created with `setGeneric()` (#1665, @MichaelChirico).
+* `object_usage_linter()` gains argument `interpret_extensions` to govern which false positive-prone common syntaxes should be checked for used objects (#1472, @MichaelChirico). Currently `"glue"` (renamed from earlier argument `interpret_glue`) and `"rlang"` are supported. The latter newly covers usage of the `.env` pronoun like `.env$key`, where `key` was previously missed as being a used variable.
 
 ### Lint accuracy fixes: removing false positives
 

R/object_usage_linter.R

@@ -3,8 +3,14 @@
 #' Check that closures have the proper usage using [codetools::checkUsage()].
 #' Note that this runs [base::eval()] on the code, so **do not use with untrusted code**.
 #'
-#' @param interpret_glue If `TRUE`, interpret [glue::glue()] calls to avoid false positives caused by local variables
-#' which are only used in a glue expression.
+#' @param interpret_glue (Deprecated) If `TRUE`, interpret [glue::glue()] calls to avoid
+#'   false positives caused by local variables which are only used in a glue expression.
+#'   Provide `interpret_extensions` instead, see below.
+#' @param interpret_extensions Character vector of extensions to interpret. These are meant to cover known cases where
+#'   variables may be used in ways understood by the reader but not by `checkUsage()` to avoid false positives.
+#'   Currently `"glue"` and `"rlang"` are supported, both of which are in the default.
+#'   - For `glue`, examine [glue::glue()] calls.
+#'   - For `rlang`, examine `.env$key` usages.
 #' @param skip_with A logical. If `TRUE` (default), code in `with()` expressions
 #'   will be skipped. This argument will be passed to `skipWith` argument of
 #'   `codetools::checkUsage()`.
@@ -29,7 +35,27 @@
 #' @evalRd rd_linters("package_development")
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
-object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) {
+object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c("glue", "rlang"), skip_with = TRUE) {
+  if (!is.null(interpret_glue)) {
+    lintr_deprecated(
+      "interpret_glue",
+      '"glue" in interpret_extensions',
+      version = "3.3.0",
+      type = "Argument",
+      signal = "warning"
+    )
+
+    if (interpret_glue) {
+      interpret_extensions <- union(interpret_extensions, "glue")
+    } else {
+      interpret_extensions <- setdiff(interpret_extensions, "glue")
+    }
+  }
+
+  if (length(interpret_extensions) > 0L) {
+    interpret_extensions <- match.arg(interpret_extensions, several.ok = TRUE)
+  }
+
   # NB: difference across R versions in how EQ_ASSIGN is represented in the AST
   #   (under <expr_or_assign_or_help> or <equal_assign>)
   # NB: the repeated expr[2][FUNCTION] XPath has no performance impact, so the different direct assignment XPaths are
@@ -77,7 +103,7 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) {
       if (inherits(fun, "try-error")) {
         return()
       }
-      known_used_symbols <- extract_glued_symbols(fun_assignment, interpret_glue = interpret_glue)
+      known_used_symbols <- known_used_symbols(fun_assignment, interpret_extensions = interpret_extensions)
       res <- parse_check_usage(
         fun,
         known_used_symbols = known_used_symbols,
@@ -261,3 +287,27 @@ get_imported_symbols <- function(xml) {
     )
   }))
 }
+
+known_used_symbols <- function(fun_assignment, interpret_extensions) {
+  unique(c(
+    if ("rlang" %in% interpret_extensions) extract_env_symbols(fun_assignment),
+    if ("glue" %in% interpret_extensions) extract_glued_symbols(fun_assignment)
+  ))
+}
+
+extract_env_symbols <- function(fun_assignment) {
+  env_names <- xml_find_all(
+    fun_assignment,
+    "
+    .//SYMBOL[text() = '.env']
+      /parent::expr
+      /following-sibling::OP-DOLLAR
+      /following-sibling::SYMBOL
+    | .//SYMBOL[text() = '.env']
+      /parent::expr
+      /following-sibling::LBB
+      /following-sibling::expr[STR_CONST]
+    "
+  )
+  get_r_string(env_names)
+}

R/shared_constants.R

@@ -262,7 +262,7 @@ strip_names <- function(x) {
 #' @return A character vector of symbols (variables, infix operators, and
 #'   function calls) found in glue calls under `expr`.
 #' @noRd
-extract_glued_symbols <- function(expr, interpret_glue) {
+extract_glued_symbols <- function(expr, interpret_glue = TRUE) {
   if (!isTRUE(interpret_glue)) {
     return(character())
   }

R/unused_import_linter.R

@@ -1,6 +1,7 @@
 #' Check that imported packages are actually used
 #'
-#' @inheritParams object_usage_linter
+#' @param interpret_glue If `TRUE`, interpret [glue::glue()] calls to avoid false positives caused by local variables
+#'   which are only used in a glue expression.
 #' @param allow_ns_usage Suppress lints for packages only used via namespace.
 #' This is `FALSE` by default because `pkg::fun()` doesn't require `library(pkg)`.
 #' You can use [requireNamespace("pkg")][requireNamespace()] to ensure a package is

man/object_usage_linter.Rd

@@ -418,7 +418,7 @@ test_that("interprets glue expressions", {
       local_var <- 42
       glue::glue('The answer is {local_var}.')
     }
-  "), "local_var", object_usage_linter(interpret_glue = FALSE))
+  "), "local_var", object_usage_linter(interpret_extensions = NULL))
 
   # call in glue is caught
   expect_lint(
@@ -858,3 +858,51 @@ test_that("globals in scripts are found regardless of assignment operator", {
     linter
   )
 })
+
+test_that("dplyr's .env-specified objects are marked as 'used'", {
+  skip_if_not_installed("dplyr")
+  skip_if_not_installed("rlang")
+  linter <- object_usage_linter()
+
+  expect_lint(
+    trim_some("
+      foo <- function(df) {
+        source <- 1
+        target <- 2
+        unused <- 3
+
+        df %>%
+          dplyr::mutate(
+            from = rlang::.env$source,
+            to = rlang::.env[['target']]
+          )
+      }
+    "),
+    rex::rex("local variable", anything, "unused"),
+    linter
+  )
+})
+
+test_that("interpret_glue is deprecated", {
+  expect_warning(
+    {
+      linter_no <- object_usage_linter(interpret_glue = FALSE)
+    },
+    rex::rex("interpret_glue", anything, "deprecated")
+  )
+  expect_warning(
+    {
+      linter_yes <- object_usage_linter(interpret_glue = TRUE)
+    },
+    rex::rex("interpret_glue", anything, "deprecated")
+  )
+
+  code <- trim_some("
+    fun <- function() {
+      local_var <- 42
+      glue::glue('The answer is {local_var}.')
+    }
+  ")
+  expect_lint(code, "local_var", linter_no)
+  expect_no_lint(code, linter_yes)
+})