Correctly parse checkUsage when a multiline warning is encountered (#758)

* Correctly parse checkUsage when a multiline warning is encountered

fixes #507

* 100% coverage for object_usage_linter

* improve location detection, nolint new false positive lints.

* fix single-line case

add tests for 100% coverage

* nzchar over !=""

* add comments

* clean up globalVariables() and remove nolint sections

Co-authored-by: Michael Chirico <[email protected]>

Author: AshesITR

NEWS.md

@@ -55,6 +55,7 @@
 * `trailing_blank_lines_linter()` now also lints files without a terminal newline (#675, @AshesITR)
 * `object_name_linter()` now correctly detects imported functions when linting packages (#642, @AshesITR)
 * Consistent access to linters through a function call, even for linters without parameters (#245, @fangly, @AshesITR, and @MichaelChirico)
+* `object_usage_linter()` now correctly reports usage warnings spanning multiple lines (#507, @AshesITR)
 * `T_and_F_symbol_linter()` no longer lints occurrences of `T` and `F` when used for subsetting and gives a better 
   message when used as variable names (#657, @AshesITR)
 

R/aaa.R

@@ -24,4 +24,8 @@ NULL
 # need to register rex shortcuts as globals to avoid CRAN check errors
 rex::register_shortcuts("lintr")
 
-utils::globalVariables("from", "lintr")
+utils::globalVariables(
+  c("line1", "col1", "line2", "col2", # columns of parsed_content
+    "id", "parent", "token", "terminal", "text"), # dito
+  "lintr"
+)

R/object_usage_linter.R

@@ -45,34 +45,51 @@ object_usage_linter <- function() {
       }
       res <- parse_check_usage(fun)
 
-      lapply(which(!is.na(res$message)),
-             function(row_num) {
-               row <- res[row_num, ]
-
-               if (row$name %in% declared_globals) {
-                 return()
-               }
-
-               org_line_num <- as.integer(row$line_number) + info$line1 - 1L
-
-               line <- source_file$content[as.integer(org_line_num)]
-
-               row$name <- re_substitutes(row$name, rex("<-"), "")
-
-               location <- re_matches(line,
-                                      rex(row$name),
-                                      locations = TRUE)
-
-               Lint(
-                 filename = source_file$filename,
-                 line_number = org_line_num,
-                 column_number = location$start,
-                 type = "warning",
-                 message = row$message,
-                 line = line,
-                 ranges = list(c(location$start, location$end))
-               )
-             })
+      lapply(
+        which(!is.na(res$message)),
+        function(row_num) {
+          row <- res[row_num, ]
+
+          if (row$name %in% declared_globals) {
+            return()
+          }
+
+          org_line_num <- as.integer(row$line1) + info$line1 - 1L
+          line <- source_file$content[as.integer(org_line_num)]
+
+          row$name <- re_substitutes(row$name, rex("<-"), "")
+
+          location <- re_matches(line, rex(boundary, row$name, boundary), locations = TRUE)
+
+          # Handle multi-line lints where name occurs on subsequent lines (#507)
+          if (is.na(location$start) && nzchar(row$line2) && row$line2 != row$line1) {
+            lines <- source_file$content[org_line_num:(as.integer(row$line2) + info$line1 - 1L)]
+            locations <- re_matches(lines, rex(boundary, row$name, boundary), locations = TRUE)
+
+            matching_row <- (which(!is.na(locations$start)) %||% 1L)[[1L]] # first matching row or 1 (as a fallback)
+
+            org_line_num <- org_line_num + matching_row - 1L
+            location <- locations[matching_row, ]
+            line <- lines[matching_row]
+          }
+
+          # Fallback if name isn't found anywhere: lint the first line
+          if (is.na(location$start)) {
+            location$start <- 1L
+            location$end <- nchar(line)
+          }
+
+          Lint(
+            filename = source_file$filename,
+            line_number = org_line_num,
+            column_number = location$start,
+            type = "warning",
+            message = row$message,
+            line = line,
+            ranges = list(c(location$start, location$end))
+          )
+        }
+      )
     })
   })
 }
@@ -139,23 +156,38 @@ parse_check_usage <- function(expression) {
   try(codetools::checkUsage(expression, report = report))
 
   function_name <- rex(anything, ": ")
-  line_info <- rex(" ", "(", capture(name = "path", non_spaces), ":", capture(name = "line_number", digits), ")")
-
-  res <- re_matches(vals,
-                    rex(function_name,
-                        capture(name = "message", anything,
-                                one_of(quote, "\u2018"), capture(name = "name", anything), one_of(quote, "\u2019"),
-                                anything),
-                        line_info))
+  line_info <- rex(" ", "(", capture(name = "path", non_spaces), ":",
+                   capture(name = "line1", digits), maybe("-", capture(name = "line2", digits)), ")")
+
+  res <- re_matches(
+    vals,
+    rex(
+      function_name,
+      capture(
+        name = "message",
+        anything,
+        one_of(quote, "\u2018"),
+        capture(name = "name", anything),
+        one_of(quote, "\u2019"),
+        anything
+      ),
+      line_info
+    )
+  )
 
   missing <- is.na(res$message)
   if (any(missing)) {
-    res[missing, ] <- re_matches(vals[missing],
-                                rex(function_name,
-                                    capture(name = "message",
-                                            "possible error in ", capture(name = "name", anything), ": ", anything
-                                    ),
-                                    line_info))
+    res[missing, ] <- re_matches(
+      vals[missing],
+      rex(
+        function_name,
+        capture(
+          name = "message",
+          "possible error in ", capture(name = "name", anything), ": ", anything
+        ),
+        line_info
+      )
+    )
   }
 
   res

R/pipe_continuation_linter.R

@@ -72,5 +72,3 @@ pipe_continuation_linter <- function() {
       })
   })
 }
