1#' Unload a package
2#'
3#' This function attempts to cleanly unload a package, including unloading
4#' its namespace, deleting S4 class definitions and unloading any loaded
5#' DLLs. Unfortunately S4 classes are not really designed to be cleanly
6#' unloaded, and so we have to manually modify the class dependency graph in
7#' order for it to work - this works on the cases for which we have tested
8#' but there may be others.  Similarly, automated DLL unloading is best tested
9#' for simple scenarios (particularly with `useDynLib(pkgname)` and may
10#' fail in other cases. If you do encounter a failure, please file a bug report
11#' at \url{https://github.com/r-lib/pkgload/issues}.
12#'
13#' @inheritParams ns_env
14#' @param quiet if `TRUE` suppresses output from this function.
15#'
16#' @examples
17#' \dontrun{
18#' # Unload package that is in current directory
19#' unload()
20#'
21#' # Unload package that is in ./ggplot2/
22#' unload(pkg_name("ggplot2/"))
23#'
24#' library(ggplot2)
25#' # unload the ggplot2 package directly by name
26#' unload("ggplot2")
27#' }
28#' @export
29unload <- function(package = pkg_name(), quiet = FALSE) {
30
31  if (package == "compiler") {
32    # Disable JIT compilation as it could interfere with the compiler
33    # unloading. Also, if the JIT was kept enabled, it would cause the
34    # compiler package to be loaded again soon, anyway. Note if we
35    # restored the JIT level after the unloading, the call to
36    # enableJIT itself would load the compiler again.
37    oldEnable <- compiler::enableJIT(0)
38    if (oldEnable != 0) {
39      warning("JIT automatically disabled when unloading the compiler.")
40    }
41  }
42
43  if (!package %in% loadedNamespaces()) {
44    stop("Package ", package, " not found in loaded packages or namespaces")
45  }
46
47  unregister_methods(package)
48
49  # unloadNamespace calls onUnload hook and .onUnload, and detaches the
50  # package if it's attached. It will fail if a loaded package needs it.
51  unloaded <- tryCatch({
52    unloadNamespace(package)
53    TRUE
54  }, error = function(e) FALSE)
55
56  if (!unloaded) {
57    # unloadNamespace() failed before we get to the detach, so need to
58    # manually detach
59    unload_pkg_env(package)
60
61    # Can't use loadedNamespaces() and unloadNamespace() here because
62    # things can be in a weird state.
63    unregister_namespace(package)
64  }
65
66  # Clear so that loading the package again will re-read all files
67  clear_cache()
68
69  # Do this after detach, so that packages that have an .onUnload function
70  # which unloads DLLs (like MASS) won't try to unload the DLL twice.
71  unload_dll(package)
72}
73
74unload_pkg_env <- function(package) {
75  if (is_attached(package)) {
76    pos <- which(pkg_env_name(package) == search())
77    suppressWarnings(detach(pos = pos, force = TRUE))
78  }
79}
80
81# This unloads dlls loaded by either library() or load_all()
82unload_dll <- function(package) {
83  # Always run garbage collector to force any deleted external pointers to
84  # finalise
85  gc()
86
87  # Special case for devtools - don't unload DLL because we need to be able
88  # to access nsreg() in the DLL in order to run makeNamespace. This means
89  # that changes to compiled code in devtools can't be reloaded with
90  # load_all -- it requires a reinstallation.
91  if (package == "pkgload") {
92    return(invisible())
93  }
94
95  pkglibs <- loaded_dlls(package)
96
97  for (lib in pkglibs) {
98    dyn.unload(lib[["path"]])
99  }
100
101  # Remove the unloaded dlls from .dynLibs()
102  libs <- .dynLibs()
103  .dynLibs(libs[!(libs %in% pkglibs)])
104
105  invisible()
106}
107
108s3_unregister <- function(package) {
109  ns <- ns_env(package)
110
111  # If the package is loaded, but not installed this will fail, so we bail out in that case.
112  ns_defs <- suppressWarnings(try(parse_ns_file(system.file(package = package)), silent = TRUE))
113  if (inherits(ns_defs, "try-error")) {
114    return()
115  }
116  methods <- ns_defs$S3methods[, 1:2, drop = FALSE]
117
118  for (i in seq_len(nrow(methods))) {
119    method <- methods[i, , drop = FALSE]
120
121    generic <- env_get(ns, method[[1]], inherit = TRUE, default = NULL)
122    if (is_null(generic)) {
123      next
124    }
125
126    generic_ns <- topenv(fn_env(generic))
127    if (!is_namespace(generic_ns)) {
128      next
129    }
130
131    # Don't remove methods for generics defined in the namespace being
132    # unloaded. The stale namespace should still work as much as
133    # possible.
134    if (is_string(ns_env_name(generic_ns), package)) {
135      next
136    }
137
138    table <- generic_ns$.__S3MethodsTable__.
139    if (!is_environment(table)) {
140      next
141    }
142
143    nm <- paste0(method, collapse = ".")
144    env_unbind(table, nm)
145  }
146}
147