From f138a1faa80324c81f4506725a322bfee12b49d6 Mon Sep 17 00:00:00 2001 From: gnoblet Date: Tue, 1 Jul 2025 19:38:17 +0200 Subject: [PATCH] update renv version --- renv/activate.R | 227 +++++++++++++++++++++++++++--------------------- 1 file changed, 128 insertions(+), 99 deletions(-) diff --git a/renv/activate.R b/renv/activate.R index 0eb5108..90b251c 100644 --- a/renv/activate.R +++ b/renv/activate.R @@ -2,7 +2,7 @@ local({ # the requested version of renv - version <- "1.0.11" + version <- "1.1.4" attr(version, "sha") <- NULL # the project directory @@ -42,7 +42,7 @@ local({ return(FALSE) # next, check environment variables - # TODO: prefer using the configuration one in the future + # prefer using the configuration one in the future envvars <- c( "RENV_CONFIG_AUTOLOADER_ENABLED", "RENV_AUTOLOADER_ENABLED", @@ -135,12 +135,12 @@ local({ # R help links pattern <- "`\\?(renv::(?:[^`])+)`" - replacement <- "`\033]8;;ide:help:\\1\a?\\1\033]8;;\a`" + replacement <- "`\033]8;;x-r-help:\\1\a?\\1\033]8;;\a`" text <- gsub(pattern, replacement, text, perl = TRUE) # runnable code pattern <- "`(renv::(?:[^`])+)`" - replacement <- "`\033]8;;ide:run:\\1\a\\1\033]8;;\a`" + replacement <- "`\033]8;;x-r-run:\\1\a\\1\033]8;;\a`" text <- gsub(pattern, replacement, text, perl = TRUE) # return ansified text @@ -209,10 +209,6 @@ local({ } - startswith <- function(string, prefix) { - substring(string, 1, nchar(prefix)) == prefix - } - bootstrap <- function(version, library) { friendly <- renv_bootstrap_version_friendly(version) @@ -563,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) @@ -696,11 +695,19 @@ local({ } - renv_bootstrap_platform_prefix <- function() { + renv_bootstrap_platform_prefix_default <- function() { - # construct version prefix - version <- paste(R.version$major, R.version$minor, sep = ".") - prefix <- paste("R", numeric_version(version)[1, 1:2], sep = "-") + # read version component + version <- Sys.getenv("RENV_PATHS_VERSION", unset = "R-%v") + + # expand placeholders + placeholders <- list( + list("%v", format(getRversion()[1, 1:2])), + list("%V", format(getRversion()[1, 1:3])) + ) + + for (placeholder in placeholders) + version <- gsub(placeholder[[1L]], placeholder[[2L]], version, fixed = TRUE) # include SVN revision for development versions of R # (to avoid sharing platform-specific artefacts with released versions of R) @@ -709,10 +716,19 @@ local({ identical(R.version[["nickname"]], "Unsuffered Consequences") if (devel) - prefix <- paste(prefix, R.version[["svn rev"]], sep = "-r") + version <- paste(version, R.version[["svn rev"]], sep = "-r") + + version + + } + + renv_bootstrap_platform_prefix <- function() { + + # construct version prefix + version <- renv_bootstrap_platform_prefix_default() # build list of path components - components <- c(prefix, R.version$platform) + components <- c(version, R.version$platform) # include prefix if provided by user prefix <- renv_bootstrap_platform_prefix_impl() @@ -951,8 +967,14 @@ local({ } renv_bootstrap_validate_version_dev <- function(version, description) { + expected <- description[["RemoteSha"]] - is.character(expected) && startswith(expected, version) + if (!is.character(expected)) + return(FALSE) + + pattern <- sprintf("^\\Q%s\\E", version) + grepl(pattern, expected, perl = TRUE) + } renv_bootstrap_validate_version_release <- function(version, description) { @@ -1132,10 +1154,10 @@ local({ renv_bootstrap_exec <- function(project, libpath, version) { if (!renv_bootstrap_load(project, libpath, version)) - renv_bootstrap_run(version, libpath) + renv_bootstrap_run(project, libpath, version) } - renv_bootstrap_run <- function(version, libpath) { + renv_bootstrap_run <- function(project, libpath, version) { # perform bootstrap bootstrap(version, libpath) @@ -1146,7 +1168,7 @@ local({ # try again to load if (requireNamespace("renv", lib.loc = libpath, quietly = TRUE)) { - return(renv::load(project = getwd())) + return(renv::load(project = project)) } # failed to download or load renv; warn the user @@ -1192,98 +1214,105 @@ local({ jsonlite::fromJSON(txt = text, simplifyVector = FALSE) } + renv_json_read_patterns <- function() { + + list( + + # objects + list("{", "\t\n\tobject(\t\n\t", TRUE), + list("}", "\t\n\t)\t\n\t", TRUE), + + # arrays + list("[", "\t\n\tarray(\t\n\t", TRUE), + list("]", "\n\t\n)\n\t\n", TRUE), + + # maps + list(":", "\t\n\t=\t\n\t", TRUE), + + # newlines + list("\\u000a", "\n", FALSE) + + ) + + } + + renv_json_read_envir <- function() { + + envir <- new.env(parent = emptyenv()) + + envir[["+"]] <- `+` + envir[["-"]] <- `-` + + envir[["object"]] <- function(...) { + result <- list(...) + names(result) <- as.character(names(result)) + result + } + + envir[["array"]] <- list + + envir[["true"]] <- TRUE + envir[["false"]] <- FALSE + envir[["null"]] <- NULL + + envir + + } + + renv_json_read_remap <- function(object, patterns) { + + # repair names if necessary + if (!is.null(names(object))) { + + nms <- names(object) + for (pattern in patterns) + nms <- gsub(pattern[[2L]], pattern[[1L]], nms, fixed = TRUE) + names(object) <- nms + + } + + # repair strings if necessary + if (is.character(object)) { + for (pattern in patterns) + object <- gsub(pattern[[2L]], pattern[[1L]], object, fixed = TRUE) + } + + # recurse for other objects + if (is.recursive(object)) + for (i in seq_along(object)) + object[i] <- list(renv_json_read_remap(object[[i]], patterns)) + + # return remapped object + object + + } + renv_json_read_default <- function(file = NULL, text = NULL) { - # find strings in the JSON + # read json text text <- paste(text %||% readLines(file, warn = FALSE), collapse = "\n") - pattern <- '["](?:(?:\\\\.)|(?:[^"\\\\]))*?["]' - locs <- gregexpr(pattern, text, perl = TRUE)[[1]] - # if any are found, replace them with placeholders - replaced <- text - strings <- character() - replacements <- character() - - if (!identical(c(locs), -1L)) { - - # get the string values - starts <- locs - ends <- locs + attr(locs, "match.length") - 1L - strings <- substring(text, starts, ends) - - # only keep those requiring escaping - strings <- grep("[[\\]{}:]", strings, perl = TRUE, value = TRUE) - - # compute replacements - replacements <- sprintf('"\032%i\032"', seq_along(strings)) - - # replace the strings - mapply(function(string, replacement) { - replaced <<- sub(string, replacement, replaced, fixed = TRUE) - }, strings, replacements) - - } - - # transform the JSON into something the R parser understands - transformed <- replaced - transformed <- gsub("{}", "`names<-`(list(), character())", transformed, fixed = TRUE) - transformed <- gsub("[[{]", "list(", transformed, perl = TRUE) - transformed <- gsub("[]}]", ")", transformed, perl = TRUE) - transformed <- gsub(":", "=", transformed, fixed = TRUE) - text <- paste(transformed, collapse = "\n") + # convert into something the R parser will understand + patterns <- renv_json_read_patterns() + transformed <- text + for (pattern in patterns) + transformed <- gsub(pattern[[1L]], pattern[[2L]], transformed, fixed = TRUE) # parse it - json <- parse(text = text, keep.source = FALSE, srcfile = NULL)[[1L]] + rfile <- tempfile("renv-json-", fileext = ".R") + on.exit(unlink(rfile), add = TRUE) + writeLines(transformed, con = rfile) + json <- parse(rfile, keep.source = FALSE, srcfile = NULL)[[1L]] - # construct map between source strings, replaced strings - map <- as.character(parse(text = strings)) - names(map) <- as.character(parse(text = replacements)) + # evaluate in safe environment + result <- eval(json, envir = renv_json_read_envir()) - # convert to list - map <- as.list(map) - - # remap strings in object - remapped <- renv_json_read_remap(json, map) - - # evaluate - eval(remapped, envir = baseenv()) + # fix up strings if necessary -- do so only with reversible patterns + patterns <- Filter(function(pattern) pattern[[3L]], patterns) + renv_json_read_remap(result, patterns) } - renv_json_read_remap <- function(json, map) { - - # fix names - if (!is.null(names(json))) { - lhs <- match(names(json), names(map), nomatch = 0L) - rhs <- match(names(map), names(json), nomatch = 0L) - names(json)[rhs] <- map[lhs] - } - - # fix values - if (is.character(json)) - return(map[[json]] %||% json) - - # handle true, false, null - if (is.name(json)) { - text <- as.character(json) - if (text == "true") - return(TRUE) - else if (text == "false") - return(FALSE) - else if (text == "null") - return(NULL) - } - - # recurse - if (is.recursive(json)) { - for (i in seq_along(json)) { - json[i] <- list(renv_json_read_remap(json[[i]], map)) - } - } - - json - - } # load the renv profile, if any renv_bootstrap_profile_load(project)