# 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()) { # only run if interactive, or if testing ok <- interactive() || testthat::is_testing() if (!ok) return() # make sure this only runs once if (!once()) return() # force gitcreds to initialize early renv_download_auth_github() # 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 <- ensure_directory(renv_scope_tempfile(scope = scope)) 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_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.config.user.library = FALSE, renv.config.sandbox.enabled = TRUE, renv.consent = TRUE, restart = NULL, renv.config.install.transactional = FALSE, renv.tests.running = TRUE, 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()) { # 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) renv_scope_wd(target) # 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" 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", latestOnly = FALSE ) # return path to on-disk repository repopath }