diff --git a/NEWS.md b/NEWS.md index 0da73eb07d..0edcf06198 100644 --- a/NEWS.md +++ b/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 diff --git a/R/namespace.R b/R/namespace.R index e4b82fc856..27ad3c54dc 100644 --- a/R/namespace.R +++ b/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( diff --git a/tests/testthat/test-namespace.R b/tests/testthat/test-namespace.R new file mode 100644 index 0000000000..051ad2e923 --- /dev/null +++ b/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) +})