From c78b0f01a48e1a8f0ee99f1698a8327050d06c7e Mon Sep 17 00:00:00 2001 From: Kara Woo Date: Wed, 15 Jul 2026 10:20:23 -0700 Subject: [PATCH 1/5] remove overwrite arg --- R/cache.R | 38 +++++-------------------------------- tests/testthat/test-cache.R | 27 +++----------------------- 2 files changed, 8 insertions(+), 57 deletions(-) diff --git a/R/cache.R b/R/cache.R index 9d891d50..2de95fe1 100644 --- a/R/cache.R +++ b/R/cache.R @@ -198,13 +198,12 @@ symlinkPackageToCache <- function(packagePath, cachedPackagePath) { # package into the cache and replace the original directory with a symbolic # link into the package cache. # -# If the package already exists inside the cache, overwrite=TRUE causes -# replacement of the cached content while overwrite=FALSE with fatal=FALSE -# uses the cached package. Using overwrite=TRUE with fatal=TRUE will err. +# If the package already exists inside the cache, fatal=FALSE (the default) +# adopts the cached content as-is, while fatal=TRUE errs. This function never +# overwrites an existing cache entry. moveInstalledPackageToCache <- function( packagePath, hash, - overwrite = TRUE, fatal = FALSE, cacheDir = cacheLibDir() ) { @@ -212,29 +211,14 @@ moveInstalledPackageToCache <- function( packageName <- basename(packagePath) cachedPackagePath <- file.path(cacheDir, packageName, hash, packageName) - backupPackagePath <- tempfile(tmpdir = dirname(cachedPackagePath)) # check for existence of package in cache if (file.exists(cachedPackagePath)) { - if (fatal && !overwrite) { + if (fatal) { stop("cached package already exists at path '", cachedPackagePath, "'") } - if (!fatal) { - return(symlinkPackageToCache(packagePath, cachedPackagePath)) - } - } - - # back up a pre-existing cached package (restore on failure) - if (file.exists(cachedPackagePath)) { - if (!file.rename(cachedPackagePath, backupPackagePath)) { - stop( - "failed to back up package '", - packageName, - "'; cannot safely copy to cache" - ) - } - on.exit(unlink(backupPackagePath, recursive = TRUE), add = TRUE) + return(symlinkPackageToCache(packagePath, cachedPackagePath)) } if (isVerboseCache()) { @@ -263,18 +247,6 @@ moveInstalledPackageToCache <- function( return(symlinkPackageToCache(packagePath, cachedPackagePath)) } - # failed to insert package into cache -- restore any backed-up cache entry - # and return error - if (file.exists(backupPackagePath)) { - if (!file.rename(backupPackagePath, cachedPackagePath)) { - stop( - "failed to restore package '", - packageName, - "' in cache; package may be lost from cache" - ) - } - } - # return failure stop("failed to copy package '", packageName, "' to cache") } diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index 0e585a8e..2591a034 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -207,7 +207,7 @@ test_that("moveInstalledPackageToCache reports a fresh-package cache failure", { expect_true(file.exists(file.path(packagePath, "DESCRIPTION"))) }) -test_that("moveInstalledPackageToCache restores a backed-up cache entry", { +test_that("moveInstalledPackageToCache errs when fatal and the entry exists", { skip_on_os("windows") packagePath <- makeTestPackage("oatmeal", version = "2.0") @@ -220,44 +220,23 @@ test_that("moveInstalledPackageToCache restores a backed-up cache entry", { hash <- strrep("a", 32) cachedPackagePath <- file.path(cacheDir, "oatmeal", hash, "oatmeal") - # a pre-existing cache entry that overwrite = TRUE will back up dir.create(cachedPackagePath, recursive = TRUE) writeLines( c("Package: oatmeal", "Version: 1.0"), file.path(cachedPackagePath, "DESCRIPTION") ) - # the first two renames into the final cache location (direct rename, then - # rename of the temporary copy) fail; the third is the rollback of the - # backup, which must be allowed through - realRename <- base::file.rename - renamesToCache <- 0 - local_mocked_bindings( - file.rename = function(from, to) { - if (!identical(to, cachedPackagePath)) { - return(realRename(from, to)) - } - renamesToCache <<- renamesToCache + 1 - if (renamesToCache <= 2) { - return(FALSE) - } - realRename(from, to) - }, - .package = "base" - ) - expect_error( moveInstalledPackageToCache( packagePath, hash, - overwrite = TRUE, fatal = TRUE, cacheDir = cacheDir ), - "failed to copy package 'oatmeal' to cache" + "cached package already exists" ) - # the pre-existing cache entry was restored from backup + # the pre-existing cache entry is untouched desc <- readLines(file.path(cachedPackagePath, "DESCRIPTION")) expect_true("Version: 1.0" %in% desc) }) From b34b7ef0b7d0fc3d13e5e4d3fa3baf86d6910059 Mon Sep 17 00:00:00 2001 From: Kara Woo Date: Wed, 15 Jul 2026 14:59:16 -0700 Subject: [PATCH 2/5] remove fatal arg from moveInstalledPackageToCache --- R/cache.R | 11 ++----- tests/testthat/test-cache.R | 64 +++++++++++++++++-------------------- 2 files changed, 33 insertions(+), 42 deletions(-) diff --git a/R/cache.R b/R/cache.R index 2de95fe1..3f26374d 100644 --- a/R/cache.R +++ b/R/cache.R @@ -198,13 +198,12 @@ symlinkPackageToCache <- function(packagePath, cachedPackagePath) { # package into the cache and replace the original directory with a symbolic # link into the package cache. # -# If the package already exists inside the cache, fatal=FALSE (the default) -# adopts the cached content as-is, while fatal=TRUE errs. This function never -# overwrites an existing cache entry. +# If the package already exists inside the cache, its content is adopted +# as-is and the freshly-built package at packagePath is discarded. This +# function never overwrites an existing cache entry. moveInstalledPackageToCache <- function( packagePath, hash, - fatal = FALSE, cacheDir = cacheLibDir() ) { ensureDirectory(cacheDir) @@ -214,10 +213,6 @@ moveInstalledPackageToCache <- function( # check for existence of package in cache if (file.exists(cachedPackagePath)) { - if (fatal) { - stop("cached package already exists at path '", cachedPackagePath, "'") - } - return(symlinkPackageToCache(packagePath, cachedPackagePath)) } diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index 2591a034..38539c7b 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -125,6 +125,36 @@ test_that("moveInstalledPackageToCache caches a fresh package", { expect_true(file.exists(file.path(cachedPackagePath, "DESCRIPTION"))) }) +test_that("moveInstalledPackageToCache adopts a pre-existing cache entry", { + skip_on_os("windows") + + packagePath <- makeTestPackage("oatmeal", version = "2.0") + cacheDir <- tempfile("packrat-cache-") + on.exit( + unlink(c(dirname(packagePath), cacheDir), recursive = TRUE), + add = TRUE + ) + + hash <- strrep("a", 32) + cachedPackagePath <- file.path(cacheDir, "oatmeal", hash, "oatmeal") + + dir.create(cachedPackagePath, recursive = TRUE) + writeLines( + c("Package: oatmeal", "Version: 1.0"), + file.path(cachedPackagePath, "DESCRIPTION") + ) + + result <- moveInstalledPackageToCache(packagePath, hash, cacheDir = cacheDir) + + expect_identical(result, cachedPackagePath) + expect_true(is.symlink(packagePath)) + + # the pre-existing cache entry is untouched; the freshly-built package + # (version 2.0) was discarded in favor of it + desc <- readLines(file.path(cachedPackagePath, "DESCRIPTION")) + expect_true("Version: 1.0" %in% desc) +}) + test_that("moveInstalledPackageToCache adopts a competing process's copy", { skip_on_os("windows") @@ -207,40 +237,6 @@ test_that("moveInstalledPackageToCache reports a fresh-package cache failure", { expect_true(file.exists(file.path(packagePath, "DESCRIPTION"))) }) -test_that("moveInstalledPackageToCache errs when fatal and the entry exists", { - skip_on_os("windows") - - packagePath <- makeTestPackage("oatmeal", version = "2.0") - cacheDir <- tempfile("packrat-cache-") - on.exit( - unlink(c(dirname(packagePath), cacheDir), recursive = TRUE), - add = TRUE - ) - - hash <- strrep("a", 32) - cachedPackagePath <- file.path(cacheDir, "oatmeal", hash, "oatmeal") - - dir.create(cachedPackagePath, recursive = TRUE) - writeLines( - c("Package: oatmeal", "Version: 1.0"), - file.path(cachedPackagePath, "DESCRIPTION") - ) - - expect_error( - moveInstalledPackageToCache( - packagePath, - hash, - fatal = TRUE, - cacheDir = cacheDir - ), - "cached package already exists" - ) - - # the pre-existing cache entry is untouched - desc <- readLines(file.path(cachedPackagePath, "DESCRIPTION")) - expect_true("Version: 1.0" %in% desc) -}) - test_that("packrat uses the untrusted cache when instructed", { skip_on_cran() skip_on_os("windows") From 24cd4e795a709199b13e7e6845a927ee3bcd2599 Mon Sep 17 00:00:00 2001 From: Kara Woo Date: Wed, 15 Jul 2026 15:09:18 -0700 Subject: [PATCH 3/5] report discarded builds via cacheCopyStatus --- R/cache.R | 39 ++++++++++++++++++++++++++++++++++++- R/restore.R | 12 ++++++++++-- tests/testthat/test-cache.R | 29 ++++++++++++++++++++++++--- 3 files changed, 74 insertions(+), 6 deletions(-) diff --git a/R/cache.R b/R/cache.R index 3f26374d..42b23448 100644 --- a/R/cache.R +++ b/R/cache.R @@ -194,6 +194,27 @@ symlinkPackageToCache <- function(packagePath, cachedPackagePath) { return(cachedPackagePath) } +# Record that the freshly-built package at packagePath is being discarded in +# favor of an existing cache entry (either one that predates this call, or one +# a competing process just won the race to populate). Logs the reason when +# cache verbosity is on, and if cacheCopyStatus is supplied, sets its $type +# field so callers can report what actually happened instead of the outcome +# they expected before caching was attempted. +discardBuildForCacheEntry <- function(packageName, reason, cacheCopyStatus) { + if (isVerboseCache()) { + message( + "Discarding freshly-built ", + packageName, + "; ", + reason, + "." + ) + } + if (!is.null(cacheCopyStatus)) { + cacheCopyStatus$type <- "symlinked cache" + } +} + # Given a path to an installed package (outside the packrat cache), move that # package into the cache and replace the original directory with a symbolic # link into the package cache. @@ -201,10 +222,16 @@ symlinkPackageToCache <- function(packagePath, cachedPackagePath) { # If the package already exists inside the cache, its content is adopted # as-is and the freshly-built package at packagePath is discarded. This # function never overwrites an existing cache entry. +# +# cacheCopyStatus, if supplied, is an environment that gets a $type field set +# to "symlinked cache" whenever a freshly-built package is discarded in favor +# of an existing cache entry, so callers can report what actually happened +# instead of the outcome they expected before caching was attempted. moveInstalledPackageToCache <- function( packagePath, hash, - cacheDir = cacheLibDir() + cacheDir = cacheLibDir(), + cacheCopyStatus = NULL ) { ensureDirectory(cacheDir) @@ -213,6 +240,11 @@ moveInstalledPackageToCache <- function( # check for existence of package in cache if (file.exists(cachedPackagePath)) { + discardBuildForCacheEntry( + packageName, + "already present in cache", + cacheCopyStatus + ) return(symlinkPackageToCache(packagePath, cachedPackagePath)) } @@ -239,6 +271,11 @@ moveInstalledPackageToCache <- function( # failed to insert the package; if a competing process populated the cache # entry in the meantime, use it if (file.exists(cachedPackagePath)) { + discardBuildForCacheEntry( + packageName, + "a competing process cached it first", + cacheCopyStatus + ) return(symlinkPackageToCache(packagePath, cachedPackagePath)) } diff --git a/R/restore.R b/R/restore.R index 6cd85d22..761f47b3 100644 --- a/R/restore.R +++ b/R/restore.R @@ -791,8 +791,12 @@ installPkg <- function(pkgRecord, project, repos, lib = libDir(project)) { moveInstalledPackageToCache( packagePath = pkgInstallPath, hash = hash, - cacheDir = cacheLibDir() + cacheDir = cacheLibDir(), + cacheCopyStatus = cacheCopyStatus ) + if (!is.null(cacheCopyStatus$type)) { + type <- cacheCopyStatus$type + } } } else { tarballName <- pkgSrcFilename(pkgRecord) @@ -804,8 +808,12 @@ installPkg <- function(pkgRecord, project, repos, lib = libDir(project)) { moveInstalledPackageToCache( packagePath = pkgInstallPath, hash = hash, - cacheDir = untrustedCacheLibDir() + cacheDir = untrustedCacheLibDir(), + cacheCopyStatus = cacheCopyStatus ) + if (!is.null(cacheCopyStatus$type)) { + type <- cacheCopyStatus$type + } } } } diff --git a/tests/testthat/test-cache.R b/tests/testthat/test-cache.R index 38539c7b..a745d87f 100644 --- a/tests/testthat/test-cache.R +++ b/tests/testthat/test-cache.R @@ -118,11 +118,20 @@ test_that("moveInstalledPackageToCache caches a fresh package", { hash <- strrep("a", 32) cachedPackagePath <- file.path(cacheDir, "oatmeal", hash, "oatmeal") - result <- moveInstalledPackageToCache(packagePath, hash, cacheDir = cacheDir) + cacheCopyStatus <- new.env(parent = emptyenv()) + result <- moveInstalledPackageToCache( + packagePath, + hash, + cacheDir = cacheDir, + cacheCopyStatus = cacheCopyStatus + ) expect_identical(result, cachedPackagePath) expect_true(is.symlink(packagePath)) expect_true(file.exists(file.path(cachedPackagePath, "DESCRIPTION"))) + + # a fresh insert isn't a discard, so no status is reported + expect_null(cacheCopyStatus$type) }) test_that("moveInstalledPackageToCache adopts a pre-existing cache entry", { @@ -144,7 +153,13 @@ test_that("moveInstalledPackageToCache adopts a pre-existing cache entry", { file.path(cachedPackagePath, "DESCRIPTION") ) - result <- moveInstalledPackageToCache(packagePath, hash, cacheDir = cacheDir) + cacheCopyStatus <- new.env(parent = emptyenv()) + result <- moveInstalledPackageToCache( + packagePath, + hash, + cacheDir = cacheDir, + cacheCopyStatus = cacheCopyStatus + ) expect_identical(result, cachedPackagePath) expect_true(is.symlink(packagePath)) @@ -153,6 +168,7 @@ test_that("moveInstalledPackageToCache adopts a pre-existing cache entry", { # (version 2.0) was discarded in favor of it desc <- readLines(file.path(cachedPackagePath, "DESCRIPTION")) expect_true("Version: 1.0" %in% desc) + expect_identical(cacheCopyStatus$type, "symlinked cache") }) test_that("moveInstalledPackageToCache adopts a competing process's copy", { @@ -192,11 +208,18 @@ test_that("moveInstalledPackageToCache adopts a competing process's copy", { .package = "base" ) - result <- moveInstalledPackageToCache(packagePath, hash, cacheDir = cacheDir) + cacheCopyStatus <- new.env(parent = emptyenv()) + result <- moveInstalledPackageToCache( + packagePath, + hash, + cacheDir = cacheDir, + cacheCopyStatus = cacheCopyStatus + ) expect_identical(result, cachedPackagePath) expect_true(is.symlink(packagePath)) expect_true(file.exists(file.path(packagePath, "DESCRIPTION"))) + expect_identical(cacheCopyStatus$type, "symlinked cache") }) test_that("moveInstalledPackageToCache reports a fresh-package cache failure", { From f8c910a522a128bf9755de5fd1c0e17688c1d39b Mon Sep 17 00:00:00 2001 From: Kara Woo Date: Thu, 16 Jul 2026 10:28:55 -0700 Subject: [PATCH 4/5] add comment --- R/cache.R | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/R/cache.R b/R/cache.R index 42b23448..b0946fce 100644 --- a/R/cache.R +++ b/R/cache.R @@ -257,8 +257,11 @@ moveInstalledPackageToCache <- function( return(symlinkPackageToCache(packagePath, cachedPackagePath)) } - # rename failed; copy to temporary destination in same directory - # and then attempt to rename from there + # rename failed. this can happen when the library and cache live on different + # filesystems, when a competing process created the cache entry first, or on + # other OS errors (permissions, disk full). copy to a temporary destination in + # the same directory as the target (so the final rename stays within one + # filesystem) and attempt to rename from there tempPath <- tempfile(tmpdir = dirname(cachedPackagePath)) on.exit(unlink(tempPath, recursive = TRUE), add = TRUE) if (all(dir_copy(packagePath, tempPath))) { From d177487939e15ac9ee68072c2d62f58e90e6077e Mon Sep 17 00:00:00 2001 From: Kara Woo Date: Thu, 16 Jul 2026 10:33:21 -0700 Subject: [PATCH 5/5] skip new linting checks --- R/aaa-globals.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/aaa-globals.R b/R/aaa-globals.R index 02e0d500..1a6c9be1 100644 --- a/R/aaa-globals.R +++ b/R/aaa-globals.R @@ -35,11 +35,11 @@ new_defaults <- function(value = list()) { if (is.null(names(dots)) && length(dots) == 1 && is.list(dots[[1]])) { if (length(dots <- dots[[1]]) == 0) return() } - defaults <<- merge(dots) + defaults <<- merge(dots) # nolint invisible(NULL) } merge <- function(values) merge_list(defaults, values) - restore <- function(target = value) defaults <<- target + restore <- function(target = value) defaults <<- target # nolint list(get = get, set = set, merge = merge, restore = restore) }