#206 Warn for installing loaded packages

Merged gaborcsardi

No flags found

Use flags to group coverage reports by test type, project and/or folders.
Then setup custom commit statuses and notifications for each flag.

e.g., #unittest #integration

#production #enterprise

#frontend #backend

Learn more about Codecov Flags here.

Showing 8 of 9 files from the diff.

@@ -245,3 +245,20 @@
Loading
245 245
    interactive()
246 246
  }
247 247
}
248 +
249 +
loaded_packages <- function(lib) {
250 +
  lib <- normalizePath(lib)
251 +
  pkgs <- setdiff(loadedNamespaces(), base_packages())
252 +
  libs <- vcapply(pkgs, function(x) dirname(getNamespaceInfo(x, "path")))
253 +
254 +
  bad <- normalizePath(libs) == lib
255 +
  pkgs[bad]
256 +
}
257 +
258 +
lapply_with_names <- function(X, FUN, ...) {
259 +
  structure(lapply(X, FUN, ...), names = X)
260 +
}
261 +
262 +
na_omit <- function(x) {
263 +
  x[!is.na(x)]
264 +
}

@@ -0,0 +1,136 @@
Loading
1 +
2 +
#' Unload packages
3 +
#'
4 +
#' It will unload `packages` and their loaded reverse dependencies
5 +
#' (imports, really).
6 +
#'
7 +
#' It will not unload
8 +
#' * base packages
9 +
#' * pak
10 +
#' * packages that are not loaded, obviously.
11 +
#'
12 +
#' This function is similar to `pkgload::unload()`, but it is specialized
13 +
#' to pak, in that
14 +
#' * it does not deal with packages loaded by pkgload.
15 +
#' * it will not unload base packages and pak itself.
16 +
#' * it will also unload the loaded reverse dependencies of the unloaded
17 +
#'   packages, in the right order.
18 +
#' * It never forces an unload. (It does not need to, since reverse
19 +
#'   dependencies are unloaded first.)
20 +
#'
21 +
#' @param packages [character] The packages to unload.
22 +
#' @return The unloaded packages, unvisibly.
23 +
#'
24 +
#' @noRd
25 +
26 +
unload <- function(packages) {
27 +
28 +
  badbase <- intersect(base_packages(), packages)
29 +
  if (length(badbase) > 0) {
30 +
    packages <- setdiff(packages, badbase)
31 +
    warning("Will not unload base packages: ", paste(badbase, collapse = ", "))
32 +
  }
33 +
34 +
  if ("pak" %in% packages) {
35 +
    packages <- setdiff(packages, "pak")
36 +
    warning("Will not unload pak")
37 +
  }
38 +
39 +
  badloaded <- setdiff(packages, loadedNamespaces())
40 +
  if (length(badloaded) > 0) {
41 +
    packages <- setdiff(packages, badloaded)
42 +
    warning(
43 +
      "Will not unload packages that are load not loaded: ",
44 +
      paste(badloaded, collapse = ", ")
45 +
    )
46 +
  }
47 +
48 +
  # This will also include reverse dependencies
49 +
  packages <- unload_order_topo(packages)
50 +
51 +
  # Always run garbage collector to force any deleted external pointers to
52 +
  # finalise
53 +
  gc()
54 +
55 +
  for (pkg in packages) {
56 +
    unloadNamespace(pkg)
57 +
    unload_dll(pkg)
58 +
  }
59 +
60 +
  # TODO: summary of packages unloaded
61 +
  bad <- intersect(packages, loadedNamespaces())
62 +
  if (length(bad) > 0) {
63 +
    stop(
64 +
      "Could not unload ",
65 +
      if (length(bad) == 1) "one package: " else "some packages: ",
66 +
      paste(bad, collapse = ", ")
67 +
    )
68 +
  }
69 +
70 +
  invisible(packages)
71 +
}
72 +
73 +
#' Query additional packages that need to be unloaded
74 +
#'
75 +
#' @param packages [character] Packages that we want to unload.
76 +
#' @return [character] All packages that need to be unloaded, because
77 +
#' they (recursively) depend on `packages`.
78 +
#'
79 +
#' @noRd
80 +
81 +
needs_unload <- function(packages) {
82 +
  packages <- setdiff(packages, c(base_packages(), "pak"))
83 +
  packages <- intersect(packages, loadedNamespaces())
84 +
  unload_order_topo(packages)
85 +
}
86 +
87 +
package_imports <- function(package, base = FALSE) {
88 +
  imp <- unique(names(getNamespaceInfo(package, "imports")))
89 +
  if (!base) imp <- imp[! imp %in% base_packages()]
90 +
  # pkgload has some unnamed components somehow?
91 +
  imp[imp != ""]
92 +
}
93 +
94 +
unload_order_topo <- function(packages) {
95 +
  all <- setdiff(loadedNamespaces(), base_packages())
96 +
  imp <- lapply_with_names(all, package_imports)
97 +
  imp_by <- lapply_with_names(all, function(p) {
98 +
    all[vlapply(imp, `%in%`, x = p)]
99 +
  })
100 +
101 +
  revs <- packages
102 +
  while (length(more <- setdiff(unlist(imp_by[revs]), revs)) > 0) {
103 +
    revs <- c(revs, more)
104 +
  }
105 +
  imp_by <- lapply(imp_by, intersect, revs)[revs]
106 +
107 +
  topo <- character()
108 +
  while (length(topo) < length(revs)) {
109 +
    new <- names(imp_by)[viapply(imp_by, length) == 0]
110 +
    if (length(new) == 0) stop("Loop in package imports???")
111 +
    topo <- c(topo, new)
112 +
    imp_by <- lapply(imp_by, setdiff, new)[setdiff(names(imp_by), new)]
113 +
  }
114 +
115 +
  topo
116 +
}
117 +
118 +
unload_dll <- function(package) {
119 +
  pkglibs <- loaded_dlls(package)
120 +
121 +
  for (lib in pkglibs) {
122 +
    dyn.unload(lib[["path"]])
123 +
  }
124 +
125 +
  # Remove the unloaded dlls from .dynLibs()
126 +
  libs <- .dynLibs()
127 +
  .dynLibs(libs[!(libs %in% pkglibs)])
128 +
129 +
  invisible()
130 +
}
131 +
132 +
loaded_dlls <- function(package) {
133 +
  libs <- .dynLibs()
134 +
  matchidx <- vapply(libs, "[[", character(1), "name") == package
135 +
  libs[matchidx]
136 +
}

