From 76bc40d03d56c485be00395f31d2a291c273571e Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 12 Dec 2024 13:38:03 -0800 Subject: [PATCH 01/16] start recording extra fields in lockfile --- R/hash.R | 61 ++++++++++++++++++++---------- R/lockfile-write.R | 4 +- R/lockfile.R | 1 + R/record.R | 2 +- R/snapshot.R | 48 ++++------------------- R/zzz.R | 2 +- tests/testthat/test-bioconductor.R | 6 +-- tests/testthat/test-lockfile.R | 21 +++++----- tests/testthat/test-snapshot.R | 8 ++-- tests/testthat/test-vendor.R | 4 -- 10 files changed, 68 insertions(+), 89 deletions(-) diff --git a/R/hash.R b/R/hash.R index a20f6a31f..14c5a53c2 100644 --- a/R/hash.R +++ b/R/hash.R @@ -3,6 +3,44 @@ renv_hash_text <- function(text) { renv_bootstrap_hash_text(text) } +renv_hash_fields <- function(dcf) { + c( + renv_hash_fields_default(), + renv_hash_fields_remotes(dcf) + ) +} + +renv_hash_fields_default <- function() { + c( + "Package", "Version", + "Title", "Author", "Maintainer", "Description", + "Depends", "Imports", "Suggests", "LinkingTo" + ) +} + +renv_hash_fields_remotes <- function(dcf) { + + # if this seems to be a cran-like record, only keep remotes + # when RemoteSha appears to be a hash (e.g. for r-universe) + # note that RemoteSha may be a package version when installed + # by e.g. pak + if (renv_record_cranlike(dcf)) { + sha <- dcf[["RemoteSha"]] + if (is.null(sha) || nchar(sha) < 40L) + return(character()) + } + + # grab the relevant remotes + remotes <- grep("^Remote(?!s)", names(dcf), perl = TRUE, value = TRUE) + + # don't include 'RemoteRef' if it's a non-informative remote + if (identical(dcf[["RemoteRef"]], "HEAD")) + remotes <- setdiff(remotes, "RemoteRef") + + remotes + +} + renv_hash_description <- function(path) { filebacked( context = "renv_hash_description", @@ -19,17 +57,11 @@ renv_hash_description_impl <- function(path) { ~ stop("unexpected path '%s'", path) ) - # include default fields - fields <- c( - "Package", "Version", "Title", "Author", "Maintainer", "Description", - "Depends", "Imports", "Suggests", "LinkingTo" - ) - - # add remotes fields - remotes <- renv_hash_description_remotes(dcf) + # find relevant fields for hashing + fields <- renv_hash_fields(dcf) # retrieve these fields - subsetted <- dcf[renv_vector_intersect(c(fields, remotes), names(dcf))] + subsetted <- dcf[renv_vector_intersect(fields, names(dcf))] # sort names (use C locale to ensure consistent ordering) ordered <- subsetted[csort(names(subsetted))] @@ -71,14 +103,3 @@ renv_hash_description_impl <- function(path) { invisible(hash) } - -renv_hash_description_remotes <- function(dcf) { - - # ignore other remote fields for cranlike remotes - if (renv_record_cranlike(dcf)) - return(character()) - - # otherwise, include any other discovered remote fields - grep("^Remote", names(dcf), value = TRUE) - -} diff --git a/R/lockfile-write.R b/R/lockfile-write.R index 0310c35ca..d881a3bff 100644 --- a/R/lockfile-write.R +++ b/R/lockfile-write.R @@ -90,9 +90,7 @@ renv_lockfile_write_json <- function(lockfile, file = stdout()) { prepared <- enumerate(lockfile, renv_lockfile_write_json_prepare) - box <- c("Depends", "Imports", "Suggests", "LinkingTo", "Requirements") - config <- list(box = box) - json <- renv_json_convert(prepared, config) + json <- renv_json_convert(prepared) if (is.null(file)) return(json) diff --git a/R/lockfile.R b/R/lockfile.R index e19ff9988..57723b96b 100644 --- a/R/lockfile.R +++ b/R/lockfile.R @@ -122,6 +122,7 @@ renv_lockfile_save <- function(lockfile, project) { } renv_lockfile_load <- function(project, strict = FALSE) { + path <- renv_lockfile_path(project) if (file.exists(path)) return(renv_lockfile_read(path)) diff --git a/R/record.R b/R/record.R index 79ec8cf99..5fb417377 100644 --- a/R/record.R +++ b/R/record.R @@ -121,5 +121,5 @@ renv_record_placeholder <- function() { renv_record_cranlike <- function(record) { type <- record[["RemoteType"]] - is.null(type) || type %in% c("cran", "repository", "standard") + is.null(type) || tolower(type) %in% c("cran", "repository", "standard") } diff --git a/R/snapshot.R b/R/snapshot.R index e9fffb18d..c7d918f3e 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -741,6 +741,10 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { dcf <- dcf[fields] } + # collect fields to include in lockfile + fields <- c("Source", renv_hash_fields(dcf), "Repository", "OS_type") + dcf <- dcf[renv_vector_intersect(names(dcf), fields)] + # generate a hash if we can dcf[["Hash"]] <- if (the$auto_snapshot_hash) { if (is.null(path)) @@ -748,47 +752,9 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { else renv_hash_description(path) } - - # generate a Requirements field -- primarily for use by 'pak' - fields <- c("Depends", "Imports", "LinkingTo") - deps <- bind(map(dcf[fields], renv_description_parse_field)) - all <- unique(csort(unlist(deps$Package))) - dcf[["Requirements"]] <- all - - # get remotes fields - remotes <- renv_snapshot_description_impl_remotes(dcf) - - # only keep relevant fields - extra <- c("Repository", "OS_type") - all <- c(required, extra, remotes, "Requirements", "Hash") - keep <- renv_vector_intersect(all, names(dcf)) - + # return as list - as.list(dcf[keep]) - -} - -renv_snapshot_description_impl_remotes <- function(dcf) { - - # if this seems to be a cran-like record, only keep remotes - # when RemoteSha appears to be a hash (e.g. for r-universe) - # note that RemoteSha may be a package version when installed - # by e.g. pak - if (renv_record_cranlike(dcf)) { - sha <- dcf[["RemoteSha"]] - if (is.null(sha) || nchar(sha) < 40) - return(character()) - } - - # grab the relevant remotes - git <- grep("^git", names(dcf), value = TRUE) - remotes <- grep("^Remote(?!s)", names(dcf), perl = TRUE, value = TRUE) - - # don't include 'RemoteRef' if it's a non-informative remote - if (identical(dcf[["RemoteRef"]], "HEAD")) - remotes <- setdiff(remotes, "RemoteRef") - - c(git, remotes) + as.list(dcf) } @@ -840,7 +806,7 @@ renv_snapshot_description_source <- function(dcf) { # check for a custom declared remote type if (!renv_record_cranlike(dcf)) { - type <- dcf[["RemoteType"]] + type <- dcf[["RemoteType"]] %||% "standard" return(list(Source = alias(type))) } diff --git a/R/zzz.R b/R/zzz.R index faf8025e4..08dd760c4 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -29,7 +29,7 @@ } # don't lock sandbox while testing / checking - options(renv.sandbox.locking_enabled = FALSE) + Sys.setenv(RENV_SANDBOX_LOCKING_ENABLED = FALSE) } diff --git a/tests/testthat/test-bioconductor.R b/tests/testthat/test-bioconductor.R index 15d117ded..4e64de8d2 100644 --- a/tests/testthat/test-bioconductor.R +++ b/tests/testthat/test-bioconductor.R @@ -222,11 +222,9 @@ test_that("standard bioc remotes are standardized appropriately", { Package = "BiocVersion", Version = "3.18.1", Source = "Bioconductor", - Repository = "Bioconductor 3.18", - Requirements = "R", - Hash = "2ecaed86684f5fae76ed5530f9d29c4a" + Repository = "Bioconductor 3.18" ) - expect_identical(actual, expected) + expect_identical(actual[names(expected)], expected) }) diff --git a/tests/testthat/test-lockfile.R b/tests/testthat/test-lockfile.R index d9527903f..4f5ff23cc 100644 --- a/tests/testthat/test-lockfile.R +++ b/tests/testthat/test-lockfile.R @@ -53,22 +53,23 @@ test_that("we create lockfile from a manifest automatically when no lockfile fou skip_on_cran() - project_dir <- tempfile() - dir.create(project_dir) + project <- tempfile() + dir.create(project) - manifest <- "resources/manifest.json" - expected_lock <- renv_lockfile_from_manifest("resources/manifest.json") - file.copy(manifest, file.path(project_dir, "manifest.json")) + path <- renv_tests_path("resources/manifest.json") + expected <- renv_lockfile_from_manifest(path) + file.copy(path, file.path(project, "manifest.json")) # when called with `strict = TRUE` does not create manifest - expect_error(renv_lockfile_load(project_dir, strict = TRUE)) + expect_error(renv_lockfile_load(project, strict = TRUE)) # creates and reads lockfile - obtained_lock <- renv_lockfile_load(project_dir) - expect_identical(expected_lock, obtained_lock) - expect_true(file.exists(file.path(project_dir, "renv.lock"))) + actual <- renv_lockfile_load(project) + expect_identical(expected, actual) + expect_true(file.exists(file.path(project, "renv.lock"))) - unlink(project_dir, recursive = TRUE) + unlink(project, recursive = TRUE) + }) test_that("the Requirements field is read as character", { diff --git a/tests/testthat/test-snapshot.R b/tests/testthat/test-snapshot.R index 52e666ea0..c04f9d3eb 100644 --- a/tests/testthat/test-snapshot.R +++ b/tests/testthat/test-snapshot.R @@ -397,13 +397,11 @@ test_that("packages installed from CRAN using pak are handled", { library <- renv_paths_library() ensure_directory(library) pak <- renv_namespace_load("pak") - suppressMessages(pak$pkg_install("toast")) + quietly(pak$pkg_install("toast")) record <- renv_snapshot_description(package = "toast") - expect_named( - record, - c("Package", "Version", "Source", "Repository", "Requirements", "Hash") - ) + expected <- c("Package", "Version", "Source", "Repository", "Hash") + expect_contains(names(record), expected) expect_identical(record$Source, "Repository") expect_identical(record$Repository, "CRAN") diff --git a/tests/testthat/test-vendor.R b/tests/testthat/test-vendor.R index 86d3b0caa..e35297c22 100644 --- a/tests/testthat/test-vendor.R +++ b/tests/testthat/test-vendor.R @@ -43,10 +43,6 @@ test_that("renv can be vendored into an R package", { base <- .BaseNamespaceEnv base$.libPaths(path) - # extra sanity check - if (requireNamespace("renv", quietly = TRUE)) - stop("internal error: renv shouldn't be visible on library paths") - # load the package, and check that renv realizes it's embedded namespace <- base$asNamespace("test.renv.embedding") embedded <- namespace$renv$renv_metadata_embedded() From debaf54d97ad996d64ff7ecd3444e53ca4979c9e Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 12 Dec 2024 13:41:55 -0800 Subject: [PATCH 02/16] add a test --- tests/testthat/test-snapshot.R | 16 ++++++++++++++++ 1 file changed, 16 insertions(+) diff --git a/tests/testthat/test-snapshot.R b/tests/testthat/test-snapshot.R index c04f9d3eb..e24562721 100644 --- a/tests/testthat/test-snapshot.R +++ b/tests/testthat/test-snapshot.R @@ -613,3 +613,19 @@ test_that("standard remotes drop RemoteSha if it's a version", { expect_null(record[["RemoteSha"]]) }) + +test_that("a package's hash can be re-generated from lockfile", { + + project <- renv_tests_scope("breakfast") + init() + + lockfile <- snapshot(lockfile = NULL) + records <- renv_lockfile_records(lockfile) + + map(records, function(record) { + actual <- record[["Hash"]] + expected <- renv_hash_description_impl(record) + expect_equal(actual, expected) + }) + +}) From 681145b5d134792dd8dafa259f5565e04af0cf73 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 12 Dec 2024 13:45:11 -0800 Subject: [PATCH 03/16] reorganize --- R/snapshot.R | 3 +++ 1 file changed, 3 insertions(+) diff --git a/R/snapshot.R b/R/snapshot.R index c7d918f3e..051276ae4 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -753,6 +753,9 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { renv_hash_description(path) } + # reorganize fields a bit + dcf <- dcf[c(required, setdiff(names(dcf), required))] + # return as list as.list(dcf) From f64e49eb933d3803f3b1d7dc5b213ec36a42467d Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 12 Dec 2024 14:02:09 -0800 Subject: [PATCH 04/16] include more fields --- R/hash.R | 4 ++-- R/snapshot.R | 8 +++++--- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/R/hash.R b/R/hash.R index 14c5a53c2..e008b27af 100644 --- a/R/hash.R +++ b/R/hash.R @@ -10,7 +10,7 @@ renv_hash_fields <- function(dcf) { ) } -renv_hash_fields_default <- function() { +renv_hash_fields_default <- function(dcf) { c( "Package", "Version", "Title", "Author", "Maintainer", "Description", @@ -31,7 +31,7 @@ renv_hash_fields_remotes <- function(dcf) { } # grab the relevant remotes - remotes <- grep("^Remote(?!s)", names(dcf), perl = TRUE, value = TRUE) + remotes <- grep("^Remote", names(dcf), perl = TRUE, value = TRUE) # don't include 'RemoteRef' if it's a non-informative remote if (identical(dcf[["RemoteRef"]], "HEAD")) diff --git a/R/snapshot.R b/R/snapshot.R index 051276ae4..c8f8d5a95 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -741,9 +741,11 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { dcf <- dcf[fields] } - # collect fields to include in lockfile - fields <- c("Source", renv_hash_fields(dcf), "Repository", "OS_type") - dcf <- dcf[renv_vector_intersect(names(dcf), fields)] + # drop fields that normally only appear in binary packages, + # or fields which might differ from user to user, or might + # differ depending on the mirror used for publication + ignore <- c("Packaged", "Date/Publication", "Built") + dcf[ignore] <- NULL # generate a hash if we can dcf[["Hash"]] <- if (the$auto_snapshot_hash) { From fcfb00f9085b5ccd789a5a5e0897951a96a424d4 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 12 Dec 2024 16:54:31 -0800 Subject: [PATCH 05/16] drop Remote fields for cran-like records --- R/snapshot.R | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/R/snapshot.R b/R/snapshot.R index c8f8d5a95..de37ee796 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -747,6 +747,15 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { ignore <- c("Packaged", "Date/Publication", "Built") dcf[ignore] <- NULL + # drop remote fields for cranlike remotes + if (renv_record_cranlike(dcf)) { + sha <- dcf[["RemoteSha"]] + if (is.null(sha) || nchar(sha) < 40L) { + remotes <- grep("^Remote", names(dcf), perl = TRUE, value = TRUE) + dcf[remotes] <- NULL + } + } + # generate a hash if we can dcf[["Hash"]] <- if (the$auto_snapshot_hash) { if (is.null(path)) From eb3e6dfc1531bc284a586fad68d81edfa85b2804 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Fri, 13 Dec 2024 11:54:25 -0800 Subject: [PATCH 06/16] tweaks --- R/hash.R | 6 +++--- R/snapshot.R | 6 +++++- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/R/hash.R b/R/hash.R index e008b27af..04bc616b3 100644 --- a/R/hash.R +++ b/R/hash.R @@ -10,10 +10,10 @@ renv_hash_fields <- function(dcf) { ) } -renv_hash_fields_default <- function(dcf) { +renv_hash_fields_default <- function() { c( - "Package", "Version", - "Title", "Author", "Maintainer", "Description", + "Package", "Version", "Title", + "Author", "Maintainer", "Description", "Depends", "Imports", "Suggests", "LinkingTo" ) } diff --git a/R/snapshot.R b/R/snapshot.R index de37ee796..28b1851da 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -744,7 +744,7 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { # drop fields that normally only appear in binary packages, # or fields which might differ from user to user, or might # differ depending on the mirror used for publication - ignore <- c("Packaged", "Date/Publication", "Built") + ignore <- c("Archs", "Built", "Date/Publication", "File", "MD5sum", "Packaged") dcf[ignore] <- NULL # drop remote fields for cranlike remotes @@ -756,6 +756,10 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { } } + # drop the old Github remote fields + github <- grepl("^Github", names(dcf), perl = TRUE) + dcf <- dcf[!github] + # generate a hash if we can dcf[["Hash"]] <- if (the$auto_snapshot_hash) { if (is.null(path)) From 526106bd74d3c25f01946ecacc3238a7a2d106c8 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Wed, 18 Dec 2024 12:47:42 -0800 Subject: [PATCH 07/16] update NEWS; provide option as fallback --- NEWS.md | 3 +++ R/lockfile-write.R | 5 ++++- R/snapshot.R | 21 +++++++++++++++++++++ 3 files changed, 28 insertions(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index bf1b8a523..0c37df4f0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,9 @@ # renv 1.1.0 (UNRELEASED) +* `renv` now includes the contents of each package's DESCRIPTION file in + the package records for generated lockfiles. (#2057) + * `renv` now detects dependencies from usages of `utils::citation()`. (#2047) * Fixed an issue where packages installed from r-universe via an explicit diff --git a/R/lockfile-write.R b/R/lockfile-write.R index d881a3bff..24be204fb 100644 --- a/R/lockfile-write.R +++ b/R/lockfile-write.R @@ -90,7 +90,10 @@ renv_lockfile_write_json <- function(lockfile, file = stdout()) { prepared <- enumerate(lockfile, renv_lockfile_write_json_prepare) - json <- renv_json_convert(prepared) + box <- c("Requirements") + config <- list(box = box) + + json <- renv_json_convert(prepared, config) if (is.null(file)) return(json) diff --git a/R/snapshot.R b/R/snapshot.R index 28b1851da..799623d12 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -768,6 +768,27 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { renv_hash_description(path) } + # keep only required fields if requested + minimal <- getOption("renv.lockfile.minimal", default = FALSE) + if (minimal) { + + # generate a Requirements field -- primarily for use by 'pak' + fields <- c("Depends", "Imports", "LinkingTo") + deps <- bind(map(dcf[fields], renv_description_parse_field)) + all <- unique(csort(unlist(deps$Package))) + dcf[["Requirements"]] <- all + + # keep any existing remotes fields + remotes <- grep("^Remote", names(dcf), perl = TRUE, value = TRUE) + + # only keep relevant fields + extra <- c("Repository", "OS_type") + all <- c(required, extra, remotes, "Requirements", "Hash") + keep <- renv_vector_intersect(all, names(dcf)) + dcf <- dcf[keep] + + } + # reorganize fields a bit dcf <- dcf[c(required, setdiff(names(dcf), required))] From 70eb28be5cbbbfe84fb7206a62315ba49ef9c62e Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Wed, 18 Dec 2024 13:07:09 -0800 Subject: [PATCH 08/16] add snapshot test for old lockfile --- R/aaa.R | 5 +++ R/zzz.R | 9 ++++-- tests/testthat/_snaps/snapshot.md | 54 +++++++++++++++++++++++++++++++ tests/testthat/test-snapshot.R | 13 ++++++++ 4 files changed, 79 insertions(+), 2 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index fc6664fd0..36ef7ec6e 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -42,3 +42,8 @@ testing <- function() { devel <- function() { identical(R.version[["status"]], "Under development (unstable)") } + +devmode <- function() { + load <- Sys.getenv("DEVTOOLS_LOAD", unset = NA) + identical(load, "renv") +} diff --git a/R/zzz.R b/R/zzz.R index 08dd760c4..1c2284d93 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -28,10 +28,15 @@ Sys.setenv(RENV_PATHS_SANDBOX = sandbox) } - # don't lock sandbox while testing / checking + } + + # don't lock sandbox while testing / checking + if (testing() || checking() || devmode()) { + options(renv.sandbox.locking_enabled = FALSE) Sys.setenv(RENV_SANDBOX_LOCKING_ENABLED = FALSE) - } + + renv_defer_init() renv_metadata_init() diff --git a/tests/testthat/_snaps/snapshot.md b/tests/testthat/_snaps/snapshot.md index eb01a7049..e3d2f3b21 100644 --- a/tests/testthat/_snaps/snapshot.md +++ b/tests/testthat/_snaps/snapshot.md @@ -226,3 +226,57 @@ - The lockfile is already up to date. +# we can produce old-style lockfiles if requested + + Code + . <- writeLines(readLines("renv.lock")) + Output + { + "R": { + "Version": "", + "Repositories": [ + { + "Name": "CRAN", + "URL": "" + } + ] + }, + "Packages": { + "bread": { + "Package": "bread", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "3d2aa8db4086921058b23ce646e01c7a" + }, + "breakfast": { + "Package": "breakfast", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "oatmeal", + "toast" + ], + "Hash": "0fcd2a795901b4b21326a3e35442c97c" + }, + "oatmeal": { + "Package": "oatmeal", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Hash": "1997110c04a1a14551dc791abb7cf8cf" + }, + "toast": { + "Package": "toast", + "Version": "1.0.0", + "Source": "Repository", + "Repository": "CRAN", + "Requirements": [ + "bread" + ], + "Hash": "d2f51ee89552a4668cbe9fc25b1f7c1e" + } + } + } + diff --git a/tests/testthat/test-snapshot.R b/tests/testthat/test-snapshot.R index e24562721..c949402e3 100644 --- a/tests/testthat/test-snapshot.R +++ b/tests/testthat/test-snapshot.R @@ -629,3 +629,16 @@ test_that("a package's hash can be re-generated from lockfile", { }) }) + +test_that("we can produce old-style lockfiles if requested", { + + skip_on_cran() + skip_on_ci() + + renv_scope_options(renv.lockfile.minimal = TRUE) + + project <- renv_tests_scope("breakfast") + init() + expect_snapshot(. <- writeLines(readLines("renv.lock"))) + +}) From f2753f995dea7516942d2e502b9d14f3ce88f5c1 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Wed, 18 Dec 2024 14:00:41 -0800 Subject: [PATCH 09/16] test different versions of lockfiles --- R/aaa.R | 3 +- R/snapshot.R | 107 ++++++++++++++++++++++++------ R/zzz.R | 5 +- tests/testthat/_snaps/snapshot.md | 78 +++++++++++++++++++++- tests/testthat/test-snapshot.R | 17 ++++- 5 files changed, 180 insertions(+), 30 deletions(-) diff --git a/R/aaa.R b/R/aaa.R index 36ef7ec6e..b641c6487 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -44,6 +44,5 @@ devel <- function() { } devmode <- function() { - load <- Sys.getenv("DEVTOOLS_LOAD", unset = NA) - identical(load, "renv") + Sys.getenv("DEVTOOLS_LOAD") == .packageName } diff --git a/R/snapshot.R b/R/snapshot.R index 799623d12..a0d65e91b 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -718,6 +718,92 @@ renv_snapshot_description <- function(path = NULL, package = NULL) { renv_snapshot_description_impl <- function(dcf, path = NULL) { + version <- getOption("renv.lockfile.version", default = 2L) + if (version == 1L) + renv_snapshot_description_impl_v1(dcf, path) + else if (version == 2L) + renv_snapshot_description_impl_v2(dcf, path) + else + stopf("unsupported lockfile version '%s'", format(version)) + +} + +renv_snapshot_description_impl_v1 <- function(dcf, path = NULL) { + + # figure out the package source + source <- renv_snapshot_description_source(dcf) + dcf[names(source)] <- source + + # check for required fields + required <- c("Package", "Version", "Source") + missing <- renv_vector_diff(required, names(dcf)) + if (length(missing)) { + fmt <- "required fields %s missing from DESCRIPTION at path '%s'" + stopf(fmt, paste(shQuote(missing), collapse = ", "), path %||% "") + } + + # if this is a standard remote for a bioconductor package, + # remove the other remote fields + bioc <- + !is.null(dcf[["biocViews"]]) && + identical(dcf[["RemoteType"]], "standard") + + if (bioc) { + fields <- grep("^Remote(?!s)", names(dcf), perl = TRUE, invert = TRUE) + dcf <- dcf[fields] + } + + # generate a hash if we can + dcf[["Hash"]] <- if (the$auto_snapshot_hash) { + if (is.null(path)) + renv_hash_description_impl(dcf) + else + renv_hash_description(path) + } + + # generate a Requirements field -- primarily for use by 'pak' + fields <- c("Depends", "Imports", "LinkingTo") + deps <- bind(map(dcf[fields], renv_description_parse_field)) + all <- unique(csort(unlist(deps$Package))) + dcf[["Requirements"]] <- all + + # get remotes fields + remotes <- local({ + + # if this seems to be a cran-like record, only keep remotes + # when RemoteSha appears to be a hash (e.g. for r-universe) + # note that RemoteSha may be a package version when installed + # by e.g. pak + if (renv_record_cranlike(dcf)) { + sha <- dcf[["RemoteSha"]] + if (is.null(sha) || nchar(sha) < 40L) + return(character()) + } + + # grab the relevant remotes + git <- grep("^git", names(dcf), value = TRUE) + remotes <- grep("^Remote(?!s)", names(dcf), perl = TRUE, value = TRUE) + + # don't include 'RemoteRef' if it's a non-informative remote + if (identical(dcf[["RemoteRef"]], "HEAD")) + remotes <- setdiff(remotes, "RemoteRef") + + c(git, remotes) + + }) + + # only keep relevant fields + extra <- c("Repository", "OS_type") + all <- c(required, extra, remotes, "Requirements", "Hash") + keep <- renv_vector_intersect(all, names(dcf)) + + # return as list + as.list(dcf[keep]) + +} + +renv_snapshot_description_impl_v2 <- function(dcf, path) { + # figure out the package source source <- renv_snapshot_description_source(dcf) dcf[names(source)] <- source @@ -768,27 +854,6 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { renv_hash_description(path) } - # keep only required fields if requested - minimal <- getOption("renv.lockfile.minimal", default = FALSE) - if (minimal) { - - # generate a Requirements field -- primarily for use by 'pak' - fields <- c("Depends", "Imports", "LinkingTo") - deps <- bind(map(dcf[fields], renv_description_parse_field)) - all <- unique(csort(unlist(deps$Package))) - dcf[["Requirements"]] <- all - - # keep any existing remotes fields - remotes <- grep("^Remote", names(dcf), perl = TRUE, value = TRUE) - - # only keep relevant fields - extra <- c("Repository", "OS_type") - all <- c(required, extra, remotes, "Requirements", "Hash") - keep <- renv_vector_intersect(all, names(dcf)) - dcf <- dcf[keep] - - } - # reorganize fields a bit dcf <- dcf[c(required, setdiff(names(dcf), required))] diff --git a/R/zzz.R b/R/zzz.R index 1c2284d93..387bd8cb8 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -113,8 +113,7 @@ # NOTE: required for devtools::load_all() .onDetach <- function(libpath) { - package <- Sys.getenv("DEVTOOLS_LOAD", unset = NA) - if (identical(package, .packageName)) + if (devmode()) .onUnload(libpath) } @@ -122,7 +121,7 @@ renv_zzz_run <- function() { # check if we're in pkgload::load_all() # if so, then create some files - if (renv_envvar_exists("DEVTOOLS_LOAD")) { + if (devmode()) { renv_zzz_bootstrap_activate() renv_zzz_bootstrap_config() } diff --git a/tests/testthat/_snaps/snapshot.md b/tests/testthat/_snaps/snapshot.md index e3d2f3b21..20821d052 100644 --- a/tests/testthat/_snaps/snapshot.md +++ b/tests/testthat/_snaps/snapshot.md @@ -226,7 +226,7 @@ - The lockfile is already up to date. -# we can produce old-style lockfiles if requested +# lockfiles are stable (v1) Code . <- writeLines(readLines("renv.lock")) @@ -280,3 +280,79 @@ } } +# lockfiles are stable (v2) + + Code + . <- writeLines(readLines("renv.lock")) + Output + { + "R": { + "Version": "", + "Repositories": [ + { + "Name": "CRAN", + "URL": "" + } + ] + }, + "Packages": { + "bread": { + "Package": "bread", + "Version": "1.0.0", + "Source": "Repository", + "Type": "Package", + "Repository": "CRAN", + "License": "GPL", + "Description": "renv test package", + "Title": "renv test package", + "Author": "Anonymous Person ", + "Maintainer": "Anonymous Person ", + "Config/Needs/protein": "egg", + "Hash": "3d2aa8db4086921058b23ce646e01c7a" + }, + "breakfast": { + "Package": "breakfast", + "Version": "1.0.0", + "Source": "Repository", + "Type": "Package", + "Depends": "oatmeal, toast (>= 1.0.0)", + "Suggests": "egg", + "Repository": "CRAN", + "License": "GPL", + "Description": "renv test package", + "Title": "renv test package", + "Author": "Anonymous Person ", + "Maintainer": "Anonymous Person ", + "Config/Needs/protein": "egg", + "Hash": "0fcd2a795901b4b21326a3e35442c97c" + }, + "oatmeal": { + "Package": "oatmeal", + "Version": "1.0.0", + "Source": "Repository", + "Type": "Package", + "Repository": "CRAN", + "License": "GPL", + "Description": "renv test package", + "Title": "renv test package", + "Author": "Anonymous Person ", + "Maintainer": "Anonymous Person ", + "Hash": "1997110c04a1a14551dc791abb7cf8cf" + }, + "toast": { + "Package": "toast", + "Version": "1.0.0", + "Source": "Repository", + "Depends": "bread", + "Type": "Package", + "Repository": "CRAN", + "License": "GPL", + "Description": "renv test package", + "Title": "renv test package", + "Author": "Anonymous Person ", + "Maintainer": "Anonymous Person ", + "Hash": "d2f51ee89552a4668cbe9fc25b1f7c1e" + } + } + } + diff --git a/tests/testthat/test-snapshot.R b/tests/testthat/test-snapshot.R index 9ae97af71..307bff96e 100644 --- a/tests/testthat/test-snapshot.R +++ b/tests/testthat/test-snapshot.R @@ -630,13 +630,24 @@ test_that("a package's hash can be re-generated from lockfile", { }) -test_that("we can produce old-style lockfiles if requested", { +test_that("lockfiles are stable (v1)", { - skip_on_cran() - renv_scope_options(renv.lockfile.minimal = TRUE) + renv_scope_options(renv.lockfile.version = 1L) project <- renv_tests_scope("breakfast") init() + + expect_snapshot(. <- writeLines(readLines("renv.lock"))) + +}) + +test_that("lockfiles are stable (v2)", { + + renv_scope_options(renv.lockfile.version = 2L) + + project <- renv_tests_scope("breakfast") + init() + expect_snapshot(. <- writeLines(readLines("renv.lock"))) }) From 83eac3f511c03ecafc002d1655b9eed1040f4cbb Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Wed, 18 Dec 2024 14:54:37 -0800 Subject: [PATCH 10/16] compute hash records on demand instead of storing in lockfile --- R/hash.R | 13 ++++++------- R/lockfile-read.R | 25 ++++++++++++++++++++++--- R/snapshot.R | 10 +--------- tests/testthat/_snaps/snapshot.md | 12 ++++-------- tests/testthat/test-snapshot.R | 9 +++++---- 5 files changed, 38 insertions(+), 31 deletions(-) diff --git a/R/hash.R b/R/hash.R index 04bc616b3..f6b491f75 100644 --- a/R/hash.R +++ b/R/hash.R @@ -50,18 +50,17 @@ renv_hash_description <- function(path) { } renv_hash_description_impl <- function(path) { + record <- renv_description_read(path) + renv_hash_record(record) +} - dcf <- case( - is.character(path) ~ renv_description_read(path), - is.list(path) ~ path, - ~ stop("unexpected path '%s'", path) - ) +renv_hash_record <- function(record) { # find relevant fields for hashing - fields <- renv_hash_fields(dcf) + fields <- renv_hash_fields(record) # retrieve these fields - subsetted <- dcf[renv_vector_intersect(fields, names(dcf))] + subsetted <- record[renv_vector_intersect(fields, names(record))] # sort names (use C locale to ensure consistent ordering) ordered <- subsetted[csort(names(subsetted))] diff --git a/R/lockfile-read.R b/R/lockfile-read.R index 16bb75f70..469961e87 100644 --- a/R/lockfile-read.R +++ b/R/lockfile-read.R @@ -33,9 +33,28 @@ renv_lockfile_read_finish_impl <- function(key, val) { } renv_lockfile_read_finish <- function(data) { - data <- enumerate(data, renv_lockfile_read_finish_impl) - class(data) <- "renv_lockfile" - data + + # create lockfile + lockfile <- enumerate(data, renv_lockfile_read_finish_impl) + class(lockfile) <- "renv_lockfile" + + # compute hashes for records if possible + renv_lockfile_records(lockfile) <- + renv_lockfile_records(lockfile) %>% + map(function(record) { + + record$Hash <- record$Hash %||% { + fields <- renv_hash_fields_remotes(record) + if (all(names(record) %in% fields)) + renv_hash_record(record) + } + + record + + }) + + # return lockfile + lockfile } renv_lockfile_read_preflight <- function(contents) { diff --git a/R/snapshot.R b/R/snapshot.R index a0d65e91b..41841eb67 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -756,7 +756,7 @@ renv_snapshot_description_impl_v1 <- function(dcf, path = NULL) { # generate a hash if we can dcf[["Hash"]] <- if (the$auto_snapshot_hash) { if (is.null(path)) - renv_hash_description_impl(dcf) + renv_hash_record(dcf) else renv_hash_description(path) } @@ -846,14 +846,6 @@ renv_snapshot_description_impl_v2 <- function(dcf, path) { github <- grepl("^Github", names(dcf), perl = TRUE) dcf <- dcf[!github] - # generate a hash if we can - dcf[["Hash"]] <- if (the$auto_snapshot_hash) { - if (is.null(path)) - renv_hash_description_impl(dcf) - else - renv_hash_description(path) - } - # reorganize fields a bit dcf <- dcf[c(required, setdiff(names(dcf), required))] diff --git a/tests/testthat/_snaps/snapshot.md b/tests/testthat/_snaps/snapshot.md index 20821d052..7400c0f7e 100644 --- a/tests/testthat/_snaps/snapshot.md +++ b/tests/testthat/_snaps/snapshot.md @@ -307,8 +307,7 @@ "Title": "renv test package", "Author": "Anonymous Person ", "Maintainer": "Anonymous Person ", - "Config/Needs/protein": "egg", - "Hash": "3d2aa8db4086921058b23ce646e01c7a" + "Config/Needs/protein": "egg" }, "breakfast": { "Package": "breakfast", @@ -323,8 +322,7 @@ "Title": "renv test package", "Author": "Anonymous Person ", "Maintainer": "Anonymous Person ", - "Config/Needs/protein": "egg", - "Hash": "0fcd2a795901b4b21326a3e35442c97c" + "Config/Needs/protein": "egg" }, "oatmeal": { "Package": "oatmeal", @@ -336,8 +334,7 @@ "Description": "renv test package", "Title": "renv test package", "Author": "Anonymous Person ", - "Maintainer": "Anonymous Person ", - "Hash": "1997110c04a1a14551dc791abb7cf8cf" + "Maintainer": "Anonymous Person " }, "toast": { "Package": "toast", @@ -350,8 +347,7 @@ "Description": "renv test package", "Title": "renv test package", "Author": "Anonymous Person ", - "Maintainer": "Anonymous Person ", - "Hash": "d2f51ee89552a4668cbe9fc25b1f7c1e" + "Maintainer": "Anonymous Person " } } } diff --git a/tests/testthat/test-snapshot.R b/tests/testthat/test-snapshot.R index 307bff96e..f42ff5ed0 100644 --- a/tests/testthat/test-snapshot.R +++ b/tests/testthat/test-snapshot.R @@ -400,7 +400,7 @@ test_that("packages installed from CRAN using pak are handled", { quietly(pak$pkg_install("toast")) record <- renv_snapshot_description(package = "toast") - expected <- c("Package", "Version", "Source", "Repository", "Hash") + expected <- c("Package", "Version", "Source", "Repository") expect_contains(names(record), expected) expect_identical(record$Source, "Repository") @@ -622,9 +622,10 @@ test_that("a package's hash can be re-generated from lockfile", { lockfile <- snapshot(lockfile = NULL) records <- renv_lockfile_records(lockfile) - map(records, function(record) { - actual <- record[["Hash"]] - expected <- renv_hash_description_impl(record) + enumerate(records, function(package, record) { + path <- system.file("DESCRIPTION", package = package) + actual <- renv_hash_description(path) + expected <- renv_hash_record(record) expect_equal(actual, expected) }) From 96b22e37a7f6d698922bcc219a7721a7ed0e10e1 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 19 Dec 2024 22:49:42 +0000 Subject: [PATCH 11/16] fixes for windows --- R/bootstrap.R | 3 +++ R/files.R | 11 ++--------- tests/testthat/helper-snapshot.R | 1 + 3 files changed, 6 insertions(+), 9 deletions(-) diff --git a/R/bootstrap.R b/R/bootstrap.R index 6ea44564c..dfe9c650d 100644 --- a/R/bootstrap.R +++ b/R/bootstrap.R @@ -400,6 +400,9 @@ renv_bootstrap_download_github <- function(version) { # prepare download options token <- renv_bootstrap_github_token() + if (is.null(token)) + token <- "" + if (nzchar(Sys.which("curl")) && nzchar(token)) { fmt <- "--location --fail --header \"Authorization: token %s\"" extra <- sprintf(fmt, token) diff --git a/R/files.R b/R/files.R index 028e51f70..c158016ab 100644 --- a/R/files.R +++ b/R/files.R @@ -577,15 +577,8 @@ renv_file_broken_unix <- function(paths) { } renv_file_broken_win32 <- function(paths) { - # TODO: the behavior of file.exists() for a broken junction point - # appears to have changed in the development version of R; - # we have to be extra careful here... - if (getRversion() < "4.2.0") { - info <- renv_file_info(paths) - (info$isdir %in% TRUE) & is.na(info$mtime) - } else { - file.access(paths, mode = 0L) == 0L & !file.exists(paths) - } + info <- renv_file_info(paths) + (info$isdir %in% TRUE) & is.na(info$mtime) } renv_file_size <- function(path) { diff --git a/tests/testthat/helper-snapshot.R b/tests/testthat/helper-snapshot.R index 37c1f7a27..6494f33bb 100644 --- a/tests/testthat/helper-snapshot.R +++ b/tests/testthat/helper-snapshot.R @@ -34,6 +34,7 @@ strip_dirs <- function(x) { "" = getOption("repos")[[1L]], "" = gsub(prefix, "", getOption("repos")[[1L]]), "" = renv_path_normalize(renv_paths_root()), + "" = renv_path_aliased(getwd()), "" = renv_path_normalize(getwd()), "" = renv_path_normalize(tempdir()), "" = basename(getwd()) From 6d444b619b91e2c32aa931a99e69337ffce6e653 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 19 Dec 2024 23:32:02 +0000 Subject: [PATCH 12/16] try alternate test for windows --- R/backports.R | 22 ++++++++++++++++------ R/files.R | 19 +++++++++++++++++-- inst/resources/activate.R | 3 +++ 3 files changed, 36 insertions(+), 8 deletions(-) diff --git a/R/backports.R b/R/backports.R index cb6f6b4c3..54cce4989 100644 --- a/R/backports.R +++ b/R/backports.R @@ -1,11 +1,11 @@ -if (is.null(.BaseNamespaceEnv$startsWith)) { - - startsWith <- function(x, prefix) { - pattern <- sprintf("^\\Q%s\\E", prefix) - grepl(pattern, x, perl = TRUE) +if (is.null(.BaseNamespaceEnv$dir.exists)) { + + dir.exists <- function(paths) { + info <- suppressWarnings(file.info(paths, extra_cols = FALSE)) + info$isdir %in% TRUE } - + } if (is.null(.BaseNamespaceEnv$lengths)) { @@ -15,3 +15,13 @@ if (is.null(.BaseNamespaceEnv$lengths)) { } } + +if (is.null(.BaseNamespaceEnv$startsWith)) { + + startsWith <- function(x, prefix) { + pattern <- sprintf("^\\Q%s\\E", prefix) + grepl(pattern, x, perl = TRUE) + } + +} + diff --git a/R/files.R b/R/files.R index c158016ab..98389361d 100644 --- a/R/files.R +++ b/R/files.R @@ -576,9 +576,24 @@ renv_file_broken_unix <- function(paths) { !is.na(Sys.readlink(paths)) & !file.exists(paths) } +# unfortunately, as far as I know, there isn't a more reliable +# way of detecting broken junction points on Windows using vanilla R renv_file_broken_win32 <- function(paths) { - info <- renv_file_info(paths) - (info$isdir %in% TRUE) & is.na(info$mtime) + + owd <- getwd() + on.exit(setwd(owd), add = TRUE) + + broken <- rep.int(FALSE, length(paths)) + for (i in seq_along(paths)) { + if (dir.exists(paths[[i]])) { + broken[[i]] <- tryCatch( + !nzchar(setwd(paths[[i]])), + error = function(cnd) TRUE + ) + } + } + broken + } renv_file_size <- function(path) { diff --git a/inst/resources/activate.R b/inst/resources/activate.R index 248371ce7..f8a46f82e 100644 --- a/inst/resources/activate.R +++ b/inst/resources/activate.R @@ -559,6 +559,9 @@ local({ # prepare download options token <- renv_bootstrap_github_token() + if (is.null(token)) + token <- "" + if (nzchar(Sys.which("curl")) && nzchar(token)) { fmt <- "--location --fail --header \"Authorization: token %s\"" extra <- sprintf(fmt, token) From a3ae93b587c1c11066811b65d0d4e0b6c7a25823 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 19 Dec 2024 16:11:07 -0800 Subject: [PATCH 13/16] try once more --- R/files.R | 16 +--------------- 1 file changed, 1 insertion(+), 15 deletions(-) diff --git a/R/files.R b/R/files.R index 98389361d..7141eb12b 100644 --- a/R/files.R +++ b/R/files.R @@ -579,21 +579,7 @@ renv_file_broken_unix <- function(paths) { # unfortunately, as far as I know, there isn't a more reliable # way of detecting broken junction points on Windows using vanilla R renv_file_broken_win32 <- function(paths) { - - owd <- getwd() - on.exit(setwd(owd), add = TRUE) - - broken <- rep.int(FALSE, length(paths)) - for (i in seq_along(paths)) { - if (dir.exists(paths[[i]])) { - broken[[i]] <- tryCatch( - !nzchar(setwd(paths[[i]])), - error = function(cnd) TRUE - ) - } - } - broken - + !map_lgl(paths, Sys.setFileTime, Sys.time()) } renv_file_size <- function(path) { From 1a558d58aa24dcafa822233baee115df132dacdc Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 19 Dec 2024 16:30:03 -0800 Subject: [PATCH 14/16] one more attempt? --- R/files.R | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/R/files.R b/R/files.R index 7141eb12b..d6fb0a3e4 100644 --- a/R/files.R +++ b/R/files.R @@ -579,7 +579,10 @@ renv_file_broken_unix <- function(paths) { # unfortunately, as far as I know, there isn't a more reliable # way of detecting broken junction points on Windows using vanilla R renv_file_broken_win32 <- function(paths) { - !map_lgl(paths, Sys.setFileTime, Sys.time()) + time <- Sys.time() + map_lgl(paths, function(path) { + dir.exists(path) && !Sys.setFileTime(path, time) + }) } renv_file_size <- function(path) { From 8fb4fa67e797be96d91f45e2684783b7daffd5c3 Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Thu, 19 Dec 2024 16:53:08 -0800 Subject: [PATCH 15/16] it works on my machine (tm) --- R/files.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/files.R b/R/files.R index d6fb0a3e4..09a6d94ce 100644 --- a/R/files.R +++ b/R/files.R @@ -581,7 +581,7 @@ renv_file_broken_unix <- function(paths) { renv_file_broken_win32 <- function(paths) { time <- Sys.time() map_lgl(paths, function(path) { - dir.exists(path) && !Sys.setFileTime(path, time) + file.access(path) == 0L && !Sys.setFileTime(path, time) }) } From fe37752273cad4590e9703e8654523ba87c03e5c Mon Sep 17 00:00:00 2001 From: Kevin Ushey Date: Fri, 20 Dec 2024 10:11:10 -0800 Subject: [PATCH 16/16] also explicitly test file --- tests/testthat/test-files.R | 1 + 1 file changed, 1 insertion(+) diff --git a/tests/testthat/test-files.R b/tests/testthat/test-files.R index d576012a6..c710ba5d0 100644 --- a/tests/testthat/test-files.R +++ b/tests/testthat/test-files.R @@ -176,6 +176,7 @@ test_that("renv can detect broken junctions / symlinks", { if (renv_platform_windows()) { + file.create("file") dir.create("dir") dir.create("nowhere") Sys.junction("dir", "junction")