Use a slightly altered isS3stdGeneric() to detect non-standard generics

NEWS.md

@@ -180,6 +180,7 @@ function calls. (#850, #851, @renkun-ken)
 * `object_usage_linter()` now detects functions exported by packages that are explicitly attached using `library()` or `require()` calls (#1127, @AshesITR)
 * New helper `xml_nodes_to_lints()` for converting `xml_node` objects obtained using linter logic expressed in XPath into `Lint` objects (#1124, @michaelchirico)
 * Added more explanation why certain functions and operators might be undesirable and what alternatives to use (#1133, #1146, #1159, @AshesITR)
+* Improved S3 generic detection for non-standard S3 generics (#846, @jonkeane)
 
 # lintr 2.0.1
 

R/namespace.R

@@ -36,13 +36,14 @@ imported_s3_generics <- function(ns_imports) {
 }
 
 is_s3_generic <- function(fun) {
-  if (getRversion() >= "3.5.0") {
-    # Available in 3.4.0, but bugged there in multiple ways that cause errors
-    # throughout many base functions, e.g. `-`, `as.null.default`, `dontCheck`
-    utils::isS3stdGeneric(fun)
-  } else {
-    is.function(fun) # nocov
-  }
+  # Inspired by `utils::isS3stdGeneric`, though it will detect functions that
+  # have `useMethod()` in places other than the first expression.
+  bdexpr <- body(fun)
+  while (is.call(bdexpr) && bdexpr[[1L]] == "{") bdexpr <- bdexpr[[length(bdexpr)]]
+  ret <- is.call(bdexpr) && identical(bdexpr[[1L]], as.name("UseMethod"))
+  if (ret)
+    names(ret) <- bdexpr[[2L]]
+  ret
 }
 
 .base_s3_generics <- c(

tests/testthat/test-namespace.R

@@ -0,0 +1,17 @@
+test_that("is_s3_generic", {
+  func <- function(x) {
+    print(x)
+    UseMethod("func")
+  }
+
+  expect_true(is_s3_generic(func))
+})
+
+test_that("is_s3_generic doesn't error for namespace-qualified calls", {
+  func <- function(...) {
+    pkg::call()
+  }
+
+  expect_warning(result <- is_s3_generic(func), NA)
+  expect_false(result)
+})