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/aaa.R b/R/aaa.R index fc6664fd0..b641c6487 100644 --- a/R/aaa.R +++ b/R/aaa.R @@ -42,3 +42,7 @@ testing <- function() { devel <- function() { identical(R.version[["status"]], "Under development (unstable)") } + +devmode <- function() { + Sys.getenv("DEVTOOLS_LOAD") == .packageName +} 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/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..09a6d94ce 100644 --- a/R/files.R +++ b/R/files.R @@ -576,16 +576,13 @@ 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) { - # 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) - } + time <- Sys.time() + map_lgl(paths, function(path) { + file.access(path) == 0L && !Sys.setFileTime(path, time) + }) } renv_file_size <- function(path) { diff --git a/R/hash.R b/R/hash.R index a20f6a31f..f6b491f75 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", 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", @@ -12,24 +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) - ) - - # include default fields - fields <- c( - "Package", "Version", "Title", "Author", "Maintainer", "Description", - "Depends", "Imports", "Suggests", "LinkingTo" - ) +renv_hash_record <- function(record) { - # add remotes fields - remotes <- renv_hash_description_remotes(dcf) + # find relevant fields for hashing + fields <- renv_hash_fields(record) # retrieve these fields - subsetted <- dcf[renv_vector_intersect(c(fields, remotes), names(dcf))] + subsetted <- record[renv_vector_intersect(fields, names(record))] # sort names (use C locale to ensure consistent ordering) ordered <- subsetted[csort(names(subsetted))] @@ -71,14 +102,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-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/lockfile-write.R b/R/lockfile-write.R index 0310c35ca..24be204fb 100644 --- a/R/lockfile-write.R +++ b/R/lockfile-write.R @@ -90,8 +90,9 @@ renv_lockfile_write_json <- function(lockfile, file = stdout()) { prepared <- enumerate(lockfile, renv_lockfile_write_json_prepare) - box <- c("Depends", "Imports", "Suggests", "LinkingTo", "Requirements") + box <- c("Requirements") config <- list(box = box) + json <- renv_json_convert(prepared, config) 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..41841eb67 100644 --- a/R/snapshot.R +++ b/R/snapshot.R @@ -718,10 +718,22 @@ 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)) @@ -729,66 +741,116 @@ renv_snapshot_description_impl <- function(dcf, path = NULL) { 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) + renv_hash_record(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 <- renv_snapshot_description_impl_remotes(dcf) - + 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_remotes <- function(dcf) { +renv_snapshot_description_impl_v2 <- function(dcf, path) { + + # figure out the package source + source <- renv_snapshot_description_source(dcf) + dcf[names(source)] <- source - # 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()) + # 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 %||% "") } - # grab the relevant remotes - git <- grep("^git", names(dcf), value = TRUE) - remotes <- grep("^Remote(?!s)", names(dcf), perl = TRUE, value = TRUE) + # if this is a standard remote for a bioconductor package, + # remove the other remote fields + bioc <- + !is.null(dcf[["biocViews"]]) && + identical(dcf[["RemoteType"]], "standard") - # don't include 'RemoteRef' if it's a non-informative remote - if (identical(dcf[["RemoteRef"]], "HEAD")) - remotes <- setdiff(remotes, "RemoteRef") + if (bioc) { + fields <- grep("^Remote(?!s)", names(dcf), perl = TRUE, invert = TRUE) + dcf <- dcf[fields] + } - c(git, remotes) + # 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("Archs", "Built", "Date/Publication", "File", "MD5sum", "Packaged") + 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 + } + } + + # drop the old Github remote fields + github <- grepl("^Github", names(dcf), perl = TRUE) + dcf <- dcf[!github] + + # reorganize fields a bit + dcf <- dcf[c(required, setdiff(names(dcf), required))] + + # return as list + as.list(dcf) } @@ -840,7 +902,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..387bd8cb8 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() @@ -108,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) } @@ -117,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/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) diff --git a/tests/testthat/_snaps/snapshot.md b/tests/testthat/_snaps/snapshot.md index e3d2f3b21..7400c0f7e 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,75 @@ } } +# 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" + }, + "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" + }, + "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 " + }, + "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 " + } + } + } + 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()) 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-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") 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 082286f2f..f42ff5ed0 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") + expect_contains(names(record), expected) expect_identical(record$Source, "Repository") expect_identical(record$Repository, "CRAN") @@ -616,11 +614,37 @@ test_that("standard remotes drop RemoteSha if it's a version", { }) -test_that("we can produce old-style lockfiles if requested", { +test_that("a package's hash can be re-generated from lockfile", { - skip_on_cran() + project <- renv_tests_scope("breakfast") + init() + + lockfile <- snapshot(lockfile = NULL) + records <- renv_lockfile_records(lockfile) + + 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) + }) + +}) + +test_that("lockfiles are stable (v1)", { + + 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.minimal = TRUE) + renv_scope_options(renv.lockfile.version = 2L) project <- renv_tests_scope("breakfast") init() 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()