fix object_usage_linter with new xml2lang to avoid parsing comments in multi-line expr (#1935)

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

Author: MichaelChirico

NEWS.md

@@ -14,7 +14,9 @@
 
 * `assignment_linter()` no longer lints assignments in braces that include comments when `allow_trailing = FALSE` (#1701, @ashbaldry)
 
-* `object_usage_linter()` no longer silently ignores usage warnings that don't contain a quoted name (#1714, @AshesITR)
+* `object_usage_linter()`
+   + No longer silently ignores usage warnings that don't contain a quoted name (#1714, @AshesITR)
+   + No longer fails on code with comments inside a multi-line call to `glue::glue()` (#1919, @MichaelChirico)
 
 * `namespace_linter()` correctly recognizes backticked operators to be exported from respective namespaces (like `` rlang::`%||%` ``) (#1752, @IndrajeetPatil)
 

R/object_usage_linter.R

@@ -188,9 +188,9 @@ extract_glued_symbols <- function(expr) {
     stop("Unexpected failure to parse glue call, please report: ", conditionMessage(cond)) # nocov
   }
   glued_symbols <- new.env(parent = emptyenv())
-  for (call_text in xml2::xml_text(glue_calls)) {
+  for (glue_call in glue_calls) {
     # TODO(michaelchirico): consider dropping tryCatch() here if we're more confident in our logic
-    parsed_call <- tryCatch(str2lang(call_text), error = unexpected_error, warning = unexpected_error)
+    parsed_call <- tryCatch(xml2lang(glue_call), 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

R/utils.R

@@ -277,6 +277,18 @@ get_r_code <- function(xml) {
   paste(lines, collapse = "\n")
 }
 
+#' str2lang, but for xml children.
+#'
+#' [xml2::xml_text()] is deceptively close to obviating this helper, but it collapses
+#'   text across lines. R is _mostly_ whitespace-agnostic, so this only matters in some edge cases,
+#'   in particular when there are comments within an expression (<expr> node). See #1919.
+#'
+#' @noRd
+xml2lang <- function(x) {
+  x_strip_comments <- xml_find_all(x, ".//*[not(self::COMMENT or self::expr)]")
+  str2lang(paste(xml2::xml_text(x_strip_comments), collapse = ""))
+}
+
 is_linter <- function(x) inherits(x, "linter")
 
 is_tainted <- function(lines) {

tests/testthat/test-object_usage_linter.R

@@ -469,6 +469,20 @@ test_that("errors/edge cases in glue syntax don't fail lint()", {
     NULL,
     linter
   )
+
+  # comment inside glue range (#1919)
+  expect_lint(
+    trim_some("
+      fun <- function() {
+        a <- 2
+        glue::glue(
+          'The answer is {}: {a}' # show the answer
+        )
+      }
+    "),
+    NULL,
+    linter
+  )
 })
 
 test_that("backtick'd names in glue are handled", {