Handle backtickd names in glue extraction (#1630)

* Handle backtickd names in glue extraction

* ignore str2lang usage

* attempt workaround for str2lang

* str2lang not a backports export

* silence R CMD check issue again

* bad merge

Co-authored-by: Indrajeet Patil <[email protected]>

Author: MichaelChirico

.lintr

@@ -1,7 +1,7 @@
 linters: linters_with_defaults(
    line_length_linter(120),
    implicit_integer_linter(),
-   backport_linter("oldrel-4", except = "R_user_dir")
+   backport_linter("oldrel-4", except = c("R_user_dir", "str2lang"))
  )
 exclusions: list(
   "inst/doc/creating_linters.R" = 1,

.lintr_new

@@ -1,7 +1,7 @@
 linters: linters_with_defaults(
     any_duplicated_linter(),
     any_is_na_linter(),
-    backport_linter("oldrel-4", except = "R_user_dir"),
+    backport_linter("oldrel-4", except = c("R_user_dir", "str2lang")),
     consecutive_stopifnot_linter(),
     expect_comparison_linter(),
     expect_length_linter(),

NEWS.md

@@ -12,8 +12,11 @@
 * Set the default for the `except` argument in `duplicate_argument_linter()` to `c("mutate", "transmute")`.
   This allows sequential updates like `x |> mutate(a = b + 1, a = log(a))` (#1345, @IndrajeetPatil).
 
-* `object_usage_linter()` gains `skip_with` argument to skip code in `with()` expressions.
-  To be consistent with `R CMD check`, it defaults to `TRUE` (#941, #1458, @IndrajeetPatil).
+* `object_usage_linter()`
+   + gains `skip_with` argument to skip code in `with()` expressions. To be consistent with
+     `R CMD check`, it defaults to `TRUE` (#941, #1458, @IndrajeetPatil).
+   + Handles backticked symbols inside {glue} expressions correctly, e.g. ``glue("{`x`}")`` correctly
+     determines `x` was used (#1619, @MichaelChirico)
 
 * `spaces_inside_linter()` allows terminal missing keyword arguments (e.g. `alist(arg = )`; #540, @MichaelChirico)
 

R/object_usage_linter.R

@@ -175,23 +175,19 @@ extract_glued_symbols <- function(expr) {
   if (length(glue_calls) == 0L) {
     return(character())
   }
-  glued_symbols <- new.env(parent = emptyenv())
 
   unexpected_error <- function(cond) {
     stop("Unexpected failure to parse glue call, please report: ", conditionMessage(cond)) # nocov
   }
-  for (cl in glue_calls) {
+  glued_symbols <- new.env(parent = emptyenv())
+  for (call_text in xml2::xml_text(glue_calls)) {
     # TODO(michaelchirico): consider dropping tryCatch() here if we're more confident in our logic
-    parsed_cl <- tryCatch(
-      parse(text = xml2::xml_text(cl)),
-      error = unexpected_error,
-      warning = unexpected_error
-    )[[1L]]
-    parsed_cl[[".envir"]] <- glued_symbols
-    parsed_cl[[".transformer"]] <- symbol_extractor
+    parsed_call <- tryCatch(str2lang(call_text), error = unexpected_error, warning = unexpected_error)
+    parsed_call[[".envir"]] <- glued_symbols
+    parsed_call[[".transformer"]] <- symbol_extractor
     # #1459: syntax errors in glue'd code are ignored with warning, rather than crashing lint
     tryCatch(
-      eval(parsed_cl),
+      eval(parsed_call),
       error = function(cond) {
         warning(
           "Evaluating glue expression while testing for local variable usage failed: ",
@@ -215,7 +211,9 @@ symbol_extractor <- function(text, envir, data) {
     return("")
   }
   parse_data <- utils::getParseData(parsed_text)
-  symbols <- parse_data$text[parse_data$token == "SYMBOL"]
+
+  # strip backticked symbols; `x` is the same as x.
+  symbols <- gsub("^`(.*)`$", "\\1", parse_data$text[parse_data$token == "SYMBOL"])
   for (sym in symbols) {
     assign(sym, NULL, envir = envir)
   }

R/zzz.R

@@ -285,6 +285,10 @@ settings <- NULL
 
   # This is just here to quiet R CMD check
   if (FALSE) backports::import
+  # requires R>=3.6.0; see https://github.com/r-lib/backports/issues/68
+  if (!exists("str2lang", getNamespace("base"))) {
+    assign("str2lang", get("str2lang", getNamespace("backports")), getNamespace(pkgname))
+  }
 
   default_settings <<- list(
     linters = default_linters,

tests/testthat/test-object_usage_linter.R

@@ -471,6 +471,27 @@ test_that("errors/edge cases in glue syntax don't fail lint()", {
   )
 })
 
+test_that("backtick'd names in glue are handled", {
+  expect_lint(
+    trim_some("
+      fun <- function() {
+        `w` <- 2
+        x <- 3
+        y <- -4
+        `\\`y` <- 4
+        z <- -5
+        `z\\`` <- 5
+        glue::glue('{w}{`x`}{y}{z}')
+      }
+    "),
+    list(
+      rex::rex("local variable '`y'"),
+      rex::rex("local variable 'z`'")
+    ),
+    object_usage_linter()
+  )
+})
+
 # reported as #1088
 test_that("definitions below top level are ignored (for now)", {
   expect_lint(