Warn if S3 methods aren't "exported"

And export a bunch of roxygen2 methods thus revealed.

Fixes #1175

NAMESPACE

@@ -77,6 +77,12 @@ S3method(object_name,s3generic)
 S3method(object_name,s3method)
 S3method(object_name,s4generic)
 S3method(object_name,s4method)
+S3method(object_usage,"function")
+S3method(object_usage,data)
+S3method(object_usage,default)
+S3method(object_usage,s3method)
+S3method(object_usage,s4generic)
+S3method(object_usage,s4method)
 S3method(print,object)
 S3method(print,rd)
 S3method(print,rd_section)
@@ -163,6 +169,7 @@ S3method(roxy_tag_parse,roxy_tag_templateVar)
 S3method(roxy_tag_parse,roxy_tag_title)
 S3method(roxy_tag_parse,roxy_tag_usage)
 S3method(roxy_tag_parse,roxy_tag_useDynLib)
+S3method(roxy_tag_rd,default)
 S3method(roxy_tag_rd,roxy_tag_.formals)
 S3method(roxy_tag_rd,roxy_tag_.methods)
 S3method(roxy_tag_rd,roxy_tag_.reexport)

NEWS.md

@@ -1,5 +1,10 @@
 # roxygen2 (development version)
 
+* The NAMESPACE roclet now reports if you have S3 methods that are missing
+  an `@export` tag. All S3 methods need to be `@export`ed (which confusingly
+  really registers the method) even if the generic is not. This avoids rare,
+  but hard to debug, problems (#1175).
+
 * `@describeIn()` gives a more informative warning if you use it with an
   unsupported type (#1490).
 

R/namespace.R

@@ -48,6 +48,8 @@ roclet_preprocess.roclet_namespace <- function(x, blocks, base_path) {
 
 #' @export
 roclet_process.roclet_namespace <- function(x, blocks, env, base_path) {
+  warn_missing_s3_exports(blocks, env)
+
   blocks_to_ns(blocks, env)
 }
 
@@ -365,3 +367,28 @@ namespace_exports <- function(path) {
   export_lines <- attr(parsed, "srcref")[!map_lgl(parsed, is_import)]
   unlist(lapply(export_lines, as.character))
 }
+
+# missing s3 exports ------------------------------------------------------
+
+warn_missing_s3_exports <- function(blocks, env) {
+  objs <- as.list(env)
+  funs <- Filter(is.function, objs)
+  methods <- funs[map_lgl(names(funs), is_s3_method, env = env)]
+
+  s3blocks <- blocks[map_lgl(blocks, block_has_tags, c("export", "exportS3method"))]
+  s3objects <- map(blocks, function(block) block$object$value)
+
+  undocumented <- setdiff(methods, s3objects)
+  srcrefs <- map(undocumented, attr, "srcref")
+  messages <- paste0("S3 method `", names(undocumented) , "` needs @export or @exportS3method tag.")
+  map2(undocumented, messages, warn_roxy_function)
+}
+
+warn_roxy_function <- function(fun, message, ...) {
+  srcref <- attr(fun, "srcref")
+  file <- attr(srcref, "srcfile")$filename
+  line <- as.vector(srcref)[[1]]
+
+  message[[1]] <- paste0(link_to(file, line), " ", message[[1]])
+  cli::cli_inform(c(x = message), ...)
+}

R/rd-usage.R

@@ -26,20 +26,24 @@ object_usage <- function(x) {
   UseMethod("object_usage")
 }
 
+#' @export
 object_usage.default <- function(x) {
   NULL
 }
 
+#' @export
 object_usage.data <- function(x) {
   rd(x$alias)
 }
 
+#' @export
 object_usage.function <- function(x) {
   function_usage(x$alias, formals(x$value), identity)
 }
 
 object_usage.s3generic <- object_usage.function
 
+#' @export
 object_usage.s3method <- function(x) {
   method <- attr(x$value, "s3method")
   s3method <- function(name) {
@@ -48,10 +52,12 @@ object_usage.s3method <- function(x) {
   function_usage(method[1], formals(x$value), s3method)
 }
 
+#' @export
 object_usage.s4generic <- function(x) {
   function_usage(x$value@generic, formals(x$value), identity)
 }
 
+#' @export
 object_usage.s4method <- function(x) {
   s4method <- function(name) {
     classes <- auto_backtick(as.character(x$value@defined))

R/rd.R

@@ -226,6 +226,7 @@ roxy_tag_rd <- function(x, base_path, env) {
   UseMethod("roxy_tag_rd")
 }
 
+#' @export
 roxy_tag_rd.default <- function(x, base_path, env) {
 }