Don't add package name alias if used elsewhere

Fixes #1160

NAMESPACE

@@ -36,6 +36,7 @@ S3method(format,rd_section_keyword)
 S3method(format,rd_section_minidesc)
 S3method(format,rd_section_name)
 S3method(format,rd_section_note)
+S3method(format,rd_section_package)
 S3method(format,rd_section_param)
 S3method(format,rd_section_rawRd)
 S3method(format,rd_section_rcmethods)
@@ -171,6 +172,7 @@ 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_.package)
 S3method(roxy_tag_rd,roxy_tag_.reexport)
 S3method(roxy_tag_rd,roxy_tag_author)
 S3method(roxy_tag_rd,roxy_tag_backref)

NEWS.md

@@ -1,5 +1,8 @@
 # roxygen2 (development version)
 
+* `_PACKAGE` will no longer generate an alias for your package name if 
+  a function of the same name exists (#1160).
+
 * `@exportS3Method` provides the needed metadata to generate correct usage
   for S3 methods, just like `@method` (#1202).
 

R/object-defaults.R

@@ -61,10 +61,10 @@ object_defaults.package <- function(x, block) {
   authors <- package_authors(desc$get_field("Authors@R", NULL))
 
   list(
+    roxy_generated_tag(block, ".package", name),
     roxy_generated_tag(block, "docType", "package"),
     roxy_generated_tag(block, "name", package_suffix(name)),
-    # "NULL" prevents addition of default aliases, see also #202
-    roxy_generated_tag(block, "aliases", paste("NULL", name, package_suffix(name))),
+    # default aliases are added in topics_add_package_alias()
     roxy_generated_tag(block, "title", paste0(name, ": ", title)),
     roxy_generated_tag(block, "description", description),
     roxy_generated_tag(block, "seealso", seealso),

R/object-from-call.R

@@ -104,7 +104,7 @@ parser_package <- function(file) {
     desc = desc::desc(file = pkg_path),
     path = pkg_path
   )
-  object(value, "_PACKAGE", type = "package")
+  object(value, NULL, type = "package")
 }
 
 parser_assignment <- function(call, env, block) {

R/rd.R

@@ -46,6 +46,7 @@ roclet_process.roclet_rd <- function(x, blocks, env, base_path) {
   topics$drop_invalid()
   topics_fix_params_order(topics)
   topics_add_default_description(topics)
+  topics_add_package_alias(topics)
 
   topics$topics
 }
@@ -209,6 +210,25 @@ topics_add_default_description <- function(topics) {
   invisible()
 }
 
+topics_add_package_alias <- function(topics) {
+  aliases <- unlist(topics$simple_values("alias"), use.names = FALSE)
+
+  for (topic in topics$topics) {
+    if (!identical(topic$get_value("docType"), "package")) {
+      next
+    }
+
+    package <- topic$get_value("package")
+    defaults <- c(package, package_suffix(package))
+
+    aliases <- union(setdiff(defaults, aliases), topic$get_value("alias"))
+    topic$add(rd_section("alias", aliases), overwrite = TRUE)
+    break
+  }
+
+  invisible(NULL)
+}
+
 # Tag-wise processing -----------------------------------------------------
 
 #' Generate Rd output from a tag
@@ -241,6 +261,12 @@ roxy_tag_rd.roxy_tag_.formals <- function(x, base_path, env) {
 #' @export
 format.rd_section_formals <- function(x, ...) NULL
 
+#' @export
+roxy_tag_rd.roxy_tag_.package <- function(x, base_path, env) {
+  rd_section("package", x$val)
+}
+#' @export
+format.rd_section_package <- function(x, ...) NULL
 
 #' @export
 roxy_tag_parse.roxy_tag_method <- function(x) tag_words(x, 2, 2)

R/roclet.R

@@ -123,15 +123,20 @@ is.roclet <- function(x) inherits(x, "roclet")
 #'
 #' @param roclet Name of roclet to use for processing.
 #' @param input Source string
+#' @param wd Working directory
 #' @export
 #' @keywords internal
-roc_proc_text <- function(roclet, input) {
+roc_proc_text <- function(roclet, input, wd = NULL) {
   stopifnot(is.roclet(roclet))
 
   file <- tempfile()
   write_lines(input, file)
   on.exit(unlink(file))
 
+  if (!is.null(wd)) {
+    withr::local_dir(wd)
+  }
+
   env <- env_file(file)
   blocks <- parse_text(input, env = env)
   roclet_process(roclet, blocks, env = env, base_path = ".")

tests/testthat/_snaps/object-from-call.md

@@ -1,8 +1,8 @@
-# finds package description
+# recommends use of _PACKAGE
 
     Code
-      blocks <- parse_file(file.path(path, "R/packages.R"))
+      out <- parse_text(block)[[1]]
     Message
-      x packages.R:2: `@docType "package"` is deprecated.
+      x <text>:3: `@docType "package"` is deprecated.
       i Please document "_PACKAGE" instead.
 

tests/testthat/test-object-from-call.R

@@ -6,26 +6,22 @@ test_that("undocumentable things return null", {
 
 # data / package -------------------------------------------------------
 
-test_that("finds package description", {
+test_that("recommends use of _PACKAGE", {
   path <- local_package_copy(test_path("empty"))
-  write_lines(path = file.path(path, "R/packages.R"), c(
-    "#' @docType package
-    NULL"
-  ))
-  expect_snapshot(blocks <- parse_file(file.path(path, "R/packages.R")))
-
-  expect_s3_class(blocks[[1]]$object, "package")
-
-  expect_equal(
-    block_get_tag_value(blocks[[1]], "aliases"),
-    "NULL empty empty-package"
-  )
+
+  block <- "
+    #' @docType package
+    NULL
+  "
+  withr::with_dir(path, expect_snapshot(out <- parse_text(block)[[1]]))
+
+  expect_s3_class(out$object, "package")
+  expect_equal(out$object$value$desc$get_field("Package"), "empty")
 })
 
 test_that("finds package description", {
   obj <- call_to_object("_PACKAGE", file = test_path("testEagerData/R/a.r"))
   expect_s3_class(obj, "package")
-  expect_equal(obj$alias, "_PACKAGE")
   expect_equal(obj$value$desc$get_field("Package"), "testEagerData")
 })
 

tests/testthat/test-rd.R

@@ -96,24 +96,15 @@ test_that("@description NULL", {
   expect_identical(out[[1]]$get_value("description"), "Title")
 
   # But drop for package docs
-  path <- local_package_copy(test_path("empty"))
-  desc::desc_set(
-    file = path,
-    Package = "roxygendevtest",
-    Title = "Package Title",
-    Description = "Package description."
-  )
-  withr::with_dir(
-    path,
-    out <- roc_proc_text(rd_roclet(), "
-      #' Title
-      #'
-      #' @docType package
-      #' @description NULL
-      #' @name pkg
-      '_PACKAGE'
-    ")
-  )
+  block <- "
+    #' Title
+    #'
+    #' @docType package
+    #' @description NULL
+    #' @name pkg
+    '_PACKAGE'
+  "
+  out <- roc_proc_text(rd_roclet(), block, wd = test_path("empty"))
   expect_null(out[[1]]$get_value("description"))
 })
 
@@ -148,6 +139,60 @@ test_that("@details NULL", {
   expect_null(out[[1]]$get_value("details"))
 })
 
+
+# package docs ------------------------------------------------------------
+
+
+test_that("package docs don't get alias if function present", {
+
+  block <- "
+    #' Title
+    #'
+    '_PACKAGE'
+
+    #' Empty
+    empty <- function() {}
+  "
+
+  out <- roc_proc_text(rd_roclet(), block, test_path("empty"))[[1]]
+  expect_equal(out$get_value("alias"), "empty-package")
+})
+
+test_that("package docs preserve existing aliases", {
+  block <- "
+    #' Title
+    #' @aliases a b
+    #'
+    '_PACKAGE'
+  "
+
+  out <- roc_proc_text(rd_roclet(), block, test_path("empty"))[[1]]
+  expect_equal(out$get_value("alias"), c("empty", "empty-package", "a", "b"))
+
+  block <- paste0(block, "
+    #' Empty
+    empty <- function() {}
+  ")
+  out <- roc_proc_text(rd_roclet(), block, test_path("empty"))[[1]]
+  expect_equal(out$get_value("alias"), c("empty-package", "a", "b"))
+})
+
+test_that("get correct alias even if user has overriden name", {
+  block <- "
+    #' Title
+    #' @name foo
+    #' @aliases bar
+    #'
+    '_PACKAGE'
+  "
+
+  out <- roc_proc_text(rd_roclet(), block, test_path("empty"))[[1]]
+  expect_equal(
+    out$get_value("alias"),
+    c("empty", "empty-package", "foo", "bar")
+  )
+})
+
 # UTF-8 -------------------------------------------------------------------
 
 test_that("can generate nonASCII document", {