@@ -64,21 +64,3 @@
Loading
64 64
    "downloaded ", downloaded, " (", prettyunits::pretty_bytes(dlbytes), ")",
65 65
    " {.timestamp {total_time}}"))
66 66
}
67 -
68 -
warn_for_loaded_packages <- function(pkgs, lib) {
69 -
  if (length(maybe_bad <- intersect(pkgs, loadedNamespaces()))) {
70 -
    loaded_from <- vcapply(
71 -
      maybe_bad,
72 -
      function(x) dirname(getNamespaceInfo(x, "path"))
73 -
    )
74 -
    bad <- maybe_bad[normalizePath(loaded_from) == normalizePath(lib)]
75 -
    bad <- setdiff(bad, "pak")
76 -
    if (length(bad)) {
77 -
      cli::cli_alert_warning(
78 -
        "Package(s) {format_items(bad)} are already loaded, installing \\
79 -
         them may cause problems. Use {.code pkgload::unload()} to unload them.",
80 -
        wrap = TRUE
81 -
      )
82 -
    }
83 -
  }
84 -
}

@@ -2,8 +2,10 @@
Loading
2 2
print_package_list <- function(x, new_version = NULL, old_version = NULL) {
3 3
  cli::cli_div(
4 4
    class = "pkglist",
5 -
    theme = list(div.pkglist = list("margin-left" = 2)))
6 -
5 +
    theme = list(
6 +
      div.pkglist = list("margin-left" = 2)
7 +
    )
8 +
  )
