diff --git a/NEWS.md b/NEWS.md index ee5ab8e1..248a35b7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # roxygen2 (development version) +* The `ROXYGEN_PKG` environment variable is now set up while roxygen + is running to the name of the package being documented (#1517). + +* Import directives are now ignored if they try to import from the + package being documented. This is useful to add self-dependencies in + standalone files meant to be used in other packages (r-lib/usethis#1853). + # roxygen2 7.2.3 * roxygen2 now supports HTML blocks in markdown. They are only included diff --git a/R/namespace.R b/R/namespace.R index 89d66ffb..19be1eff 100644 --- a/R/namespace.R +++ b/R/namespace.R @@ -220,7 +220,7 @@ roxy_tag_parse.roxy_tag_import <- function(x) { } #' @export roxy_tag_ns.roxy_tag_import <- function(x, block, env, import_only = FALSE) { - one_per_line("import", x$val) + one_per_line_ignore_current("import", x$val) } #' @export @@ -229,7 +229,7 @@ roxy_tag_parse.roxy_tag_importClassesFrom <- function(x) { } #' @export roxy_tag_ns.roxy_tag_importClassesFrom <- function(x, block, env, import_only = FALSE) { - repeat_first("importClassesFrom", x$val) + repeat_first_ignore_current("importClassesFrom", x$val) } #' @export @@ -238,7 +238,7 @@ roxy_tag_parse.roxy_tag_importFrom <- function(x) { } #' @export roxy_tag_ns.roxy_tag_importFrom <- function(x, block, env, import_only = FALSE) { - repeat_first("importFrom", x$val) + repeat_first_ignore_current("importFrom", x$val) } #' @export @@ -247,7 +247,7 @@ roxy_tag_parse.roxy_tag_importMethodsFrom <- function(x) { } #' @export roxy_tag_ns.roxy_tag_importMethodsFrom <- function(x, block, env, import_only = FALSE) { - repeat_first("importMethodsFrom", x$val) + repeat_first_ignore_current("importMethodsFrom", x$val) } #' @export @@ -315,12 +315,37 @@ export_s3_method <- function(x) { } one_per_line <- function(name, x) { - paste0(name, "(", auto_quote(x), ")") + if (length(x)) { + paste0(name, "(", auto_quote(x), ")") + } else { + NULL + } } repeat_first <- function(name, x) { paste0(name, "(", auto_quote(x[1]), ",", auto_quote(x[-1]), ")") } +one_per_line_ignore_current <- function(name, x) { + current <- peek_roxygen_pkg() + + # Ignore any occurrence of `current` inside `x` + if (is_string(current)) { + x <- x[x != current] + } + + one_per_line(name, x) +} +repeat_first_ignore_current <- function(name, x) { + current <- peek_roxygen_pkg() + + # Ignore the whole command if "first" is `current` + if (is_string(current) && length(x) && x[[1]] == current) { + NULL + } else { + repeat_first(name, x) + } +} + namespace_exports <- function(path) { if (!file.exists(path)) { return(character()) diff --git a/R/roxygenize-setup.R b/R/roxygenize-setup.R index 5baec62f..f3f21b28 100644 --- a/R/roxygenize-setup.R +++ b/R/roxygenize-setup.R @@ -1,4 +1,6 @@ -roxygen_setup <- function(path = ".", cur_version = NULL) { +roxygen_setup <- function(path = ".", + cur_version = NULL, + frame = caller_env()) { if (!file.exists(file.path(path, "DESCRIPTION"))) { cli::cli_abort( "{.arg package.dir} ({.path {path}}) does not contain a DESCRIPTION" @@ -23,9 +25,24 @@ roxygen_setup <- function(path = ".", cur_version = NULL) { man_path <- file.path(path, "man") dir.create(man_path, recursive = TRUE, showWarnings = FALSE) + withr::local_envvar( + ROXYGEN_PKG = desc::desc_get("Package", path), + .local_envir = frame + ) + is_first } +peek_roxygen_pkg <- function() { + pkg <- Sys.getenv("ROXYGEN_PKG") + + if (nzchar(pkg)) { + pkg + } else { + NULL + } +} + update_roxygen_version <- function(path, cur_version = NULL) { cur <- cur_version %||% as.character(utils::packageVersion("roxygen2")) prev <- roxygen_version(path) diff --git a/tests/testthat/test-namespace.R b/tests/testthat/test-namespace.R index 567453ce..6eebfd40 100644 --- a/tests/testthat/test-namespace.R +++ b/tests/testthat/test-namespace.R @@ -203,6 +203,23 @@ test_that("other namespace tags produce correct output", { ))) }) +test_that("import directives for current package are ignored", { + withr::local_envvar(c("ROXYGEN_PKG" = "ignored")) + + out <- roc_proc_text(namespace_roclet(), " + #' @import ignored + #' @import test ignored test2 + #' @importFrom ignored test1 test2 + #' @importClassesFrom ignored test1 test2 + #' @importMethodsFrom ignored test1 test2 + NULL") + + expect_equal(sort(out), sort(c( + "import(test)", + "import(test2)" + ))) +}) + test_that("poorly formed importFrom throws error", { expect_snapshot_warning(roc_proc_text(namespace_roclet(), " #' @importFrom test