From ccf49053b27c85d1cbe0ec2c942abc3457f619dc Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 12 Jun 2026 12:51:20 -0500 Subject: [PATCH] Run unload hooks This helps eliminate some method overloading warnings in S7. --- NEWS.md | 7 ++++ R/load.R | 18 ++++++++-- R/run-loadhooks.R | 26 +++++++++++++- man/load_all.Rd | 6 ++++ tests/testthat/test-load-hooks.R | 57 ++++++++++++++++++++++++++++++ tests/testthat/testLoadHooks/R/a.r | 5 +++ 6 files changed, 116 insertions(+), 3 deletions(-) diff --git a/NEWS.md b/NEWS.md index 8bcad978..fbd6c39b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,12 @@ # pkgload (development version) +* When reloading a package, `load_all()` now runs the unload hooks of the + previously loaded package (`.onUnload()` and user hooks registered with + `setHook()`), whether it was loaded with pkgload or regularly. The old + namespace and its DLL are still kept loaded so that dangling references + continue to work, and errors thrown from `.onUnload()` are demoted to + warnings so that they can't prevent reloading (#253). + # pkgload 1.5.2 * Better handling of S7 topics (#332). diff --git a/R/load.R b/R/load.R index b542b5a6..4ec6c3b6 100644 --- a/R/load.R +++ b/R/load.R @@ -64,6 +64,13 @@ #' behavior when loading an installed package with [library()], and can #' be useful for checking for missing exports. #' +#' - When reloading a package, `load_all()` runs the unload hooks +#' (`.onUnload()` and hooks registered with [setHook()]) of the old +#' namespace, but doesn't unload the namespace or its DLL. This keeps +#' dangling references to the old namespace in working order. Errors +#' thrown from `.onUnload()` are demoted to warnings so that they can't +#' prevent reloading. +#' #' # Controlling the debug compiler flags #' #' `load_all()` delegates to [pkgbuild::compile_dll()] to perform the actual @@ -183,12 +190,19 @@ load_all <- function( old_methods <- list() clear_cache() - # Remove package from known namespaces. We don't unload it to allow - # safe usage of dangling references. + # Remove package from known namespaces. We don't fully unload it, to + # allow safe usage of dangling references, but we run the unload hooks + # since `unloadNamespace()` never will (#253). if (is_loaded(package)) { patch_colon(package) methods_env <- ns_s3_methods(package) + + # Detach first so that hooks run in the same order as in + # `unloadNamespace()`: detach hooks, then unload hooks + unload_pkg_env(package) + run_unload_hooks(package) + unregister(package) # Save foreign methods after unregistering the package's own diff --git a/R/run-loadhooks.R b/R/run-loadhooks.R index f3b4d0f7..d816f9e1 100644 --- a/R/run-loadhooks.R +++ b/R/run-loadhooks.R @@ -30,7 +30,8 @@ run_pkg_hook <- function(package, hook) { if (hook %in% c("load", "attach")) { nsenv[[f_name]](dirname(ns_path), package) } else { - nsenv[[f_name]](dirname(ns_path)) + # `.onUnload()` and `.onDetach()` take the full path to the package + nsenv[[f_name]](ns_path) } metadata[[f_name]] <- TRUE @@ -67,6 +68,9 @@ run_user_hook <- function(package, hook) { try_fetch( if (hook %in% c("load", "attach")) { fun(package, lib_path) + } else if (hook == "unload") { + # `unloadNamespace()` passes the full path to the package + fun(package, ns_path) } else { fun(package) }, @@ -89,3 +93,23 @@ run_user_hook <- function(package, hook) { metadata[[hook_name]] <- TRUE invisible(TRUE) } + +# Run the unload hooks of a package that `load_all()` is about to +# reload. Reloading doesn't unload the namespace or its DLL (to allow +# safe usage of dangling references), so `unloadNamespace()` never gets +# a chance to run `.onUnload()` and the user `onUnload` hooks (#253). +# Errors are demoted to warnings so that a failing hook can't prevent +# reloading. +run_unload_hooks <- function(package) { + run_user_hook(package, "unload") + + try_fetch( + run_pkg_hook(package, "unload"), + error = function(cnd) { + cli::cli_warn( + "Problem while running `.onUnload()` for package {.pkg {package}}.", + parent = cnd + ) + } + ) +} diff --git a/man/load_all.Rd b/man/load_all.Rd index 8753777c..b942c9ae 100644 --- a/man/load_all.Rd +++ b/man/load_all.Rd @@ -126,6 +126,12 @@ it makes internal objects easy to access. To export only the objects listed as exports, use \code{export_all = FALSE}. This more closely simulates behavior when loading an installed package with \code{\link[=library]{library()}}, and can be useful for checking for missing exports. +\item When reloading a package, \code{load_all()} runs the unload hooks +(\code{.onUnload()} and hooks registered with \code{\link[=setHook]{setHook()}}) of the old +namespace, but doesn't unload the namespace or its DLL. This keeps +dangling references to the old namespace in working order. Errors +thrown from \code{.onUnload()} are demoted to warnings so that they can't +prevent reloading. } } diff --git a/tests/testthat/test-load-hooks.R b/tests/testthat/test-load-hooks.R index 3e6e3b85..7b9a341e 100644 --- a/tests/testthat/test-load-hooks.R +++ b/tests/testthat/test-load-hooks.R @@ -25,6 +25,24 @@ test_that("hooks called in correct order", { c("pkg_load", "user_load", "pkg_attach", "user_attach") ) + # Reloading runs the detach and unload hooks of the old namespace, + # in the same order as `unloadNamespace()` (#253) + reset_events() + load_all("testHooks") + expect_equal( + globalenv()$hooks$events, + c( + "user_detach", + "pkg_detach", + "user_unload", + "pkg_unload", + "pkg_load", + "user_load", + "pkg_attach", + "user_attach" + ) + ) + reset_events() unload("testHooks") expect_equal( @@ -137,6 +155,45 @@ test_that("onUnload", { rm(".__testLoadHooks__", envir = .GlobalEnv) }) +test_that("load_all() runs .onUnload() when reloading (#253)", { + load_all("testLoadHooks") + + .GlobalEnv$.__testLoadHooks__ <- 1 + load_all("testLoadHooks") + expect_equal(.GlobalEnv$.__testLoadHooks__, 2) + + # unload() runs the hook of the new namespace as usual + unload("testLoadHooks") + expect_equal(.GlobalEnv$.__testLoadHooks__, 3) + + rm(".__testLoadHooks__", envir = .GlobalEnv) +}) + +test_that(".onUnload() receives the full path to the package (#253)", { + load_all("testLoadHooks") + + path <- NULL + with_options( + "pkgload:::testLoadHooks::.onUnload" = function(libpath) path <<- libpath, + load_all("testLoadHooks") + ) + expect_equal(normalizePath(path), normalizePath(test_path("testLoadHooks"))) + + unload("testLoadHooks") +}) + +test_that("a failing .onUnload() doesn't prevent reloading (#253)", { + load_all("testLoadHooks") + + with_options( + "pkgload:::testLoadHooks::.onUnload" = function(libpath) stop("uh oh"), + expect_warning(load_all("testLoadHooks"), "onUnload") + ) + expect_true(is_loaded("testLoadHooks")) + + unload("testLoadHooks") +}) + test_that("user onLoad hooks are properly run", { load_all("testUserLoadHook") diff --git a/tests/testthat/testLoadHooks/R/a.r b/tests/testthat/testLoadHooks/R/a.r index 3bca1bf0..269e12c0 100644 --- a/tests/testthat/testLoadHooks/R/a.r +++ b/tests/testthat/testLoadHooks/R/a.r @@ -40,6 +40,11 @@ the$onattach_lib <- "" } .onUnload <- function(libpath) { + hook <- getOption("pkgload:::testLoadHooks::.onUnload") + if (is.function(hook)) { + hook(libpath) + } + # Increment this variable if it exists in the global env if (exists(".__testLoadHooks__", .GlobalEnv)) { .GlobalEnv$.__testLoadHooks__ <- .GlobalEnv$.__testLoadHooks__ + 1