7 9
  if (!is.null(new_version) && !is.null(old_version)) {
8 10
    x <- paste0(x, " (", old_version, " ", cli::symbol$arrow_right, " ",
9 11
                new_version, ")")
@@ -19,7 +21,13 @@
Loading
19 21
  any(sol$lib_status == "update")
20 22
}
21 23
22 -
print_install_details <- function(sol, lib) {
24 +
print_install_details <- function(sol, lib, loaded) {
25 +
  cli::cli_div(
26 +
    theme = list(
27 +
      "div.alert-warning" = list("margin-top" = 1, "margin-bottom" = 1)
28 +
    )
29 +
  )
30 +
23 31
  direct <- sum(sol$direct)
24 32
  deps <- sum(! sol$direct)
25 33
@@ -28,9 +36,6 @@
Loading
28 36
  n_curr  <- sum(curr  <- sol$lib_status == "current")
29 37
  n_noupd <- sum(noupd <- sol$lib_status == "no-update")
30 38
31 -
  # Nothing to do?
32 -
  if (! (n_newly + n_upd)) return(FALSE)
33 -
34 39
  # Should we ask?
35 40
  should_ask <- should_ask_confirmation(sol)
36 41
@@ -43,8 +48,6 @@
Loading
43 48
    print_package_list(sol$ref[upd], sol$version[upd], sol$old_version[upd])
44 49
  }
45 50
46 -
  warn_for_loaded_packages(sol$package[newly | upd], lib)
47 -
48 51
  w_dl <- sol$cache_status == "miss" & !is.na(sol$cache_status)
49 52
  w_ch <- sol$cache_status == "hit" & !is.na(sol$cache_status)
50 53
  n_dl <- sum(w_dl, na.rm = TRUE)
@@ -80,7 +83,13 @@
Loading
80 83
    }
81 84
  }
82 85
83 -
  invisible(should_ask)
86 +
  if (length(loaded) > 0 || get_os() == "win") {
87 +
    ls <- warn_for_loaded_packages(sol$package[newly | upd], lib, loaded)
88 +
  } else {
89 +
    ls <- list(current = "clean", dlls = "clean")
90 +
  }
91 +
92 +
  invisible(list(should_ask = should_ask, loaded_status = ls))
84 93
}
85 94
86 95
get_confirmation <-  function(q, msg = "Aborted.") {
@@ -94,3 +103,13 @@
Loading
94 103
  ans <- readline(q)
95 104
  tolower(ans) %in% c("", "y", "yes", "yeah", "yep")
96 105
}
106 +
107 +
get_answer <- function(answers, prompt = NULL) {
108 +
  prompt <- prompt %||% paste0("? Your choice [", answers[1], "]: ")
109 +
  while (TRUE) {
110 +
    ans <- readline(prompt)
111 +
    ans <- str_trim(ans)
112 +
    if (ans == "") ans <- answers[1]
113 +
    if (ans %in% answers) return(ans)
114 +
  }
115 +
}

@@ -67,21 +67,22 @@
Loading
67 67
#' `DESCRIPTION`.
68 68
#'
69 69
#' @inheritParams local_install
70 -
#' 
70 +
#'
71 71
#' @family local package trees
72 72
#' @export
73 73
74 74
local_install_dev_deps <- function(root = ".", lib = .libPaths()[1],
75 75
                                   upgrade = FALSE, ask = interactive()) {
76 76
  start <- Sys.time()
77 77
78 -
  any <- remote(
78 +
  status <- remote(
79 79
    function(...) {
80 80
      get("local_install_dev_deps_make_plan", asNamespace("pak"))(...)
81 81
    },
82 -
    list(root = root, lib = lib, upgrade = upgrade, start = start))
82 +
    list(root = root, lib = lib, upgrade = upgrade, start = start,
83 +
         loaded = loaded_packages(lib)))
83 84
84 -
  if (any && ask) get_confirmation("? Do you want to continue (Y/n) ")
85 +
  handle_status(status, lib, ask)
85 86
86 87
  inst <- remote(
87 88
    function(...) {
@@ -96,7 +97,8 @@
Loading
96 97
97 98
## Almost the same as a "regular" install, but need to set dependencies
98 99
99 -
local_install_dev_deps_make_plan <- function(root, lib, upgrade, start) {
100 +
local_install_dev_deps_make_plan <- function(root, lib, upgrade, start,
101 +
                                             loaded) {
100 102
  prop <- pkgdepends::new_pkg_installation_proposal(
101 103
    paste0("deps::", root),
102 104
    config = list(library = lib, dependencies = TRUE)
@@ -107,7 +109,7 @@
Loading
107 109
  prop$stop_for_solution_error()
108 110
  pkg_data$tmp <- list(proposal = prop, start = start)
109 111
  sol <- prop$get_solution()$data
110 -
  print_install_details(sol, lib)
112 +
  print_install_details(sol, lib, loaded)
111 113
}
112 114
113 115
## This is the same as a regular install

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Click to load this diff.
Loading diff...

Learn more Showing 3 files with coverage changes found.

New file R/unload.R
New
Loading file...
New file R/warn-loaded.R
New
Loading file...
New file R/terminate.R
New
Loading file...
Files Coverage
R -6.16% 20.68%
Project Totals (18 files) 20.68%
Loading