Show library path and where each package is loaded from (#20)

* Include library path in package info

* Fix libpath on Windows

* Fix lib path tests on Windows

* Distinguish between loadedpath and (ondisk)path

And warn if the two are not the same.

* Fix windows tests (uh)

* Fix another test case

R/dependent-packages.R

@@ -6,11 +6,15 @@ dependent_packages <- function(pkgs) {
   loaded_pkgs <- pkgs %in% setdiff(loadedNamespaces(), "base")
   loadedversion <- rep(NA_character_, length(pkgs))
   loadedversion[loaded_pkgs] <- vapply(pkgs[loaded_pkgs], getNamespaceVersion, "")
+  loadedpath <- rep(NA_character_, length(pkgs))
+  loadedpath[loaded_pkgs] <-
+    vapply(pkgs[loaded_pkgs], getNamespaceInfo, "", which = "path")
   res <- data.frame(
     package = pkgs,
     ondiskversion = vapply(desc, function(x) x$Version, character(1)),
     loadedversion = loadedversion,
-    path = vapply(desc, pkg_path, character(1)),
+    path = vapply(desc, pkg_path_disk, character(1)),
+    loadedpath = loadedpath,
     attached = paste0("package:", pkgs) %in% search(),
     stringsAsFactors = FALSE,
     row.names = NULL
@@ -22,8 +26,8 @@ dependent_packages <- function(pkgs) {
   res
 }
 
-pkg_path <- function(desc) {
-  system.file(package = desc$Package)
+pkg_path_disk <- function(desc) {
+  system.file(package = desc$Package, lib.loc = .libPaths())
 }
 
 find_deps <- function(pkgs, available = utils::available.packages(),

R/loaded-packages.R

@@ -11,14 +11,19 @@ loaded_packages <- function() {
   packages <- setdiff(loadedNamespaces(), "base")
   loadedversion <- vapply(packages, getNamespaceVersion, "")
   ondiskversion <- vapply(packages, spackageVersion, "")
-  path <- vapply(packages, getNamespaceInfo, "", "path")
+  path <- vapply(
+    packages,
+    function(p) system.file(package = p, lib.loc = .libPaths()),
+    character(1))
+  loadedpath <- vapply(packages, getNamespaceInfo, "", which = "path")
   attached <- paste0("package:", packages) %in% search()
 
   res <- data.frame(
     package = c(packages, "base"),
     ondiskversion = c(ondiskversion, spackageVersion("base")),
     loadedversion = c(loadedversion, getNamespaceVersion("base")),
     path = c(path, system.file()),
+    loadedpath = c(loadedpath, NA_character_),
     attached = c(attached, TRUE),
     stringsAsFactors = FALSE,
     row.names = NULL

R/package-info.R

@@ -8,19 +8,25 @@
 #'   false since base packages should always match the R version.
 #' @return A data frame with columns:
 #'   * `package`: package name.
+#'   * `ondiskversion`: package version (on the disk, which is sometimes
+#'     not the same as the loaded version).
 #'   * `loadedversion`: package version. This is the version of the loaded
 #'     namespace if `pkgs` is `NULL`, and it is the version of the package
 #'     on disk otherwise. The two of them are almost always the same,
 #'     though.
-#'   * `ondiskversion`: package version (on the disk, which is sometimes
-#'     not the same as the loaded version).
 #'   * `path`: path to the package on disk.
+#'   * `loadedpath`: the path the package was originally loaded from.
 #'   * `attached`: logical, whether the package is attached to the search
 #'     path.
 #'   * `is_base`: logical, whether the package is a base package.
 #'   * `date`: the date the package was installed or built.
 #'   * `source`: where the package was installed from. E.g.
 #'     `CRAN`, `GitHub`, `local` (from the local machine), etc.
+#'   * `md5ok`: Whether MD5 hashes for package DLL files match, on Windows.
+#'     `NA` on other platforms.
+#'   * `library`: factor, which package library the package was loaded from.
+#'     For loaded packages, this is (the factor representation of)
+#'     `loadedpath`, for others `path`.
 #'
 #' See [session_info()] for the description of the *printed* columns
 #' by `package_info` (as opposed to the *returned* columns).
@@ -48,12 +54,21 @@ package_info <- function(pkgs = NULL, include_base = FALSE) {
   pkgs$source <- vapply(desc, pkg_source, character(1))
   pkgs$md5ok <- vapply(desc, pkg_md5ok_dlls, logical(1))
 
+  libpath <- pkg_lib_paths()
+  path <- ifelse(is.na(pkgs$loadedpath), pkgs$path, pkgs$loadedpath)
+  pkgs$library <- factor(dirname(path), levels = libpath)
+
   if (!include_base) pkgs <- pkgs[! pkgs$is_base, ]
 
+  rownames(pkgs) <- pkgs$package
   class(pkgs) <- c("packages_info", "data.frame")
   pkgs
 }
 
+pkg_lib_paths <- function() {
+  normalizePath(.libPaths(), winslash = "/")
+}
+
 pkg_date <- function (desc) {
   if (!is.null(desc$`Date/Publication`)) {
     date <- desc$`Date/Publication`
@@ -163,35 +178,49 @@ pkg_md5_disk <- function(pkgdir) {
 print.packages_info <- function(x, ...) {
 
   unloaded <- is.na(x$loadedversion)
-  badloaded <- package_version(x$loadedversion, strict = FALSE) !=
-               package_version(x$ondiskversion)
-  badloaded <- !is.na(badloaded) & badloaded
-
-  badmd5 <- !is.na(x$md5ok) & !x$md5ok
+  flib <- function(x) ifelse(is.na(x), "?", as.integer(x))
 
   px <- data.frame(
     package = x$package,
     "*"     = ifelse(x$attached, "*", ""),
     version = ifelse(unloaded, x$ondiskversion, x$loadedversion),
     date    = x$date,
+    lib     = paste0("[", flib(x$library), "]"),
     source  = x$source,
     stringsAsFactors = FALSE,
     check.names = FALSE
   )
 
-  if (any(badloaded) || any(badmd5)) {
+  badloaded <- package_version(x$loadedversion, strict = FALSE) !=
+               package_version(x$ondiskversion)
+  badloaded <- !is.na(badloaded) & badloaded
+
+  badmd5 <- !is.na(x$md5ok) & !x$md5ok
+
+  badpath <- !is.na(x$loadedpath) & x$loadedpath != x$path
+
+  if (any(badloaded) || any(badmd5) || any(badpath)) {
     prob <- paste0(
       ifelse(badloaded, "V", ""),
+      ifelse(badpath, "P", ""),
       ifelse(badmd5, "D", ""))
     px <- cbind("!" = prob, px)
   }
 
   withr::local_options(list(max.print = 99999))
   pr <- print.data.frame(px, right = FALSE, row.names = FALSE)
 
-  if ("!" %in% names(px)) cat_ln(dash(4))
+  cat("\n")
+  lapply(
+    seq_along(levels(x$library)),
+    function(i) cat_ln(paste0("[", i, "] ", levels(x$library)[i])))
+
+  if ("!" %in% names(px)) cat("\n")
   if (any(badloaded)) {
-    cat_ln(" V ", dash(2), ", Loaded and on-disk version mismatch.")
+    cat_ln(" V ", dash(2), " Loaded and on-disk version mismatch.")
+  }
+  if (any(badpath))  {
+    cat_ln(" P ", dash(2), " Loaded and on-disk path mismatch.")
   }
   if (any(badmd5)) {
     cat_ln(" D ", dash(2), " DLL MD5 mismatch, broken installation.")

tests/testthat/test-dependent-packages.R

@@ -28,15 +28,20 @@ test_that("dependent_packages", {
     'search',
     function() paste0("package:", dep$package[dep$attached])
   )
+  mockery::stub(
+    dependent_packages,
+    'getNamespaceInfo',
+    function(x, ...) alldsc[[x]]$Version
+  )
 
-  exp <- dep[, setdiff(colnames(dep), "path")]
+  exp <- dep[, setdiff(colnames(dep), c("path", "loadedpath"))]
   tec <- dependent_packages("devtools")
-  tec <- tec[, setdiff(colnames(tec), "path")]
+  tec <- tec[, setdiff(colnames(tec), c("path", "loadedpath"))]
   expect_equal(exp, tec)
 })
 
-test_that("pkg_path", {
-  p1 <- pkg_path(utils::packageDescription("stats"))
+test_that("pkg_path_disk", {
+  p1 <- pkg_path_disk(utils::packageDescription("stats"))
   expect_equal(
     read.dcf(file.path(p1, "DESCRIPTION"))[, "Package"],
     c(Package = "stats")

tests/testthat/test-package-info.R

@@ -5,35 +5,35 @@ test_that("package_info, loaded", {
 
   descs <- readRDS("fixtures/devtools-deps.rda")
   alldsc <- readRDS("fixtures/descs.rda")
+  exp <- readRDS(paste0("fixtures/devtools-info-", .Platform$OS.type, ".rda"))
 
   mockery::stub(package_info, "loaded_packages", descs)
   mockery::stub(
     package_info,
     'utils::packageDescription',
     function(x) alldsc[[x]]
-  )
+    )
+  mockery::stub(package_info, "pkg_lib_paths", levels(exp$library))
 
   pi <- package_info()
-  exp <- readRDS("fixtures/devtools-info.rda")
-  if (.Platform$OS.type != "windows") pi$md5ok[] <- TRUE
   expect_identical(pi, exp)
 })
 
 test_that("package_info, dependent", {
 
   descs <- readRDS("fixtures/devtools-deps.rda")
   alldsc <- readRDS("fixtures/descs.rda")
+  exp <- readRDS(paste0("fixtures/devtools-info-", .Platform$OS.type, ".rda"))
 
   mockery::stub(package_info, "dependent_packages", descs)
   mockery::stub(
     package_info,
     'utils::packageDescription',
     function(x) alldsc[[x]]
   )
+  mockery::stub(package_info, "pkg_lib_paths", levels(exp$library))
 
   pi <- package_info("devtools")
-  exp <- readRDS("fixtures/devtools-info.rda")
-  if (.Platform$OS.type != "windows") pi$md5ok[] <- TRUE
   expect_identical(pi, exp)
 })
 
@@ -98,17 +98,17 @@ test_that("pkg_md5_disk", {
 })
 
 test_that("print.packages_info", {
-  info <- readRDS("fixtures/devtools-info.rda")
+  info <- readRDS(paste0("fixtures/devtools-info-", .Platform$OS.type, ".rda"))
   expect_output(
-    print(info), "package    * version     date       source",
+    print(info), "package    * version     date       lib source",
     fixed = TRUE
   )
 })
 
 test_that("print.packages_info ignores max.print", {
-  info <- readRDS("fixtures/devtools-info.rda")
+  info <- readRDS(paste0("fixtures/devtools-info-", .Platform$OS.type, ".rda"))
   withr::local_options(list(max.print = 1))
   out <- capture_output(print(info))
   out <- tail(strsplit(out, split = "\r?\n")[[1]], -1)
-  expect_length(out, nrow(info))
+  expect_length(out, nrow(info) + 3)
 })

tests/testthat/test-session-info.R

@@ -2,7 +2,7 @@
 context("session_info")
 
 test_that("session_info", {
-  pi <- readRDS("fixtures/devtools-info.rda")
+  info <- readRDS(paste0("fixtures/devtools-info-", .Platform$OS.type, ".rda"))
   mockery::stub(session_info, "package_info", pi)
 
   si <- session_info()
@@ -13,5 +13,5 @@ test_that("session_info", {
 test_that("print.session_info", {
   si <- session_info()
   expect_output(print(si), "setting  value", fixed = TRUE)
-  expect_output(print(si), "package[ ]+\\* version[ ]+date[ ]+source")
+  expect_output(print(si), "package[ ]+\\* version[ ]+date[ ]+lib[ ]+source")
 })