Add S3 group generics to .base_s3_generics, include exported S3 generics in generic list

NEWS.md

@@ -24,6 +24,8 @@
 
 * Row names for `available_linters()` data frame are now contiguous (#1781, @IndrajeetPatil).
 
+* `object_name_linter()` allows all S3 group Generics (see `?base::groupGeneric`) and S3 generics defined in a different file in the same package (#1808, #1841, @AshesITR)
+
 ## Changes to defaults
 
 * Set the default for the `except` argument in `duplicate_argument_linter()` to `c("mutate", "transmute")`.

R/namespace.R

@@ -1,5 +1,5 @@
 # Parse namespace files and return imports exports, methods
-namespace_imports <- function(path = find_package()) {
+namespace_imports <- function(path = find_package(".")) {
   namespace_data <- tryCatch(
     parseNamespaceFile(basename(path), package.lib = file.path(path, "..")),
     error = function(e) NULL
@@ -35,7 +35,7 @@ safe_get_exports <- function(ns) {
 }
 
 empty_namespace_data <- function() {
-  data.frame(pkg = character(), ns = character(), stringsAsFactors = FALSE)
+  data.frame(pkg = character(), fun = character(), stringsAsFactors = FALSE)
 }
 
 # filter namespace_imports() for S3 generics
@@ -54,6 +54,22 @@ imported_s3_generics <- function(ns_imports) {
   ns_imports[is_generic, ]
 }
 
+exported_s3_generics <- function(path = find_package(".")) {
+  namespace_data <- tryCatch(
+    parseNamespaceFile(basename(path), package.lib = file.path(path, "..")),
+    error = function(e) NULL
+  )
+
+  if (length(namespace_data$S3methods) == 0L || nrow(namespace_data$S3methods) == 0L) {
+    return(empty_namespace_data())
+  }
+
+  data.frame(
+    pkg = basename(path),
+    fun = unique(namespace_data$S3methods[, 1L])
+  )
+}
+
 is_s3_generic <- function(fun) {
   # Inspired by `utils::isS3stdGeneric`, though it will detect functions that
   # have `useMethod()` in places other than the first expression.
@@ -66,7 +82,7 @@ is_s3_generic <- function(fun) {
   ret
 }
 
-.base_s3_generics <- c(
+.base_s3_generics <- unique(c(
   names(.knownS3Generics),
   .S3PrimitiveGenerics,
   if (getRversion() >= "3.5.0") {
@@ -75,5 +91,16 @@ is_s3_generic <- function(fun) {
     # R < 3.5.0 doesn't provide .S3_methods_table
     # fallback: search baseenv() for generic methods
     imported_s3_generics(data.frame(pkg = "base", fun = ls(baseenv()), stringsAsFactors = FALSE))$fun
-  }
-)
+  },
+  # S3 generic groups, see ?base::groupGeneric
+  # Group "Math"
+  c("abs", "sign", "sqrt", "floor", "ceiling", "trunc", "round", "signif", "exp", "log", "expm1", "log1p", "cos",
+    "sin", "tan", "cospi", "sinpi", "tanpi", "acos", "asin", "atan", "cosh", "sinh", "tanh", "acosh", "asinh", "atanh",
+    "lgamma", "gamma", "digamma", "trigamma", "cumsum", "cumprod", "cummax", "cummin"),
+  # Group "Ops"
+  c("+", "-", "*", "/", "^", "%%", "%/%", "&", "|", "!", "==", "!=", "<", "<=", ">=", ">"),
+  # Group "Summary"
+  c("all", "any", "sum", "prod", "min", "max", "range"),
+  # Group "Complex"
+  c("Arg", "Conj", "Im", "Mod", "Re")
+))

R/object_length_linter.R

@@ -52,10 +52,12 @@ object_length_linter <- function(length = 30L) {
     )
 
     # run namespace_imports at run-time, not "compile" time to allow package structure to change
-    ns_imports <- namespace_imports(find_package(source_expression$filename))
+    pkg <- find_package(source_expression$filename)
+    ns_imports <- namespace_imports(pkg)
     generics <- strip_names(c(
       declared_s3_generics(xml),
       imported_s3_generics(ns_imports)$fun,
+      exported_s3_generics(pkg)$fun,
       .base_s3_generics
     ))
     generics <- unique(generics[nzchar(generics)])

R/object_name_linter.R

@@ -141,9 +141,11 @@ object_name_linter <- function(styles = c("snake_case", "symbols"), regexes = ch
     )
 
     # run namespace_imports at run-time, not "compile" time to allow package structure to change
+    pkg <- find_package(source_expression$filename)
     generics <- c(
       declared_s3_generics(xml),
-      imported_s3_generics(namespace_imports(find_package(source_expression$filename)))$fun,
+      imported_s3_generics(namespace_imports(pkg))$fun,
+      exported_s3_generics(pkg)$fun,
       .base_s3_generics
     )
     generics <- unique(generics[nzchar(generics)])

tests/testthat/dummy_packages/clean/DESCRIPTION

@@ -1,2 +1,3 @@
 Package: clean
 Version: 0.0.1
+RoxygenNote: 7.2.2

tests/testthat/dummy_packages/clean/NAMESPACE

@@ -1 +1,10 @@
-importFrom(utils,head)
+# Generated by roxygen2: do not edit by hand
+
+S3method("names<-",my_custom_class)
+S3method(drink_me,data.frame)
+S3method(drink_me,default)
+S3method(drink_me,list)
+S3method(eat_me,liiiiiiiiiiiiiiiiiiiiiiiiiiist)
+S3method(head,my_s3_object)
+export(drink_me)
+export(eat_me)

tests/testthat/dummy_packages/clean/R/clean_generics.R

@@ -37,3 +37,10 @@ head.my_s3_object <- function(x, ...) {
 `names<-.my_custom_class` <- function(x, value) {
   NULL
 }
+
+#' @export
+#' Defined S3 generic in R/eat_me.R
+#' Tests #1808
+eat_me.liiiiiiiiiiiiiiiiiiiiiiiiiiist <- function(x, ...) {
+  NULL
+}

tests/testthat/dummy_packages/clean/R/eat_me.R

@@ -0,0 +1,7 @@
+#' eat_me
+#' @description empty
+#'
+#' @export
+eat_me <- function(x, ...) {
+  UseMethod("drink_me")
+}

tests/testthat/test-object_name_linter.R

@@ -51,6 +51,12 @@ test_that("linter ignores some objects", {
   expect_lint(".First <- function(...) TRUE", NULL, object_name_linter("snake_case")) # namespace hooks
   expect_lint("`%++%` <- `+`", NULL, object_name_linter("symbols")) # all-symbol operator
   expect_lint("`%<-%` <- `+`", NULL, object_name_linter("symbols")) # all-symbol operator #495
+  # S3 group generic, #1841
+  expect_lint(
+    "`==.snake_case` <- function(a, b) unclass(a) == unclass(b)",
+    NULL,
+    object_name_linter("snake_case")
+  )
 })
 
 test_that("linter returns correct linting", {