improve handling of glued object extraction (#1612)

Author: MichaelChirico

R/object_usage_linter.R

@@ -159,30 +159,16 @@ extract_glued_symbols <- function(expr) {
     return(character())
   }
   glued_symbols <- new.env(parent = emptyenv())
+
   for (cl in glue_calls) {
     parsed_cl <- tryCatch(
       parse(text = xml2::xml_text(cl)),
       error = function(...) NULL,
       warning = function(...) NULL
     )[[1L]]
     if (is.null(parsed_cl)) next
-    parsed_cl[[".transformer"]] <- function(text, envir) {
-      parsed_text <- tryCatch(
-        parse(text = text, keep.source = TRUE),
-        error = function(...) NULL,
-        warning = function(...) NULL
-      )
-      parsed_xml <- safe_parse_to_xml(parsed_text)
-      # covers NULL & NA cases
-      if (length(parsed_xml) == 0L) {
-        return("")
-      }
-      symbols <- xml2::xml_text(xml2::xml_find_all(parsed_xml, "//SYMBOL"))
-      for (sym in symbols) {
-        assign(sym, NULL, envir = glued_symbols)
-      }
-      ""
-    }
+    parsed_cl[[".envir"]] <- glued_symbols
+    parsed_cl[[".transformer"]] <- symbol_extractor
     # #1459: syntax errors in glue'd code are ignored with warning, rather than crashing lint
     tryCatch(
       eval(parsed_cl),
@@ -196,7 +182,28 @@ extract_glued_symbols <- function(expr) {
       }
     )
   }
-  ls(envir = glued_symbols, all.names = TRUE)
+  names(glued_symbols)
+}
+
+symbol_extractor <- function(text, envir, data) {
+  parsed_text <- tryCatch(
+    parse(text = text, keep.source = TRUE),
+    error = function(...) NULL,
+    warning = function(...) NULL
+  )
+  if (is.null(parsed_text)) {
+    return("")
+  }
+  parse_data <- utils::getParseData(parsed_text)
+  # covers NULL & NA cases
+  if (nrow(parse_data) == 0L) {
+    return("")
+  }
+  symbols <- parse_data$text[parse_data$token == "SYMBOL"]
+  for (sym in symbols) {
+    assign(sym, NULL, envir = envir)
+  }
+  ""
 }
 
 get_assignment_symbols <- function(xml) {

tests/testthat/test-object_usage_linter.R

@@ -351,6 +351,24 @@ test_that("interprets glue expressions", {
     }
   "), NULL, linter)
 
+  # multiple variables in different interpolations
+  expect_lint(trim_some("
+    fun <- function() {
+      local_key <- 'a'
+      local_value <- 123
+      glue::glue('Key-value pair: {local_key}={local_value}.')
+    }
+  "), NULL, linter)
+
+  # multiple variables in single interpolation
+  expect_lint(trim_some("
+    fun <- function() {
+      local_str1 <- 'a'
+      local_str2 <- 'b'
+      glue::glue('With our powers combined: {paste(local_str1, local_str2)}.')
+    }
+  "), NULL, linter)
+
   # Check non-standard .open and .close
   expect_lint(trim_some("
     fun <- function() {