add lint for missing packages in object_usage_linter

NEWS.md

@@ -44,6 +44,7 @@
 * New `gitlab_output()` function to output lints to GitLab format (#2858, @lschneiderbauer)
 * `brace_linter()` requires `test_that()`'s `code=` argument to have curly braces (#2292, @MichaelChirico).
 * `fixed_regex_linter()` recognizes usage of the new (R 4.5.0) `grepv()` wrapper of `grep()`; `regex_subset_linter()` also recommends `grepv()` alternatives (#2855, @MichaelChirico).
+* `object_usage_linter()` lints missing packages that may cause false positives (#2872, @AshesITR)
 
 ### New linters
 

R/object_usage_linter.R

@@ -85,8 +85,16 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c(
 
     xml <- source_expression$full_xml_parsed_content
 
+    # Catch missing packages and report them as lints
+    library_lints <- list()
+    lint_hook <- function(lint_node, lint_msg) {
+      library_lints[[length(library_lints) + 1L]] <<- xml_nodes_to_lints(
+        lint_node, source_expression = source_expression, lint_message = lint_msg, type = "warning"
+      )
+    }
+
     # run the following at run-time, not "compile" time to allow package structure to change
-    env <- make_check_env(pkg_name, xml)
+    env <- make_check_env(pkg_name, xml, lint_hook)
 
     fun_assignments <- xml_find_all(xml, xpath_function_assignment)
 
@@ -144,12 +152,15 @@ object_usage_linter <- function(interpret_glue = NULL, interpret_extensions = c(
         if (is.na(line_based_match)) fun_assignment else line_based_match
       })
 
-      xml_nodes_to_lints(nodes, source_expression = source_expression, lint_message = res$message, type = "warning")
+      c(
+        library_lints,
+        xml_nodes_to_lints(nodes, source_expression = source_expression, lint_message = res$message, type = "warning")
+      )
     })
   })
 }
 
-make_check_env <- function(pkg_name, xml) {
+make_check_env <- function(pkg_name, xml, lint_hook) {
   if (!is.null(pkg_name)) {
     parent_env <- try_silently(getNamespace(pkg_name))
   }
@@ -160,7 +171,7 @@ make_check_env <- function(pkg_name, xml) {
 
   symbols <- c(
     get_assignment_symbols(xml),
-    get_imported_symbols(xml)
+    get_imported_symbols(xml, lint_hook)
   )
 
   # Just assign them an empty function
@@ -264,7 +275,7 @@ parse_check_usage <- function(expression,
   res
 }
 
-get_imported_symbols <- function(xml) {
+get_imported_symbols <- function(xml, lint_hook) {
   import_exprs_xpath <- "
   //SYMBOL_FUNCTION_CALL[text() = 'library' or text() = 'require']
     /parent::expr
@@ -280,10 +291,19 @@ get_imported_symbols <- function(xml) {
   import_exprs <- xml_find_all(xml, import_exprs_xpath)
   imported_pkgs <- get_r_string(import_exprs)
 
-  unlist(lapply(imported_pkgs, function(pkg) {
+  unlist(lapply(seq_along(import_exprs), function(i) {
     tryCatch(
-      getNamespaceExports(pkg),
-      error = function(e) character()
+      getNamespaceExports(imported_pkgs[[i]]),
+      error = function(e) {
+        pkg <- imported_pkgs[[i]]
+        lint_node <- xml2::xml_parent(import_exprs[[i]])
+        # nolint start: undesirable_function_name. .libPaths() is neccessary here.
+        lint_msg <- paste0("Could not find exported symbols for package \"", pkg, "\" in library ",
+                           toString(shQuote(.libPaths())), ". This may lead to false positives.")
+        # nolint end
+        lint_hook(lint_node, lint_msg)
+        character()
+      }
     )
   }))
 }

tests/testthat/test-object_usage_linter.R

@@ -254,7 +254,6 @@ test_that("used symbols are detected correctly", {
   )
 
 
-
   # regression #1322
   expect_silent(expect_lint("assign('x', 42)", NULL, object_usage_linter()))
 })
@@ -648,7 +647,10 @@ test_that("missing libraries don't cause issue", {
         a
       }
     "),
-    NULL,
+    list(
+      "Could not find exported symbols for package \"a.a.a.z.z.z\"",
+      line_number = 1L
+    ),
     object_usage_linter()
   )
 })