From b5f9c81a26e702638dff977bc221c11a23597670 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Mon, 12 Apr 2021 10:24:48 +0200 Subject: [PATCH 1/4] Fix argument check typo --- R/package.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/package.R b/R/package.R index ef5e0ba08..b213c2ad2 100644 --- a/R/package.R +++ b/R/package.R @@ -280,7 +280,7 @@ pkg_install_do_plan <- function(proposal, lib) { #' } pkg_status <- function(pkg, lib = .libPaths()) { - stopifnot(length(pkg == 1) && is.character(pkg)) + stopifnot(length(pkg) == 1 && is.character(pkg)) load_extra("tibble") remote( @@ -332,7 +332,7 @@ pkg_remove_internal <- function(pkg, lib) { #' pkg_deps("r-lib/fs") pkg_deps <- function(pkg, upgrade = TRUE, dependencies = NA) { - stopifnot(length(pkg == 1) && is.character(pkg)) + stopifnot(length(pkg) == 1 && is.character(pkg)) load_extra("tibble") remote( function(...) { @@ -378,7 +378,7 @@ pkg_deps_internal2 <- function(pkg, upgrade, dependencies) { #' pkg_deps_tree("r-lib/usethis") pkg_deps_tree <- function(pkg, upgrade = TRUE, dependencies = NA) { - stopifnot(length(pkg == 1) && is.character(pkg)) + stopifnot(length(pkg) == 1 && is.character(pkg)) ret <- remote( function(...) { get("pkg_deps_tree_internal", asNamespace("pak"))(...) From 9cf09dde3f9767a5ba1544a385f44846aa9ddf4c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Mon, 12 Apr 2021 11:08:47 +0200 Subject: [PATCH 2/4] Qualify a utils::head call --- R/dev-mode.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/dev-mode.R b/R/dev-mode.R index fa6cc3933..f1b65b8bf 100644 --- a/R/dev-mode.R +++ b/R/dev-mode.R @@ -39,7 +39,7 @@ lookup_deps <- function(pkg, lib_path = .libPaths()) { ## TODO: check for version requirements find_lib <- function(pkg) { - w <- head(which(vlapply(lib_pkgs, `%in%`, x = pkg)), 1) + w <- utils::head(which(vlapply(lib_pkgs, `%in%`, x = pkg)), 1) if (!length(w)) { stop("Required package `", pkg, "` is not available") } From f8184a15d1b63d71855995ef6b840facb21adbce Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Mon, 12 Apr 2021 11:09:43 +0200 Subject: [PATCH 3/4] Add pkg_upgrade() --- DESCRIPTION | 2 + NAMESPACE | 1 + R/package.R | 83 +++++++++++++ man/lib_status.Rd | 3 +- man/pak.Rd | 3 +- man/pak_package_sources.Rd | 3 +- man/pkg_deps.Rd | 3 +- man/pkg_deps_tree.Rd | 3 +- man/pkg_download.Rd | 3 +- man/pkg_install.Rd | 3 +- man/pkg_remove.Rd | 3 +- man/pkg_status.Rd | 3 +- man/pkg_upgrade.Rd | 38 ++++++ tests/testthat/_snaps/pkg-upgrade.md | 116 ++++++++++++++++++ .../fixtures/get-ref-internal/1/DESCRIPTION | 14 +++ .../fixtures/get-ref-internal/2/DESCRIPTION | 14 +++ .../fixtures/get-ref-internal/3/DESCRIPTION | 15 +++ .../fixtures/get-ref-internal/4/DESCRIPTION | 13 ++ tests/testthat/test-pkg-upgrade.R | 67 ++++++++++ 19 files changed, 381 insertions(+), 9 deletions(-) create mode 100644 man/pkg_upgrade.Rd create mode 100644 tests/testthat/_snaps/pkg-upgrade.md create mode 100644 tests/testthat/fixtures/get-ref-internal/1/DESCRIPTION create mode 100644 tests/testthat/fixtures/get-ref-internal/2/DESCRIPTION create mode 100644 tests/testthat/fixtures/get-ref-internal/3/DESCRIPTION create mode 100644 tests/testthat/fixtures/get-ref-internal/4/DESCRIPTION create mode 100644 tests/testthat/test-pkg-upgrade.R diff --git a/DESCRIPTION b/DESCRIPTION index 207142c7e..c2fd06c7c 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -27,6 +27,7 @@ Suggests: cli (>= 2.3.1), covr, curl, + desc, distro, filelock (>= 1.0.2), glue (>= 1.3.0), @@ -48,6 +49,7 @@ Config/needs/dependencies: callr, cli, curl, + desc, distro, filelock, glue, diff --git a/NAMESPACE b/NAMESPACE index d2903fd22..8e990ac7c 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -48,6 +48,7 @@ export(pkg_remove) export(pkg_search) export(pkg_status) export(pkg_system_requirements) +export(pkg_upgrade) export(repo_add) export(repo_get) export(repo_ping) diff --git a/R/package.R b/R/package.R index b213c2ad2..b92e105b7 100644 --- a/R/package.R +++ b/R/package.R @@ -461,3 +461,86 @@ pkg_download_internal <- function(pkg, dest_dir = ".", dependencies = FALSE, dl$stop_for_download_error() dl$get_downloads() } + +#' Upgrade an installed package, and its dependencies +#' +#' pak will try to upgrade the package from the same source as the +#' one used for the original installation E.g. if you installed the package +#' from a branch of a GitHub repository, then it will try to upgrade from +#' the same branch. +#' +#' @param pkg Package name to upgrade. Must be a package name, general +#' remote specifications are not allowed here. +#' @param lib Library to find the installed package in. The new version +#' of the package(s) will be installed into the same library. +#' @param upgrade Whether to upgrade the dependencies of `pkg` as well. +#' @param ... Additional arguments are passed to [pkg_install()]. +#' +#' @family package functions +#' @export + +pkg_upgrade <- function(pkg, lib = .libPaths()[[1L]], upgrade = TRUE, ...) { + stopifnot(length(pkg) == 1, is.character(pkg), !is.na(pkg)) + ref <- get_installed_ref(pkg, lib) + + if (is.null(ref)) { + stop("'", pkg, "' is not currently installed, cannot upgrade it.") + + } else if (identical(ref, NA_character_)) { + cli <- load_private_cli() + cli$cli_alert_warning( + c("Cannot find source of {.pkg {pkg}}, trying to upgrade it from ", + "the configured repositories."), + wrap = TRUE + ) + ref <- pkg + } else if (!is.null(names(ref))) { + cli <- load_private_cli() + cli$cli_alert_info( + "Updating {.emph {names(ref)}} package {.pkg {ref}}.", + wrap = TRUE + ) + } else if (pkg != ref){ + cli <- load_private_cli() + cli$cli_alert_info( + "Updating package {.pkg {pkg}} from {.pkg {ref}}.", + wrap = TRUE + ) + } + + pkg_install(ref, lib = lib, upgrade = upgrade, ...) +} + +get_installed_ref <- function(pkg, lib) { + remote( + function(...) get("get_installed_ref_internal", asNamespace("pak"))(...), + list(pkg = pkg, lib = lib) + ) +} + +get_installed_ref_internal <- function(pkg, lib) { + name <- paste0("^", pkgdepends::pkg_rx()$pkg_name, "$") + if (!grepl(name, pkg)) stop("'", pkg, "' is not a valid package name") + + pkg_dir <- tryCatch( + find.package(pkg, lib.loc = lib), + error = function(err) NULL + ) + + if (is.null(pkg_dir)) return(NULL) + + dsc <- desc::desc(pkg_dir) + ref <- dsc$get("RemotePkgRef")[[1]] + repo <- dsc$get("Repository")[[1]] + bioc <- dsc$get("biocViews")[[1]] + + if (!is.na(ref)) { + ref + } else if (!is.na(repo) && repo == "CRAN") { + c(CRAN = pkg) + } else if (!is.na(bioc)) { + c(Bioconductor = pkg) + } else { + NA_character_ + } +} diff --git a/man/lib_status.Rd b/man/lib_status.Rd index 7c5635039..b81c209db 100644 --- a/man/lib_status.Rd +++ b/man/lib_status.Rd @@ -28,7 +28,8 @@ Other package functions: \code{\link{pkg_download}()}, \code{\link{pkg_install}()}, \code{\link{pkg_remove}()}, -\code{\link{pkg_status}()} +\code{\link{pkg_status}()}, +\code{\link{pkg_upgrade}()} } \concept{library functions} \concept{package functions} diff --git a/man/pak.Rd b/man/pak.Rd index 86fdb6889..0a71b237a 100644 --- a/man/pak.Rd +++ b/man/pak.Rd @@ -39,7 +39,8 @@ Other package functions: \code{\link{pkg_download}()}, \code{\link{pkg_install}()}, \code{\link{pkg_remove}()}, -\code{\link{pkg_status}()} +\code{\link{pkg_status}()}, +\code{\link{pkg_upgrade}()} Other local package trees: \code{\link{local_deps_explain}()}, diff --git a/man/pak_package_sources.Rd b/man/pak_package_sources.Rd index cc659d936..1c0c8dcc1 100644 --- a/man/pak_package_sources.Rd +++ b/man/pak_package_sources.Rd @@ -153,6 +153,7 @@ Other package functions: \code{\link{pkg_download}()}, \code{\link{pkg_install}()}, \code{\link{pkg_remove}()}, -\code{\link{pkg_status}()} +\code{\link{pkg_status}()}, +\code{\link{pkg_upgrade}()} } \concept{package functions} diff --git a/man/pkg_deps.Rd b/man/pkg_deps.Rd index 9be9a7fd7..4cb07f988 100644 --- a/man/pkg_deps.Rd +++ b/man/pkg_deps.Rd @@ -36,6 +36,7 @@ Other package functions: \code{\link{pkg_download}()}, \code{\link{pkg_install}()}, \code{\link{pkg_remove}()}, -\code{\link{pkg_status}()} +\code{\link{pkg_status}()}, +\code{\link{pkg_upgrade}()} } \concept{package functions} diff --git a/man/pkg_deps_tree.Rd b/man/pkg_deps_tree.Rd index c1c00c524..125fdb460 100644 --- a/man/pkg_deps_tree.Rd +++ b/man/pkg_deps_tree.Rd @@ -36,6 +36,7 @@ Other package functions: \code{\link{pkg_download}()}, \code{\link{pkg_install}()}, \code{\link{pkg_remove}()}, -\code{\link{pkg_status}()} +\code{\link{pkg_status}()}, +\code{\link{pkg_upgrade}()} } \concept{package functions} diff --git a/man/pkg_download.Rd b/man/pkg_download.Rd index ae4f4bfdb..9706193b3 100644 --- a/man/pkg_download.Rd +++ b/man/pkg_download.Rd @@ -51,6 +51,7 @@ Other package functions: \code{\link{pkg_deps}()}, \code{\link{pkg_install}()}, \code{\link{pkg_remove}()}, -\code{\link{pkg_status}()} +\code{\link{pkg_status}()}, +\code{\link{pkg_upgrade}()} } \concept{package functions} diff --git a/man/pkg_install.Rd b/man/pkg_install.Rd index 36d6c6439..e75bb2b11 100644 --- a/man/pkg_install.Rd +++ b/man/pkg_install.Rd @@ -69,6 +69,7 @@ Other package functions: \code{\link{pkg_deps}()}, \code{\link{pkg_download}()}, \code{\link{pkg_remove}()}, -\code{\link{pkg_status}()} +\code{\link{pkg_status}()}, +\code{\link{pkg_upgrade}()} } \concept{package functions} diff --git a/man/pkg_remove.Rd b/man/pkg_remove.Rd index 8680e95f4..8e3f196aa 100644 --- a/man/pkg_remove.Rd +++ b/man/pkg_remove.Rd @@ -23,6 +23,7 @@ Other package functions: \code{\link{pkg_deps}()}, \code{\link{pkg_download}()}, \code{\link{pkg_install}()}, -\code{\link{pkg_status}()} +\code{\link{pkg_status}()}, +\code{\link{pkg_upgrade}()} } \concept{package functions} diff --git a/man/pkg_status.Rd b/man/pkg_status.Rd index 0d0ea941f..94d290a33 100644 --- a/man/pkg_status.Rd +++ b/man/pkg_status.Rd @@ -32,6 +32,7 @@ Other package functions: \code{\link{pkg_deps}()}, \code{\link{pkg_download}()}, \code{\link{pkg_install}()}, -\code{\link{pkg_remove}()} +\code{\link{pkg_remove}()}, +\code{\link{pkg_upgrade}()} } \concept{package functions} diff --git a/man/pkg_upgrade.Rd b/man/pkg_upgrade.Rd new file mode 100644 index 000000000..a19e2cddd --- /dev/null +++ b/man/pkg_upgrade.Rd @@ -0,0 +1,38 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/package.R +\name{pkg_upgrade} +\alias{pkg_upgrade} +\title{Upgrade an installed package, and its dependencies} +\usage{ +pkg_upgrade(pkg, lib = .libPaths()[[1L]], upgrade = TRUE, ...) +} +\arguments{ +\item{pkg}{Package name to upgrade. Must be a package name, general +remote specifications are not allowed here.} + +\item{lib}{Library to find the installed package in. The new version +of the package(s) will be installed into the same library.} + +\item{upgrade}{Whether to upgrade the dependencies of \code{pkg} as well.} + +\item{...}{Additional arguments are passed to \code{\link[=pkg_install]{pkg_install()}}.} +} +\description{ +pak will try to upgrade the package from the same source as the +one used for the original installation E.g. if you installed the package +from a branch of a GitHub repository, then it will try to upgrade from +the same branch. +} +\seealso{ +Other package functions: +\code{\link{lib_status}()}, +\code{\link{pak_package_sources}}, +\code{\link{pak}()}, +\code{\link{pkg_deps_tree}()}, +\code{\link{pkg_deps}()}, +\code{\link{pkg_download}()}, +\code{\link{pkg_install}()}, +\code{\link{pkg_remove}()}, +\code{\link{pkg_status}()} +} +\concept{package functions} diff --git a/tests/testthat/_snaps/pkg-upgrade.md b/tests/testthat/_snaps/pkg-upgrade.md new file mode 100644 index 000000000..dd645440f --- /dev/null +++ b/tests/testthat/_snaps/pkg-upgrade.md @@ -0,0 +1,116 @@ +# pkg_upgrade [plain] + + Code + pkg_upgrade("foo") + Message + ! Cannot find source of foo, trying to upgrade it from the configured + repositories. + +--- + + Code + pkg_upgrade("foo") + Message + i Updating CRAN package foo. + +--- + + Code + pkg_upgrade("foo") + Message + i Updating Bioconductor package foo. + +--- + + Code + pkg_upgrade("foo") + Message + i Updating package foo from repo/foo@master. + +# pkg_upgrade [ansi] + + Code + pkg_upgrade("foo") + Message + ! Cannot find source of foo, trying to upgrade it from the configured + repositories. + +--- + + Code + pkg_upgrade("foo") + Message + i Updating CRAN package foo. + +--- + + Code + pkg_upgrade("foo") + Message + i Updating Bioconductor package foo. + +--- + + Code + pkg_upgrade("foo") + Message + i Updating package foo from repo/foo@master. + +# pkg_upgrade [unicode] + + Code + pkg_upgrade("foo") + Message + ! Cannot find source of foo, trying to upgrade it from the configured + repositories. + +--- + + Code + pkg_upgrade("foo") + Message + ℹ Updating CRAN package foo. + +--- + + Code + pkg_upgrade("foo") + Message + ℹ Updating Bioconductor package foo. + +--- + + Code + pkg_upgrade("foo") + Message + ℹ Updating package foo from repo/foo@master. + +# pkg_upgrade [fancy] + + Code + pkg_upgrade("foo") + Message + ! Cannot find source of foo, trying to upgrade it from the configured + repositories. + +--- + + Code + pkg_upgrade("foo") + Message + ℹ Updating CRAN package foo. + +--- + + Code + pkg_upgrade("foo") + Message + ℹ Updating Bioconductor package foo. + +--- + + Code + pkg_upgrade("foo") + Message + ℹ Updating package foo from repo/foo@master. + diff --git a/tests/testthat/fixtures/get-ref-internal/1/DESCRIPTION b/tests/testthat/fixtures/get-ref-internal/1/DESCRIPTION new file mode 100644 index 000000000..446c8148a --- /dev/null +++ b/tests/testthat/fixtures/get-ref-internal/1/DESCRIPTION @@ -0,0 +1,14 @@ +Package: {{ Package }} +Title: {{ Title }} +Version: 1.0.0 +Authors@R: + c(person(given = "Jo", family = "Doe", email = "jodoe@dom.ain", + role = c("aut", "cre"))) +Maintainer: {{ Maintainer }} +Description: {{ Description }} +License: {{ License }} +LazyData: true +URL: {{ URL }} +BugReports: {{ BugReports }} +Encoding: UTF-8 +RemotePkgRef: user/repo@branch diff --git a/tests/testthat/fixtures/get-ref-internal/2/DESCRIPTION b/tests/testthat/fixtures/get-ref-internal/2/DESCRIPTION new file mode 100644 index 000000000..2ae2c4ecd --- /dev/null +++ b/tests/testthat/fixtures/get-ref-internal/2/DESCRIPTION @@ -0,0 +1,14 @@ +Package: {{ Package }} +Title: {{ Title }} +Version: 1.0.0 +Authors@R: + c(person(given = "Jo", family = "Doe", email = "jodoe@dom.ain", + role = c("aut", "cre"))) +Maintainer: {{ Maintainer }} +Description: {{ Description }} +License: {{ License }} +LazyData: true +URL: {{ URL }} +BugReports: {{ BugReports }} +Encoding: UTF-8 +Repository: CRAN diff --git a/tests/testthat/fixtures/get-ref-internal/3/DESCRIPTION b/tests/testthat/fixtures/get-ref-internal/3/DESCRIPTION new file mode 100644 index 000000000..0b63726a0 --- /dev/null +++ b/tests/testthat/fixtures/get-ref-internal/3/DESCRIPTION @@ -0,0 +1,15 @@ +Package: {{ Package }} +Title: {{ Title }} +Version: 1.0.0 +Authors@R: + c(person(given = "Jo", family = "Doe", email = "jodoe@dom.ain", + role = c("aut", "cre"))) +Maintainer: {{ Maintainer }} +Description: {{ Description }} +License: {{ License }} +LazyData: true +URL: {{ URL }} +BugReports: {{ BugReports }} +Encoding: UTF-8 +Reposiry: foo +biocViews: annotation diff --git a/tests/testthat/fixtures/get-ref-internal/4/DESCRIPTION b/tests/testthat/fixtures/get-ref-internal/4/DESCRIPTION new file mode 100644 index 000000000..dd7794d36 --- /dev/null +++ b/tests/testthat/fixtures/get-ref-internal/4/DESCRIPTION @@ -0,0 +1,13 @@ +Package: {{ Package }} +Title: {{ Title }} +Version: 1.0.0 +Authors@R: + c(person(given = "Jo", family = "Doe", email = "jodoe@dom.ain", + role = c("aut", "cre"))) +Maintainer: {{ Maintainer }} +Description: {{ Description }} +License: {{ License }} +LazyData: true +URL: {{ URL }} +BugReports: {{ BugReports }} +Encoding: UTF-8 diff --git a/tests/testthat/test-pkg-upgrade.R b/tests/testthat/test-pkg-upgrade.R new file mode 100644 index 000000000..345430dc3 --- /dev/null +++ b/tests/testthat/test-pkg-upgrade.R @@ -0,0 +1,67 @@ + +test_that("pkg_upgrade errors", { + # Only for one package for now + expect_error(pkg_upgrade(c("f", "b")), "length(pkg) == 1", fixed = TRUE) + + # Only package names + expect_error(pkg_upgrade("foo/bar"), "not a valid package name") + + # Not installed, cannot upgrade + expect_error(pkg_upgrade(basename(tempfile())), "not currently installed") +}) + +cli::test_that_cli("pkg_upgrade", { + mockery::stub(pkg_upgrade, "pkg_install", function(...) invisible(NULL)) + + mockery::stub(pkg_upgrade, "get_installed_ref", NA_character_) + expect_snapshot( + pkg_upgrade("foo") + ) + + mockery::stub(pkg_upgrade, "get_installed_ref", c(CRAN = "foo")) + expect_snapshot( + pkg_upgrade("foo") + ) + + mockery::stub(pkg_upgrade, "get_installed_ref", c(Bioconductor = "foo")) + expect_snapshot( + pkg_upgrade("foo") + ) + + mockery::stub(pkg_upgrade, "get_installed_ref", "repo/foo@master") + expect_snapshot( + pkg_upgrade("foo") + ) +}) + +test_that("get_installed_ref_internal", { + expect_error( + get_installed_ref_internal("foo/bar"), + "not a valid package name" + ) + + mockery::stub(get_installed_ref_internal, "find.package", function(...) { + stop("not here") + }) + expect_null(get_installed_ref_internal("repo")) + + mockery::stub(get_installed_ref_internal, "find.package", function(...) { + test_path("fixtures", "get-ref-internal", "1") + }) + expect_equal(get_installed_ref_internal("repo"), "user/repo@branch") + + mockery::stub(get_installed_ref_internal, "find.package", function(...) { + test_path("fixtures", "get-ref-internal", "2") + }) + expect_equal(get_installed_ref_internal("repo"), c(CRAN = "repo")) + + mockery::stub(get_installed_ref_internal, "find.package", function(...) { + test_path("fixtures", "get-ref-internal", "3") + }) + expect_equal(get_installed_ref_internal("repo"), c(Bioconductor = "repo")) + + mockery::stub(get_installed_ref_internal, "find.package", function(...) { + test_path("fixtures", "get-ref-internal", "4") + }) + expect_equal(get_installed_ref_internal("repo"), NA_character_) +}) From e436167d9a41bed5ddcd8a5fe7b93b6ce8b615ea Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Wed, 14 Apr 2021 16:19:15 +0200 Subject: [PATCH 4/4] Run private lib tests in a subprocess --- tests/testthat/test-pkg-upgrade.R | 6 +-- tests/testthat/test-private-lib.R | 64 +++++++++++++++++++------------ tests/testthat/test-subprocess.R | 8 ++-- 3 files changed, 44 insertions(+), 34 deletions(-) diff --git a/tests/testthat/test-pkg-upgrade.R b/tests/testthat/test-pkg-upgrade.R index 345430dc3..3c590d175 100644 --- a/tests/testthat/test-pkg-upgrade.R +++ b/tests/testthat/test-pkg-upgrade.R @@ -3,11 +3,7 @@ test_that("pkg_upgrade errors", { # Only for one package for now expect_error(pkg_upgrade(c("f", "b")), "length(pkg) == 1", fixed = TRUE) - # Only package names - expect_error(pkg_upgrade("foo/bar"), "not a valid package name") - - # Not installed, cannot upgrade - expect_error(pkg_upgrade(basename(tempfile())), "not currently installed") + # The rest is tested in get_installed_ref_internal }) cli::test_that_cli("pkg_upgrade", { diff --git a/tests/testthat/test-private-lib.R b/tests/testthat/test-private-lib.R index ab41d001d..780acf86d 100644 --- a/tests/testthat/test-private-lib.R +++ b/tests/testthat/test-private-lib.R @@ -1,19 +1,25 @@ test_that("loading package from private lib", { skip_on_cran() - on.exit(pkg_data$ns <- list(), add = TRUE) - pkg_data$ns$processx <- NULL - gc() - ## Load - load_private_package("processx", "c_") - pkgdir <- normalizePath(pkg_data$ns$processx[["__pkg-dir__"]]) + do <- function() { + pak <- asNamespace("pak") + pak$load_private_package("processx", "c_") + pkgdir <- normalizePath(pak$pkg_data$ns$processx[["__pkg-dir__"]]) + paths <- normalizePath(sapply(.dynLibs(), "[[", "path")) + list( + pkgdir = file.exists(pkgdir), + isfun = is.function(pak$pkg_data$ns$processx$run), + dyn = any(grepl(basename(pkgdir), paths, fixed = TRUE)), + dd = pkgdir, + pp = paths + ) + } - ## Check if loaded - expect_true(is.function(pkg_data$ns$processx$run)) - expect_true(file.exists(pkgdir)) - paths <- normalizePath(sapply(.dynLibs(), "[[", "path")) - expect_true(any(grepl(pkgdir, paths, fixed = TRUE))) + ret <- callr::r(do, env = c(callr::rcmd_safe_env(), R_ENABLE_JIT = "0")) + expect_true(ret$pkgdir) + expect_true(ret$isfun) + expect_true(ret$dyn) }) test_that("cleanup of temp files", { @@ -44,21 +50,31 @@ test_that("cleanup of temp files", { test_that("no interference", { skip_on_cran() - on.exit(pkg_data$ns <- list(), add = TRUE) - pkg_data$ns$processx <- NULL - gc() - asNamespace("ps") - expect_true("ps" %in% loadedNamespaces()) - expect_true("ps" %in% sapply(.dynLibs(), "[[", "name")) + do <- function() { + pak <- asNamespace("pak") + asNamespace("ps") + p1 <- "ps" %in% loadedNamespaces() + p2 <- "ps" %in% sapply(.dynLibs(), "[[", "name") - load_private_package("ps") - expect_true(is.function(pkg_data$ns$ps$ps)) - expect_true(is.function(asNamespace("ps")$ps)) + pak$load_private_package("ps") + p3 <- is.function(pak$pkg_data$ns$ps$ps) + p4 <- is.function(asNamespace("ps")$ps) - pkg_data$ns$ps <- NULL - gc(); gc() + ns <- pak$pkg_data$ns + ns$ps <- NULL + gc(); gc() + + p5 <- "ps" %in% loadedNamespaces() + p6 <- "ps" %in% sapply(.dynLibs(), "[[", "name") + list(p1, p2, p3, p4, p5, p6) + } - expect_true("ps" %in% loadedNamespaces()) - expect_true("ps" %in% sapply(.dynLibs(), "[[", "name")) + ret <- callr::r(do, env = c(callr::rcmd_safe_env(), R_ENABLE_JIT = "0")) + expect_true(ret[[1]]) + expect_true(ret[[2]]) + expect_true(ret[[3]]) + expect_true(ret[[4]]) + expect_true(ret[[5]]) + expect_true(ret[[6]]) }) diff --git a/tests/testthat/test-subprocess.R b/tests/testthat/test-subprocess.R index 63c494c86..446163eea 100644 --- a/tests/testthat/test-subprocess.R +++ b/tests/testthat/test-subprocess.R @@ -9,11 +9,9 @@ test_that("no dependencies are loaded with pak", { new_pkgs <- callr::r( function() { - withr::with_options(list(pkg.subprocess = FALSE), { - orig <- loadedNamespaces() - library(pak) - new <- loadedNamespaces() - }) + orig <- loadedNamespaces() + library(pak) + new <- loadedNamespaces() setdiff(new, orig) }, timeout = 5