# Code that needs to run once, before a suite of tests is run. # Here, "suite of tests" might also mean "a single test" interactively. renv_tests_setup <- function(scope = parent.frame()) { # make sure this only runs once if (!once()) return() # remove automatic tasks so we can capture explicitly in tests renv_task_unload() # cache path before working directory gets changed renv_tests_root() # make sure required packages are loaded # (not scoped to the environment since packages can't reliably be unloaded) renv_tests_setup_packages() # fix up the library paths if needed for testing renv_tests_setup_libpaths(scope = scope) # make sure we clean up sandbox on exit renv_tests_setup_sandbox(scope = scope) # initialize test repositories renv_tests_setup_repos(scope = scope) # scope relevant environment variables renv_tests_setup_envvars(scope = scope) renv_tests_setup_options(scope = scope) } renv_tests_setup_envvars <- function(scope = parent.frame()) { # set up root directory root <- renv_scope_tempfile("renv-root-", scope = scope) ensure_directory(root) # set up sandbox directory sandbox <- file.path(root, "sandbox") ensure_directory(sandbox) renv_scope_envvars( RENV_AUTOLOAD_ENABLED = FALSE, RENV_CONFIG_LOCKING_ENABLED = FALSE, RENV_DOWNLOAD_METHOD = NULL, RENV_PATHS_ROOT = root, RENV_PATHS_LIBRARY = NULL, RENV_PATHS_LIBRARY_ROOT = NULL, RENV_PATHS_LOCAL = NULL, RENV_PATHS_LOCKFILE = NULL, RENV_PATHS_RENV = NULL, RENV_PATHS_SANDBOX = sandbox, RENV_WATCHDOG_ENABLED = FALSE, RENV_WATCHDOG_DEBUG = FALSE, scope = scope ) envvars <- Sys.getenv() configvars <- grep("^RENV_CONFIG_", names(envvars), value = TRUE) renv_scope_envvars( list = rep_named(configvars, list(NULL)), scope = scope ) } renv_tests_setup_options <- function(scope = parent.frame()) { renv_scope_options( renv.bootstrap.quiet = TRUE, renv.caution.verbose = interactive(), renv.config.install.transactional = FALSE, renv.config.sandbox.enabled = TRUE, renv.config.user.library = FALSE, renv.consent = TRUE, renv.tests.running = TRUE, restart = NULL, scope = scope ) } # Force loading of packages from current .libPaths(); needed for packages # that would otherwise loaded in a renv_tests_scope() renv_tests_setup_packages <- function() { # load recursive dependencies of testthat deps <- renv_package_dependencies("testthat") for (dep in names(deps)) requireNamespace(dep, quietly = TRUE) # also load remotes requireNamespace("remotes", quietly = TRUE) # pak needs a little special handling if (renv_package_installed("pak")) { # set environment variables that influence pak usr <- file.path(tempdir(), "usr-cache") ensure_directory(file.path(usr, "R/renv")) pkg <- file.path(tempdir(), "pkg-cache") ensure_directory(pkg) renv_scope_envvars( R_USER_CACHE_DIR = usr, R_PKG_CACHE_DIR = pkg ) # load pak now requireNamespace("pak", quietly = TRUE) # trigger package load in pak subprocess # # TODO(Kevin): This fails for me with: # # Error in `source_file()`: # ! In path: "/Users/kevin/r/pkg/renv/tests/testthat/helper-zzz.R" # Caused by error in `pak$remote()`: # ! Subprocess is busy or cannot start tryCatch({ pak <- renv_namespace_load("pak") pak$remote(function() {}) }, error = function(e) { options(renv.pak.enabled = FALSE) }) } } renv_tests_setup_libpaths <- function(scope = parent.frame()) { # remove the sandbox from the library paths, just in case we tried # to run tests from an R session where the sandbox was active old <- .libPaths() new <- grep("renv/sandbox", old, fixed = TRUE, invert = TRUE, value = TRUE) renv_scope_libpaths(new, scope = scope) } renv_tests_setup_sandbox <- function(scope = parent.frame()) { renv_scope_options(renv.sandbox.locking_enabled = FALSE) defer(renv_sandbox_unlock(), scope = scope) } renv_tests_setup_repos <- function(scope = parent.frame()) { # use internal tar implementations here; on Windows, external is too slow # note the environment variable names are not case sensitive on Windows if (renv_platform_windows()) { renv_scope_envvars(TAR = "internal") } else { renv_scope_envvars(TAR = "internal", tar = "internal") } # also prefer using internal R copy method renv_scope_options(renv.config.copy.method = "r") # generate our dummy repository repopath <- renv_tests_repopath() if (file.exists(repopath)) return() # create repository source directory contrib <- file.path(repopath, "src/contrib") ensure_directory(contrib) # copy package stuff to tempdir (because we'll mutate them a bit) source <- renv_tests_path("packages") target <- renv_scope_tempfile("renv-packages-", scope = scope) renv_file_copy(source, target) if (!file.exists(target)) stopf("failed to copy '%s' to '%s'", source, target) renv_scope_wd(target) # update the local packrat package version to match what's available version <- tryCatch( renv_package_version("packrat") %||% "0.9.2", error = function(cnd) "0.9.2" ) dcf <- renv_dcf_read(file = "packrat/DESCRIPTION") dcf$Version <- version renv_dcf_write(dcf, file = "packrat/DESCRIPTION") # helper function for 'uploading' a package to our test repo upload <- function(path, root, subdir = FALSE) { # create package tarball desc <- renv_description_read(path) package <- basename(path) tarball <- sprintf("%s_%s.tar.gz", package, desc$Version) tar(tarball, package, compression = "gzip") # copy into repository tree components <- c(root, if (subdir) package, tarball) target <- paste(components, collapse = "/") ensure_parent_directory(target) renv_file_move(tarball, target, overwrite = TRUE) } # just in case? renv_scope_options(renv.config.filebacked.cache = FALSE) # copy in packages paths <- list.files(getwd(), full.names = TRUE) subdirs <- file.path(getRversion(), "Recommended") for (path in paths) { # upload the 'regular' package upload(path, contrib, subdir = FALSE) # upload a subdir (mocking what R does during upgrades) upload(path, file.path(contrib, subdirs), subdir = FALSE) # generate an 'old' version of the packages descpath <- file.path(path, "DESCRIPTION") desc <- renv_description_read(descpath) desc$Version <- "0.0.1" write.dcf(desc, file = descpath) # place packages at top level (simulating packages with multiple # versions at the top level of the repository) upload(path, contrib, subdir = FALSE) # generate an 'old' version of the packages descpath <- file.path(path, "DESCRIPTION") desc <- renv_description_read(descpath) desc$Version <- "0.1.0" desc$Depends <- gsub("99.99.99", "1.0.0", desc$Depends %||% "", fixed = TRUE) write.dcf(desc, file = descpath) # place these packages into the archive upload(path, file.path(contrib, "Archive"), subdir = TRUE) } # update PACKAGES metadata tools::write_PACKAGES( dir = contrib, subdirs = subdirs, type = "source", fields = "Remotes", latestOnly = FALSE ) # ── Binary packages ────────────────────────────────────────── # Build binary versions of all test packages so tests can # exercise the binary installation code path. # Skipped on Linux where .Platform$pkgType is "source". if (!identical(.Platform$pkgType, "source")) { # platform-appropriate binary contrib path bincontrib <- paste0(repopath, contrib.url("", type = "binary")) ensure_directory(bincontrib) # temporary library for building binary packages; # R CMD INSTALL --build installs into this library then packs # the result as a binary archive in the working directory tmplib <- renv_scope_tempfile("renv-binlib-", scope = scope) dir.create(tmplib) # ensure the temp library is on the search path so # R CMD INSTALL can resolve dependencies across builds renv_scope_envvars(R_LIBS = tmplib) # latest-version source tarballs (test packages are all 1.0.0) srcfiles <- list.files( contrib, pattern = "_1\\.0\\.0\\.tar\\.gz$", full.names = TRUE ) # build from bincontrib so binary output lands there directly owd <- setwd(bincontrib) # build in dependency order via retry: try each tarball, # retry failures until all succeed or no further progress remaining <- srcfiles while (length(remaining) > 0L) { built <- character() for (src in remaining) { status <- system2( file.path(R.home("bin"), "R"), args = c("CMD", "INSTALL", "--build", "-l", shQuote(tmplib), shQuote(src)), stdout = FALSE, stderr = FALSE ) if (identical(status, 0L)) built <- c(built, src) } if (length(built) == 0L) break remaining <- setdiff(remaining, built) } setwd(owd) # write PACKAGES index for the binary arm wptype <- if (renv_platform_windows()) "win.binary" else "mac.binary" tools::write_PACKAGES(bincontrib, type = wptype) } # return path to on-disk repository repopath }