Preserve namespaces as much as possible on reloads

NEWS.md

@@ -1,5 +1,23 @@
 # pkgload (development version)
 
+* `load_all()` now preserves existing namespaces in working order. In
+  particular, it doesn't unload the package's shared library and keeps
+  it loaded instead. When reloading, a copy of the SO for the new
+  namespace is loaded from a temporary location. These temporary SOs
+  are only unloaded on GC and deleted from their temporary location
+  via a weak reference attached to the namespace.
+
+  This mechanism ensures that lingering references to the namespace
+  keep working as expected. Consequently the namespace
+  propagation routine that was added to pkgload as a workaround has
+  been removed.
+
+  Note that `.Call()` invokations that pass a string symbol rather
+  than a structured symbol may keep crashing, because R will look into
+  the most recently loaded SO of a given name. Since symbol
+  registration is now the norm, we don't expect this to cause much
+  trouble.
+
 * `load_all()` no longer forces all bindings of a namespace to avoid
   lazy-load errors. Instead, it removes exported S3 methods from the
   relevant tables.

R/imports-env.r

@@ -49,12 +49,16 @@ load_imports <- function(path = ".") {
   deps <- description$get_deps()
   imports <- deps[deps$type == "Imports", ]
 
-  if (length(imports) == 0) return(invisible())
+  if (length(imports) == 0) {
+    return(invisible())
+  }
 
   # If we've already loaded imports, don't load again (until load_all
   # is run with reset=TRUE). This is to avoid warnings when running
   # process_imports()
-  if (length(ls(imports_env(package))) > 0) return(invisible(imports))
+  if (length(ls(envir = imports_env(package))) > 0) {
+    return(invisible(imports))
+  }
 
   res <- mapply(check_dep_version, imports$package, imports$version)
   abort_for_missing_packages(res, imports$package)
@@ -120,23 +124,3 @@ onload_assign("process_imports", {
 
   process_imports
 })
-
-onload_assign("update_imports", {
-  update_imports <- function(package) {
-    vI <- ("tools" %:::% ".split_dependencies")(utils::packageDescription(package)[["Imports"]])
-    nsInfo <- parse_ns_file(system.file("NAMESPACE", package = package))
-    ns <- ns_env(package)
-    lib.loc <- NULL
-
-    suppressWarnings({
-      !! load_namespace_for1()
-      !! load_namespace_for2()
-      !! load_namespace_for3()
-    })
-  }
-
-  update_imports <- expr_interp(update_imports)
-  fn_env(update_imports) <- rlang::ns_env("pkgload")
-
-  update_imports
-})

R/load-dll.r

@@ -35,6 +35,10 @@ onload_assign("load_dll", {
     !!for_loop
     addNamespaceDynLibs(env, nsInfo$dynlibs)
 
+    # Delete the temporary SO when the namespace gets garbage collected
+    dll_path <- dlls[[package]][["path"]]
+    new_weakref(env, finalizer = ns_finalizer(dll_path))
+
     invisible(dlls)
   }
 
@@ -44,6 +48,19 @@ onload_assign("load_dll", {
   load_dll
 })
 
+ns_finalizer <- function(path) {
+  force(path)
+  function(...) {
+    # Clean up the temporary .so file.
+    unlink(path)
+
+    # Remove the .so from the cached list of loaded modules
+    loaded <- .dynLibs()
+    loaded <- Filter(function(x) !is_string(x[["path"]], path), loaded)
+    .dynLibs(loaded)
+  }
+}
+
 # Return a list of currently loaded DLLs from the package
 loaded_dlls <- function(package) {
   libs <- .dynLibs()
@@ -59,15 +76,27 @@ loaded_dlls <- function(package) {
 library.dynam2 <- function(path = ".", lib = "") {
   path <- pkg_path(path)
 
-  dllname <- paste(lib, .Platform$dynlib.ext, sep = "")
+  dyn_ext <- .Platform$dynlib.ext
+  dllname <- paste(lib, dyn_ext, sep = "")
   dllfile <- package_file("src", dllname, path = path)
 
-  if (!file.exists(dllfile))
+  if (!file.exists(dllfile)) {
     return(invisible())
+  }
+
+  # Copy the .so to a temporary directory with a unique name. This way
+  # we may have different versions of the .so loaded, in case
+  # references to the previously loaded .so linger in the session.
+  # The .so should have the package name so that R can find the
+  # `R_init_` function by itself.
+  dll_copy_dir <- tempfile("pkgload")
+  dll_copy_file <- file.path(dll_copy_dir, paste0(pkg_name(path), dyn_ext))
+  dir.create(dll_copy_dir)
+  file.copy(dllfile, dll_copy_file)
 
   # # The loading and registering of the dll is similar to how it's done
   # # in library.dynam.
-  dllinfo <- dyn.load(dllfile)
+  dllinfo <- dyn.load(dll_copy_file)
 
   # Register dll info so it can be unloaded with library.dynam.unload
   .dynLibs(c(.dynLibs(), list(dllinfo)))

R/load.r

@@ -129,23 +129,6 @@ load_all <- function(path = ".", reset = TRUE, compile = NA,
     cli::cli_code(msg)
   }
 
-  ## The unload() has to come before unload_dll(), for packages with
-  ## compiled code, becauase they might crash of objects still use the
-  ## DLL's memory.
-  if (reset) {
-    clear_cache()
-    if (is_loaded(package)) unload(package, quiet = quiet)
-  }
-
-  if (is_loaded(package) && is.null(dev_meta(package))) {
-    # If installed version of package loaded, unload it
-    # (and also the DLLs)
-    unload(package, quiet = quiet)
-  } else {
-    # Unload only DLLs
-    unload_dll(package)
-  }
-
   # Compile dll if requested
   if (missing(compile) && !missing(recompile)) {
     compile <- if (isTRUE(recompile)) TRUE else NA
@@ -161,16 +144,21 @@ load_all <- function(path = ".", reset = TRUE, compile = NA,
     stop("`compile` must be a logical vector of length 1", call. = FALSE)
   }
 
-  # If installed version of package loaded, unload it, again
-  # (needed for dependencies of pkgbuild)
-  if (is_loaded(package) && is.null(dev_meta(package))) {
-    unload(package, quiet = quiet)
-  }
+  if (reset) {
+    clear_cache()
 
-  # Set up the namespace environment ----------------------------------
-  # This mimics the procedure in loadNamespace
+    # Remove package from known namespaces. We don't unload it to allow
+    # safe usage of dangling references.
+    if (is_loaded(package)) {
+      unload_pkg_env(package)
+      unregister_methods(package)
+      unregister_namespace(package)
+    }
+  }
 
-  if (!is_loaded(package)) create_ns_env(path)
+  if (!is_loaded(package)) {
+    create_ns_env(path)
+  }
 
   out <- list(env = ns_env(package))
 
@@ -231,9 +219,6 @@ load_all <- function(path = ".", reset = TRUE, compile = NA,
   # Replace help and ? in utils package environment
   insert_global_shims()
 
-  # Propagate new definitions to namespace imports of loaded packages.
-  propagate_ns(package)
-
   if (isTRUE(warn_conflicts)) {
     warn_if_conflicts(package, getNamespaceExports(out$env), names(globalenv()))
   }
@@ -319,22 +304,3 @@ find_test_dir <- function(path) {
 
   stop("No testthat directories found in ", path, call. = FALSE)
 }
-
-propagate_ns <- function(package) {
-  for (ns in loadedNamespaces()) {
-    imports <- getNamespaceImports(ns)
-    if (package %in% names(imports)) {
-      env <- ns_env(ns)
-      lapply(ls(env, all.names = TRUE), unlockBinding, env)
-
-      imp <- imports_env(ns)
-      lapply(ls(imp, all.names = TRUE), unlockBinding, imp)
-
-      unlock_environment(env)
-      unlock_environment(imp)
-      update_imports(ns)
-      lockEnvironment(env)
-      lockEnvironment(imp)
-    }
-  }
-}

R/namespace-env.r

@@ -240,7 +240,26 @@ unregister_namespace <- function(name = NULL) {
   if (!(name %in% loadedNamespaces()))
     stop(name, " is not a registered namespace.")
 
+  # This is a hack to work around unloading pkgload itself. The unloading
+  # process normally makes other pkgload functions inaccessible,
+  # resulting in "Error in unload(pkg) : internal error -3 in R_decompress1".
+  # If we simply force them first, then they will remain available for use
+  # later. This also makes it possible to use `load_all()` on pkgload itself.
+  if (name == "pkgload") {
+    eapply(ns_env(name), force, all.names = TRUE)
+  }
+
   # Remove the item from the registry
   do.call(rm, args = list(name, envir = ns_registry()))
   invisible()
 }
+
+unregister_methods <- function(package) {
+  # Unloading S3 methods manually avoids lazy-load errors when the new
+  # package is loaded overtop the old one. It also prevents removed
+  # methods from staying registered.
+  s3_unregister(package)
+
+  # S4 classes that were created by the package need to be removed in a special way.
+  remove_s4_classes(package)
+}

R/unload.r

@@ -40,27 +40,12 @@ unload <- function(package = pkg_name(), quiet = FALSE) {
     }
   }
 
-  # This is a hack to work around unloading pkgload itself. The unloading
-  # process normally makes other pkgload functions inaccessible,
-  # resulting in "Error in unload(pkg) : internal error -3 in R_decompress1".
-  # If we simply force them first, then they will remain available for use
-  # later.
-  if (package == "pkgload") {
-    eapply(ns_env(package), force, all.names = TRUE)
-  }
-
-  # Unloading S3 methods manually avoids lazy-load errors when the new
-  # package is loaded overtop the old one. It also prevents removed
-  # methods from staying registered.
-  s3_unregister(package)
-
-  # S4 classes that were created by the package need to be removed in a special way.
-  remove_s4_classes(package)
-
   if (!package %in% loadedNamespaces()) {
     stop("Package ", package, " not found in loaded packages or namespaces")
   }
 
+  unregister_methods(package)
+
   # unloadNamespace calls onUnload hook and .onUnload, and detaches the
   # package if it's attached. It will fail if a loaded package needs it.
   unloaded <- tryCatch({
@@ -76,11 +61,7 @@ unload <- function(package = pkg_name(), quiet = FALSE) {
 
     # unloadNamespace() failed before we get to the detach, so need to
     # manually detach
-    pkgenv <- pkg_env(package)
-    if (is_attached(package)) {
-      pos <- which(pkg_env_name(package) == search())
-      suppressWarnings(detach(pos = pos, force = TRUE))
-    }
+    unload_pkg_env(package)
 
     # Can't use loadedNamespaces() and unloadNamespace() here because
     # things can be in a weird state.
@@ -95,6 +76,13 @@ unload <- function(package = pkg_name(), quiet = FALSE) {
   unload_dll(package)
 }
 
+unload_pkg_env <- function(package) {
+  if (is_attached(package)) {
+    pos <- which(pkg_env_name(package) == search())
+    suppressWarnings(detach(pos = pos, force = TRUE))
+  }
+}
+
 # This unloads dlls loaded by either library() or load_all()
 unload_dll <- function(package) {
   # Always run garbage collector to force any deleted external pointers to

R/utils.R

@@ -180,7 +180,3 @@ last <- function(x) utils::tail(x, n = 1L)
 single_quote <- function(x) {
   encodeString(x, quote = "'")
 }
-
-unlock_environment <- function(x) {
-  get(".Call")("rlang_env_unlock", x, PACKAGE = "rlang")
-}