-
-utils::globalVariables(c("line1", "line2", "col1", "col2"), "lintr")

tests/testthat/test-object_usage_linter.R

@@ -215,3 +215,86 @@ test_that("used symbols are detected correctly", {
     object_usage_linter()
   )
 })
+
+test_that("object_usage_linter finds lints spanning multiple lines", {
+  # Regression test for #507
+  expect_lint(
+    trim_some("
+      foo <- function() {
+        if (unknown_function()) NULL
+
+        if (unknown_function()) {
+          NULL
+        }
+      }
+    "),
+    list(
+      list(message = "unknown_function", line_number = 2L),
+      list(message = "unknown_function", line_number = 4L)
+    ),
+    object_usage_linter()
+  )
+
+  # Linted symbol is not on the first line of the usage warning
+  expect_lint(
+    trim_some("
+      foo <- function(x) {
+        with(
+          x,
+          unknown_symbol
+        )
+      }
+    "),
+    list(message = "unknown_symbol", line_number = 4L, column_number = 5L),
+    object_usage_linter()
+  )
+
+  # Kill regex match to enforce fallback to line 1 column 1 of the warning
+  expect_lint(
+    trim_some("
+      foo <- function(x) {
+        with(
+          x,
+          `\u2019regex_kill`
+        )
+      }
+    "),
+    list(line_number = 2L, column_number = 1L),
+    object_usage_linter()
+  )
+})
+
+test_that("global variable detection works", {
+  old_globals <- utils::globalVariables(package = globalenv())
+  utils::globalVariables("global_function", package = globalenv())
+  on.exit(utils::globalVariables(old_globals, package = globalenv(), add = FALSE))
+
+  expect_lint(
+    trim_some("
+      foo <- function() {
+        if (global_function()) NULL
+
+        if (global_function()) {
+          NULL
+        }
+      }
+    "),
+    NULL,
+    object_usage_linter()
+  )
+})
+
+test_that("package detection works", {
+  expect_length(
+    lint_package("dummy_packages/package", linters = object_usage_linter(), parse_settings = FALSE),
+    9L
+  )
+})
+
+test_that("robust against errors", {
+  expect_lint(
+    "assign(\"x\", unknown_function)",
+    NULL,
+    object_usage_linter()
+  )
+})