From 4f55c5abfb1b2e067a5b6a0aa44f7a4bdce38bc8 Mon Sep 17 00:00:00 2001 From: Jonathan Yoder Date: Fri, 13 Mar 2026 12:38:03 -0400 Subject: [PATCH 1/2] Add two-tier cache read fallback for group cache isolation When R_PACKRAT_GLOBAL_CACHE_DIR is set, packrat reads from the primary (group) cache first, then falls back to the global cache. Writes always go to the primary cache. This avoids re-downloading public packages that are already cached globally when using group-based cache partitioning. Co-Authored-By: Claude Opus 4.6 --- R/paths.R | 14 + R/restore-routines.R | 81 ++++ R/restore.R | 11 + tests/testthat/test-global-cache.R | 592 +++++++++++++++++++++++++++++ 4 files changed, 698 insertions(+) create mode 100644 tests/testthat/test-global-cache.R diff --git a/R/paths.R b/R/paths.R index ffead2a1..5b5ba98f 100644 --- a/R/paths.R +++ b/R/paths.R @@ -289,6 +289,20 @@ cacheLibDir <- function(...) { file.path(appDataDir(), packratCacheVersion(), "library", ...) } +globalAppDataDir <- function() { + globalCacheDir <- Sys.getenv("R_PACKRAT_GLOBAL_CACHE_DIR", unset = "") + if (!nzchar(globalCacheDir)) return(NULL) + rVersion <- R.Version() + rVersionString <- paste(rVersion$major, rVersion$minor, sep = ".") + file.path(globalCacheDir, rVersionString) +} + +globalCacheLibDir <- function(...) { + globalDir <- globalAppDataDir() + if (is.null(globalDir)) return(NULL) + file.path(globalDir, "v2", "library", ...) +} + untrustedCacheLibDir <- function(...) { file.path(appDataDir(), packratCacheVersion(), "library-client", ...) } diff --git a/R/restore-routines.R b/R/restore-routines.R index 30c63043..1c9ab275 100644 --- a/R/restore-routines.R +++ b/R/restore-routines.R @@ -113,6 +113,87 @@ restoreWithCopyFromCache <- function(project, pkgRecord, cacheCopyStatus) { return(FALSE) } +restoreWithCopyFromGlobalCache <- function(project, pkgRecord, cacheCopyStatus) { + # Only applies when a global cache fallback is configured + globalSource <- globalCacheLibDir(pkgRecord$name, pkgRecord$hash, pkgRecord$name) + if (is.null(globalSource)) { + return(FALSE) + } + + # don't copy from cache if disabled for this project + if (!isUsingCache(project)) { + return(FALSE) + } + + # don't try to use cache if we don't have a hash + if (!length(pkgRecord$hash)) { + return(FALSE) + } + + # don't try to cache uncacheable packages (ie, packages that + # need to be reinstalled each time for whatever reason) + if (!isCacheable(pkgRecord$name)) { + return(FALSE) + } + + # ensure that the global cache package path exists + if (!file_test("-d", globalSource)) { + return(FALSE) + } + + # sanity check for cache corruption -- we've seen some cases where + # a cache entry exists, but it's just an empty folder + if (isCorruptPackageCacheEntry(globalSource)) { + return(FALSE) + } + + # attempt to form a symlink to the packrat library + # (remove stale file if one exists) + lib <- libDir(project) + target <- file.path(lib, pkgRecord$name) + + # if we already have a directory at the target location, back it up + # and attempt to restore it if something goes wrong and we fail to + # copy from the global cache + if (file.exists(target)) { + temp <- tempfile(tmpdir = lib) + file.rename(target, temp) + on.exit( + { + if (file.exists(target)) { + unlink(temp, recursive = !is.symlink(temp)) + } else { + file.rename(temp, target) + } + }, + add = TRUE + ) + } + + # attempt the symlink + suppressWarnings(symlink(globalSource, target)) + success <- file.exists(target) + if (success) { + cacheCopyStatus$type <- "symlinked global cache" + return(TRUE) + } + + # symlinking failed; attempt a copy from the global cache to the target directory + success <- all(dir_copy( + globalCacheLibDir(pkgRecord$name, pkgRecord$hash), + file.path(libDir(project), pkgRecord$name) + )) + + if (success) { + cacheCopyStatus$type <- "copied global cache" + return(TRUE) + } + + # failed to copy or symlink from global cache; report warning and return false + warning("failed to symlink or copy package '", pkgRecord$name, "' from global cache") + return(FALSE) +} + restoreWithCopyFromUntrustedCache <- function( project, pkgRecord, diff --git a/R/restore.R b/R/restore.R index 6cd85d22..88bb7d2a 100644 --- a/R/restore.R +++ b/R/restore.R @@ -614,6 +614,17 @@ installPkg <- function(pkgRecord, project, repos, lib = libDir(project)) { return(cacheCopyStatus$type) } + # Try restoring the package from the global cache fallback + # (when using group cache isolation via R_PACKRAT_GLOBAL_CACHE_DIR). + copiedFromGlobalCache <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) + if (copiedFromGlobalCache) { + return(cacheCopyStatus$type) + } + # Try restoring the package from the 'unsafe' cache, if applicable. copiedFromUntrustedCache <- restoreWithCopyFromUntrustedCache( project, diff --git a/tests/testthat/test-global-cache.R b/tests/testthat/test-global-cache.R new file mode 100644 index 00000000..1ea7b4e7 --- /dev/null +++ b/tests/testthat/test-global-cache.R @@ -0,0 +1,592 @@ +# Tests for two-tier cache read fallback: +# 1. paths.R: globalAppDataDir() and globalCacheLibDir() +# 2. restore-routines.R: restoreWithCopyFromGlobalCache() +# 3. restore.R: installPkg() wiring (fallback ordering) + +# --------------------------------------------------------------------------- +# helpers +# --------------------------------------------------------------------------- + +# Create a minimal fake "installed package" directory with a DESCRIPTION file. +make_fake_cached_pkg <- function(base_dir, pkg_name, hash) { + pkg_path <- file.path(base_dir, pkg_name, hash, pkg_name) + dir.create(pkg_path, recursive = TRUE) + writeLines( + c( + paste0("Package: ", pkg_name), + "Version: 1.0.0", + "Title: Fake" + ), + file.path(pkg_path, "DESCRIPTION") + ) + pkg_path +} + +# Build a pkgRecord list (mimics the structure used by packrat internals). +make_pkg_record <- function(name = "mypkg", hash = "abc123", version = "1.0.0", + source = "CRAN") { + list(name = name, hash = hash, version = version, source = source) +} + +# --------------------------------------------------------------------------- +# globalAppDataDir() +# --------------------------------------------------------------------------- + +test_that("globalAppDataDir returns NULL when env var is unset", { + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = NA), { + expect_null(globalAppDataDir()) + }) +}) + +test_that("globalAppDataDir returns NULL when env var is empty string", { + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = ""), { + expect_null(globalAppDataDir()) + }) +}) + +test_that("globalAppDataDir returns correct path when env var is set", { + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = "/tmp/my-global-cache"), { + result <- globalAppDataDir() + rv <- R.Version() + expected_version <- paste(rv$major, rv$minor, sep = ".") + expect_equal(result, file.path("/tmp/my-global-cache", expected_version)) + }) +}) + +test_that("globalAppDataDir uses R.Version() major.minor, not getRversion()", { + + # Verify the version string format matches R.Version() output + + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = "/cache"), { + result <- globalAppDataDir() + rv <- R.Version() + expected <- file.path("/cache", paste(rv$major, rv$minor, sep = ".")) + expect_equal(result, expected) + }) +}) + +# --------------------------------------------------------------------------- +# globalCacheLibDir() +# --------------------------------------------------------------------------- + +test_that("globalCacheLibDir returns NULL when env var is unset", { + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = NA), { + expect_null(globalCacheLibDir()) + }) +}) + +test_that("globalCacheLibDir returns NULL when env var is empty string", { + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = ""), { + expect_null(globalCacheLibDir()) + }) +}) + +test_that("globalCacheLibDir builds correct path when env var is set", { + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = "/tmp/global"), { + result <- globalCacheLibDir() + rv <- R.Version() + version_str <- paste(rv$major, rv$minor, sep = ".") + expect_equal( + result, + file.path("/tmp/global", version_str, "v2", "library") + ) + }) +}) + +test_that("globalCacheLibDir passes variadic args to build full path", { + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = "/tmp/global"), { + result <- globalCacheLibDir("mypkg", "abc123", "mypkg") + rv <- R.Version() + version_str <- paste(rv$major, rv$minor, sep = ".") + expect_equal( + result, + file.path("/tmp/global", version_str, "v2", "library", + "mypkg", "abc123", "mypkg") + ) + }) +}) + +test_that("globalCacheLibDir with no extra args returns library root", { + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = "/cache"), { + result <- globalCacheLibDir() + expect_true(grepl("v2/library$", result)) + }) +}) + +# --------------------------------------------------------------------------- +# restoreWithCopyFromGlobalCache() +# --------------------------------------------------------------------------- + +test_that("restoreWithCopyFromGlobalCache returns FALSE when env var is not set", { + skip_on_cran() + + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = NA), { + project <- withr::local_tempdir() + pkgRecord <- make_pkg_record() + cacheCopyStatus <- new.env(parent = emptyenv()) + + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + + expect_false(result) + expect_null(cacheCopyStatus$type) + }) +}) + +test_that("restoreWithCopyFromGlobalCache returns FALSE when cache disabled for project", { + skip_on_cran() + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + # Ensure use.cache is FALSE (the default) + set_opts(project = project, use.cache = FALSE) + + pkgRecord <- make_pkg_record() + cacheCopyStatus <- new.env(parent = emptyenv()) + + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + + expect_false(result) + }) +}) + +test_that("restoreWithCopyFromGlobalCache returns FALSE when pkgRecord has no hash", { + skip_on_cran() + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(hash = NULL) + cacheCopyStatus <- new.env(parent = emptyenv()) + + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + + expect_false(result) + }) +}) + +test_that("restoreWithCopyFromGlobalCache returns FALSE when pkgRecord hash is empty character", { + skip_on_cran() + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + # length(character(0)) is 0, so this should return FALSE + pkgRecord <- make_pkg_record() + pkgRecord$hash <- character(0) + cacheCopyStatus <- new.env(parent = emptyenv()) + + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + + expect_false(result) + }) +}) + +test_that("restoreWithCopyFromGlobalCache returns FALSE when global cache entry does not exist", { + skip_on_cran() + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "nonexistent", hash = "deadbeef") + cacheCopyStatus <- new.env(parent = emptyenv()) + + # The directory for this package/hash does not exist in globalCacheDir + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + + expect_false(result) + }) +}) + +test_that("restoreWithCopyFromGlobalCache returns FALSE when cache entry is corrupt (no DESCRIPTION)", { + skip_on_cran() + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "badpkg", hash = "badhash") + + # Create the cache directory structure but without a DESCRIPTION file + rv <- R.Version() + version_str <- paste(rv$major, rv$minor, sep = ".") + corrupt_path <- file.path( + globalCacheDir, version_str, "v2", "library", + "badpkg", "badhash", "badpkg" + ) + dir.create(corrupt_path, recursive = TRUE) + # No DESCRIPTION file created -- this is the corruption + + cacheCopyStatus <- new.env(parent = emptyenv()) + + expect_warning( + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus), + "corrupt" + ) + + expect_false(result) + }) +}) + +test_that("restoreWithCopyFromGlobalCache returns FALSE when DESCRIPTION is empty", { + skip_on_cran() + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "emptydesc", hash = "ehash") + + rv <- R.Version() + version_str <- paste(rv$major, rv$minor, sep = ".") + pkg_path <- file.path( + globalCacheDir, version_str, "v2", "library", + "emptydesc", "ehash", "emptydesc" + ) + dir.create(pkg_path, recursive = TRUE) + file.create(file.path(pkg_path, "DESCRIPTION")) # empty file + + cacheCopyStatus <- new.env(parent = emptyenv()) + + expect_warning( + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus), + "corrupt" + ) + + expect_false(result) + }) +}) + +test_that("restoreWithCopyFromGlobalCache symlinks on success and sets status", { + skip_on_cran() + skip_on_os("windows") + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "goodpkg", hash = "goodhash") + + # Populate the global cache with a valid package + rv <- R.Version() + version_str <- paste(rv$major, rv$minor, sep = ".") + pkg_path <- file.path( + globalCacheDir, version_str, "v2", "library", + "goodpkg", "goodhash", "goodpkg" + ) + dir.create(pkg_path, recursive = TRUE) + writeLines( + c("Package: goodpkg", "Version: 1.0.0", "Title: Good"), + file.path(pkg_path, "DESCRIPTION") + ) + + # Create the project lib directory so the symlink target directory exists + lib <- libDir(project) + dir.create(lib, recursive = TRUE) + + cacheCopyStatus <- new.env(parent = emptyenv()) + + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + + expect_true(result) + expect_equal(cacheCopyStatus$type, "symlinked global cache") + + # Verify symlink was created + target <- file.path(lib, "goodpkg") + expect_true(file.exists(target)) + expect_true(is.symlink(target)) + }) +}) + +test_that("restoreWithCopyFromGlobalCache backs up and restores existing target on failure", { + skip_on_cran() + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "existing", hash = "nope") + + # Don't create the global cache entry -- so lookup will fail at the + # directory existence check. But the env var is set, cache is enabled, + # hash is present, package is cacheable -- it will reach the dir check. + + # Create an existing package in the project lib + lib <- libDir(project) + existing_path <- file.path(lib, "existing") + dir.create(existing_path, recursive = TRUE) + writeLines("marker", file.path(existing_path, "marker.txt")) + + cacheCopyStatus <- new.env(parent = emptyenv()) + + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + + # Should return FALSE because cache entry doesn't exist + expect_false(result) + + # The existing directory should NOT have been disturbed since the function + # returned FALSE before reaching the backup/symlink logic + # (the dir check happens before the backup) + }) +}) + +test_that("restoreWithCopyFromGlobalCache overwrites pre-existing target on success", { + skip_on_cran() + skip_on_os("windows") + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "replaceme", hash = "newhash") + + # Populate the global cache + rv <- R.Version() + version_str <- paste(rv$major, rv$minor, sep = ".") + pkg_path <- file.path( + globalCacheDir, version_str, "v2", "library", + "replaceme", "newhash", "replaceme" + ) + dir.create(pkg_path, recursive = TRUE) + writeLines( + c("Package: replaceme", "Version: 2.0.0", "Title: New"), + file.path(pkg_path, "DESCRIPTION") + ) + + # Create existing package in the project lib + lib <- libDir(project) + existing_path <- file.path(lib, "replaceme") + dir.create(existing_path, recursive = TRUE) + writeLines("old version marker", file.path(existing_path, "OLD_MARKER")) + + cacheCopyStatus <- new.env(parent = emptyenv()) + + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + + expect_true(result) + expect_equal(cacheCopyStatus$type, "symlinked global cache") + + # The target should now be a symlink, not the old directory + target <- file.path(lib, "replaceme") + expect_true(is.symlink(target)) + expect_false(file.exists(file.path(target, "OLD_MARKER"))) + expect_true(file.exists(file.path(target, "DESCRIPTION"))) + }) +}) + +# --------------------------------------------------------------------------- +# installPkg() fallback ordering +# --------------------------------------------------------------------------- + +test_that("installPkg tries global cache fallback after primary cache miss", { + skip_on_cran() + skip_on_os("windows") + + scopeTestContext() + + globalCacheDir <- withr::local_tempdir() + project <- withr::local_tempdir() + + # Enable cache for project + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "fromprimary", hash = "hash1") + + # Populate the PRIMARY cache (not global) with a valid entry + # so restoreWithCopyFromCache succeeds first + primaryCacheDir <- withr::local_tempdir() + withr::local_envvar( + R_PACKRAT_CACHE_DIR = primaryCacheDir, + R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir + ) + + rv <- R.Version() + primary_pkg_path <- file.path( + primaryCacheDir, getRversion(), "v2", "library", + "fromprimary", "hash1", "fromprimary" + ) + dir.create(primary_pkg_path, recursive = TRUE) + writeLines( + c("Package: fromprimary", "Version: 1.0.0", "Title: Primary"), + file.path(primary_pkg_path, "DESCRIPTION") + ) + + # Create the project lib directory + lib <- libDir(project) + dir.create(lib, recursive = TRUE) + + result <- installPkg(pkgRecord, project, repos = character(), lib = lib) + + # Should have come from primary cache + expect_equal(result, "symlinked cache") +}) + +test_that("installPkg falls through to global cache when primary cache misses", { + skip_on_cran() + skip_on_os("windows") + + scopeTestContext() + + globalCacheDir <- withr::local_tempdir() + primaryCacheDir <- withr::local_tempdir() + project <- withr::local_tempdir() + + withr::local_envvar( + R_PACKRAT_CACHE_DIR = primaryCacheDir, + R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir + ) + + # Enable cache for project + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "fromglobal", hash = "ghash") + + # Do NOT populate primary cache -- leave it empty. + # Populate the GLOBAL cache with a valid entry. + rv <- R.Version() + version_str <- paste(rv$major, rv$minor, sep = ".") + global_pkg_path <- file.path( + globalCacheDir, version_str, "v2", "library", + "fromglobal", "ghash", "fromglobal" + ) + dir.create(global_pkg_path, recursive = TRUE) + writeLines( + c("Package: fromglobal", "Version: 1.0.0", "Title: Global"), + file.path(global_pkg_path, "DESCRIPTION") + ) + + # Create the project lib directory + lib <- libDir(project) + dir.create(lib, recursive = TRUE) + + result <- installPkg(pkgRecord, project, repos = character(), lib = lib) + + # Should have come from global cache + expect_equal(result, "symlinked global cache") +}) + +test_that("installPkg skips global cache fallback when env var is unset", { + skip_on_cran() + skip_on_os("windows") + + scopeTestContext() + + primaryCacheDir <- withr::local_tempdir() + project <- withr::local_tempdir() + + withr::local_envvar( + R_PACKRAT_CACHE_DIR = primaryCacheDir, + R_PACKRAT_GLOBAL_CACHE_DIR = NA + ) + + # Enable cache for project + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "testpkg", hash = "thash") + + # Populate primary cache + primary_pkg_path <- file.path( + primaryCacheDir, getRversion(), "v2", "library", + "testpkg", "thash", "testpkg" + ) + dir.create(primary_pkg_path, recursive = TRUE) + writeLines( + c("Package: testpkg", "Version: 1.0.0", "Title: Test"), + file.path(primary_pkg_path, "DESCRIPTION") + ) + + lib <- libDir(project) + dir.create(lib, recursive = TRUE) + + # With global cache unset, should still succeed from primary cache + + result <- installPkg(pkgRecord, project, repos = character(), lib = lib) + expect_equal(result, "symlinked cache") +}) + +# --------------------------------------------------------------------------- +# Edge cases and interaction tests +# --------------------------------------------------------------------------- + +test_that("restoreWithCopyFromGlobalCache is independent of primary cache state", { + skip_on_cran() + skip_on_os("windows") + + # The global cache function doesn't check cacheLibDir at all. + # It uses globalCacheLibDir exclusively. + + globalCacheDir <- withr::local_tempdir() + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = globalCacheDir), { + project <- withr::local_tempdir() + set_opts(project = project, use.cache = TRUE) + withr::defer(set_opts(use.cache = FALSE, project = project)) + + pkgRecord <- make_pkg_record(name = "indep", hash = "ihash") + + # Create the global cache entry + rv <- R.Version() + version_str <- paste(rv$major, rv$minor, sep = ".") + pkg_path <- file.path( + globalCacheDir, version_str, "v2", "library", + "indep", "ihash", "indep" + ) + dir.create(pkg_path, recursive = TRUE) + writeLines( + c("Package: indep", "Version: 1.0.0", "Title: Independent"), + file.path(pkg_path, "DESCRIPTION") + ) + + lib <- libDir(project) + dir.create(lib, recursive = TRUE) + + cacheCopyStatus <- new.env(parent = emptyenv()) + result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + + expect_true(result) + expect_equal(cacheCopyStatus$type, "symlinked global cache") + }) +}) + +test_that("globalCacheLibDir path structure matches what restoreWithCopyFromGlobalCache expects", { + # Verify the path construction is consistent between the two functions + withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = "/test/cache"), { + # globalCacheLibDir with package path args + lib_path <- globalCacheLibDir("pkg", "hash", "pkg") + + rv <- R.Version() + version_str <- paste(rv$major, rv$minor, sep = ".") + + expect_equal( + lib_path, + file.path("/test/cache", version_str, "v2", "library", "pkg", "hash", "pkg") + ) + + # This is exactly the pattern used in restoreWithCopyFromGlobalCache: + # globalCacheLibDir(pkgRecord$name, pkgRecord$hash, pkgRecord$name) + pkgRecord <- make_pkg_record(name = "pkg", hash = "hash") + source_path <- globalCacheLibDir(pkgRecord$name, pkgRecord$hash, pkgRecord$name) + expect_equal(lib_path, source_path) + }) +}) From 37b64d592fdf3d2a0470c3221ea4ff942bd3b5fd Mon Sep 17 00:00:00 2001 From: Jonathan Yoder Date: Fri, 13 Mar 2026 15:46:19 -0400 Subject: [PATCH 2/2] Apply air formatting Co-Authored-By: Claude Opus 4.6 --- R/paths.R | 8 +- R/restore-routines.R | 18 ++- tests/testthat/test-global-cache.R | 176 +++++++++++++++++++++++------ 3 files changed, 162 insertions(+), 40 deletions(-) diff --git a/R/paths.R b/R/paths.R index 5b5ba98f..9e3e39a4 100644 --- a/R/paths.R +++ b/R/paths.R @@ -291,7 +291,9 @@ cacheLibDir <- function(...) { globalAppDataDir <- function() { globalCacheDir <- Sys.getenv("R_PACKRAT_GLOBAL_CACHE_DIR", unset = "") - if (!nzchar(globalCacheDir)) return(NULL) + if (!nzchar(globalCacheDir)) { + return(NULL) + } rVersion <- R.Version() rVersionString <- paste(rVersion$major, rVersion$minor, sep = ".") file.path(globalCacheDir, rVersionString) @@ -299,7 +301,9 @@ globalAppDataDir <- function() { globalCacheLibDir <- function(...) { globalDir <- globalAppDataDir() - if (is.null(globalDir)) return(NULL) + if (is.null(globalDir)) { + return(NULL) + } file.path(globalDir, "v2", "library", ...) } diff --git a/R/restore-routines.R b/R/restore-routines.R index 1c9ab275..ae5a5c43 100644 --- a/R/restore-routines.R +++ b/R/restore-routines.R @@ -113,9 +113,17 @@ restoreWithCopyFromCache <- function(project, pkgRecord, cacheCopyStatus) { return(FALSE) } -restoreWithCopyFromGlobalCache <- function(project, pkgRecord, cacheCopyStatus) { +restoreWithCopyFromGlobalCache <- function( + project, + pkgRecord, + cacheCopyStatus +) { # Only applies when a global cache fallback is configured - globalSource <- globalCacheLibDir(pkgRecord$name, pkgRecord$hash, pkgRecord$name) + globalSource <- globalCacheLibDir( + pkgRecord$name, + pkgRecord$hash, + pkgRecord$name + ) if (is.null(globalSource)) { return(FALSE) } @@ -190,7 +198,11 @@ restoreWithCopyFromGlobalCache <- function(project, pkgRecord, cacheCopyStatus) } # failed to copy or symlink from global cache; report warning and return false - warning("failed to symlink or copy package '", pkgRecord$name, "' from global cache") + warning( + "failed to symlink or copy package '", + pkgRecord$name, + "' from global cache" + ) return(FALSE) } diff --git a/tests/testthat/test-global-cache.R b/tests/testthat/test-global-cache.R index 1ea7b4e7..78e52a07 100644 --- a/tests/testthat/test-global-cache.R +++ b/tests/testthat/test-global-cache.R @@ -23,8 +23,12 @@ make_fake_cached_pkg <- function(base_dir, pkg_name, hash) { } # Build a pkgRecord list (mimics the structure used by packrat internals). -make_pkg_record <- function(name = "mypkg", hash = "abc123", version = "1.0.0", - source = "CRAN") { +make_pkg_record <- function( + name = "mypkg", + hash = "abc123", + version = "1.0.0", + source = "CRAN" +) { list(name = name, hash = hash, version = version, source = source) } @@ -54,7 +58,6 @@ test_that("globalAppDataDir returns correct path when env var is set", { }) test_that("globalAppDataDir uses R.Version() major.minor, not getRversion()", { - # Verify the version string format matches R.Version() output withr::with_envvar(c(R_PACKRAT_GLOBAL_CACHE_DIR = "/cache"), { @@ -100,8 +103,15 @@ test_that("globalCacheLibDir passes variadic args to build full path", { version_str <- paste(rv$major, rv$minor, sep = ".") expect_equal( result, - file.path("/tmp/global", version_str, "v2", "library", - "mypkg", "abc123", "mypkg") + file.path( + "/tmp/global", + version_str, + "v2", + "library", + "mypkg", + "abc123", + "mypkg" + ) ) }) }) @@ -125,7 +135,11 @@ test_that("restoreWithCopyFromGlobalCache returns FALSE when env var is not set" pkgRecord <- make_pkg_record() cacheCopyStatus <- new.env(parent = emptyenv()) - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) expect_false(result) expect_null(cacheCopyStatus$type) @@ -144,7 +158,11 @@ test_that("restoreWithCopyFromGlobalCache returns FALSE when cache disabled for pkgRecord <- make_pkg_record() cacheCopyStatus <- new.env(parent = emptyenv()) - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) expect_false(result) }) @@ -162,7 +180,11 @@ test_that("restoreWithCopyFromGlobalCache returns FALSE when pkgRecord has no ha pkgRecord <- make_pkg_record(hash = NULL) cacheCopyStatus <- new.env(parent = emptyenv()) - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) expect_false(result) }) @@ -182,7 +204,11 @@ test_that("restoreWithCopyFromGlobalCache returns FALSE when pkgRecord hash is e pkgRecord$hash <- character(0) cacheCopyStatus <- new.env(parent = emptyenv()) - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) expect_false(result) }) @@ -201,7 +227,11 @@ test_that("restoreWithCopyFromGlobalCache returns FALSE when global cache entry cacheCopyStatus <- new.env(parent = emptyenv()) # The directory for this package/hash does not exist in globalCacheDir - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) expect_false(result) }) @@ -222,8 +252,13 @@ test_that("restoreWithCopyFromGlobalCache returns FALSE when cache entry is corr rv <- R.Version() version_str <- paste(rv$major, rv$minor, sep = ".") corrupt_path <- file.path( - globalCacheDir, version_str, "v2", "library", - "badpkg", "badhash", "badpkg" + globalCacheDir, + version_str, + "v2", + "library", + "badpkg", + "badhash", + "badpkg" ) dir.create(corrupt_path, recursive = TRUE) # No DESCRIPTION file created -- this is the corruption @@ -231,7 +266,11 @@ test_that("restoreWithCopyFromGlobalCache returns FALSE when cache entry is corr cacheCopyStatus <- new.env(parent = emptyenv()) expect_warning( - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus), + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ), "corrupt" ) @@ -253,16 +292,25 @@ test_that("restoreWithCopyFromGlobalCache returns FALSE when DESCRIPTION is empt rv <- R.Version() version_str <- paste(rv$major, rv$minor, sep = ".") pkg_path <- file.path( - globalCacheDir, version_str, "v2", "library", - "emptydesc", "ehash", "emptydesc" + globalCacheDir, + version_str, + "v2", + "library", + "emptydesc", + "ehash", + "emptydesc" ) dir.create(pkg_path, recursive = TRUE) - file.create(file.path(pkg_path, "DESCRIPTION")) # empty file + file.create(file.path(pkg_path, "DESCRIPTION")) # empty file cacheCopyStatus <- new.env(parent = emptyenv()) expect_warning( - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus), + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ), "corrupt" ) @@ -286,8 +334,13 @@ test_that("restoreWithCopyFromGlobalCache symlinks on success and sets status", rv <- R.Version() version_str <- paste(rv$major, rv$minor, sep = ".") pkg_path <- file.path( - globalCacheDir, version_str, "v2", "library", - "goodpkg", "goodhash", "goodpkg" + globalCacheDir, + version_str, + "v2", + "library", + "goodpkg", + "goodhash", + "goodpkg" ) dir.create(pkg_path, recursive = TRUE) writeLines( @@ -301,7 +354,11 @@ test_that("restoreWithCopyFromGlobalCache symlinks on success and sets status", cacheCopyStatus <- new.env(parent = emptyenv()) - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) expect_true(result) expect_equal(cacheCopyStatus$type, "symlinked global cache") @@ -336,7 +393,11 @@ test_that("restoreWithCopyFromGlobalCache backs up and restores existing target cacheCopyStatus <- new.env(parent = emptyenv()) - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) # Should return FALSE because cache entry doesn't exist expect_false(result) @@ -363,8 +424,13 @@ test_that("restoreWithCopyFromGlobalCache overwrites pre-existing target on succ rv <- R.Version() version_str <- paste(rv$major, rv$minor, sep = ".") pkg_path <- file.path( - globalCacheDir, version_str, "v2", "library", - "replaceme", "newhash", "replaceme" + globalCacheDir, + version_str, + "v2", + "library", + "replaceme", + "newhash", + "replaceme" ) dir.create(pkg_path, recursive = TRUE) writeLines( @@ -380,7 +446,11 @@ test_that("restoreWithCopyFromGlobalCache overwrites pre-existing target on succ cacheCopyStatus <- new.env(parent = emptyenv()) - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) expect_true(result) expect_equal(cacheCopyStatus$type, "symlinked global cache") @@ -422,8 +492,13 @@ test_that("installPkg tries global cache fallback after primary cache miss", { rv <- R.Version() primary_pkg_path <- file.path( - primaryCacheDir, getRversion(), "v2", "library", - "fromprimary", "hash1", "fromprimary" + primaryCacheDir, + getRversion(), + "v2", + "library", + "fromprimary", + "hash1", + "fromprimary" ) dir.create(primary_pkg_path, recursive = TRUE) writeLines( @@ -467,8 +542,13 @@ test_that("installPkg falls through to global cache when primary cache misses", rv <- R.Version() version_str <- paste(rv$major, rv$minor, sep = ".") global_pkg_path <- file.path( - globalCacheDir, version_str, "v2", "library", - "fromglobal", "ghash", "fromglobal" + globalCacheDir, + version_str, + "v2", + "library", + "fromglobal", + "ghash", + "fromglobal" ) dir.create(global_pkg_path, recursive = TRUE) writeLines( @@ -508,8 +588,13 @@ test_that("installPkg skips global cache fallback when env var is unset", { # Populate primary cache primary_pkg_path <- file.path( - primaryCacheDir, getRversion(), "v2", "library", - "testpkg", "thash", "testpkg" + primaryCacheDir, + getRversion(), + "v2", + "library", + "testpkg", + "thash", + "testpkg" ) dir.create(primary_pkg_path, recursive = TRUE) writeLines( @@ -549,8 +634,13 @@ test_that("restoreWithCopyFromGlobalCache is independent of primary cache state" rv <- R.Version() version_str <- paste(rv$major, rv$minor, sep = ".") pkg_path <- file.path( - globalCacheDir, version_str, "v2", "library", - "indep", "ihash", "indep" + globalCacheDir, + version_str, + "v2", + "library", + "indep", + "ihash", + "indep" ) dir.create(pkg_path, recursive = TRUE) writeLines( @@ -562,7 +652,11 @@ test_that("restoreWithCopyFromGlobalCache is independent of primary cache state" dir.create(lib, recursive = TRUE) cacheCopyStatus <- new.env(parent = emptyenv()) - result <- restoreWithCopyFromGlobalCache(project, pkgRecord, cacheCopyStatus) + result <- restoreWithCopyFromGlobalCache( + project, + pkgRecord, + cacheCopyStatus + ) expect_true(result) expect_equal(cacheCopyStatus$type, "symlinked global cache") @@ -580,13 +674,25 @@ test_that("globalCacheLibDir path structure matches what restoreWithCopyFromGlob expect_equal( lib_path, - file.path("/test/cache", version_str, "v2", "library", "pkg", "hash", "pkg") + file.path( + "/test/cache", + version_str, + "v2", + "library", + "pkg", + "hash", + "pkg" + ) ) # This is exactly the pattern used in restoreWithCopyFromGlobalCache: # globalCacheLibDir(pkgRecord$name, pkgRecord$hash, pkgRecord$name) pkgRecord <- make_pkg_record(name = "pkg", hash = "hash") - source_path <- globalCacheLibDir(pkgRecord$name, pkgRecord$hash, pkgRecord$name) + source_path <- globalCacheLibDir( + pkgRecord$name, + pkgRecord$hash, + pkgRecord$name + ) expect_equal(lib_path, source_path) }) })