avoid using global sandbox when other packages running tests (#1645)

* avoid using global sandbox when other packages running tests

* naming

R/aaa.R

@@ -7,3 +7,18 @@ building <- function() {
   nzchar(Sys.getenv("R_CMD")) &&
     grepl("Rbuild", basename(dirname(getwd())), fixed = TRUE)
 }
+
+# are we running code within R CMD check?
+checking <- function() {
+  "CheckExEnv" %in% search() ||
+    renv_envvar_exists("_R_CHECK_PACKAGE_NAME_") ||
+    renv_envvar_exists("_R_CHECK_SIZE_OF_TARBALL_")
+}
+
+# NOTE: Prefer using 'testing()' to 'renv_tests_running()' for behavior
+# that should apply regardless of the package currently being tested.
+#
+# 'renv_tests_running()' is appropriate when running renv's own tests.
+testing <- function() {
+  identical(Sys.getenv("TESTTHAT"), "true")
+}

R/activate.R

@@ -164,7 +164,7 @@ renv_activate_prompt <- function(action, library, prompt, project) {
     interactive() &&
     is.null(library) &&
     !renv_project_loaded(project) &&
-    !is_testing()
+    !testing()
 
   # for snapshot, since users might want to snapshot their system library
   # in an renv-lite configuration, only prompt if it looks like they're

R/difftime.R

@@ -1,7 +1,7 @@
 
 renv_difftime_format <- function(time, digits = 2L) {
 
-  if (is_testing())
+  if (testing())
     return("XXXX seconds")
 
   units <- attr(time, "units") %||% ""
@@ -30,7 +30,7 @@ renv_difftime_format <- function(time, digits = 2L) {
 
 renv_difftime_format_short <- function(time, digits = 2L) {
 
-  if (is_testing())
+  if (testing())
     return("XXs")
 
   units <- attr(time, "units") %||% ""

R/download.R

@@ -667,7 +667,7 @@ renv_download_report <- function(elapsed, file) {
     return()
 
   info <- renv_file_info(file)
-  size <- if (is_testing())
+  size <- if (testing())
     "XXXX bytes"
   else
     structure(info$size, class = "object_size")

R/load.R

@@ -622,7 +622,7 @@ renv_load_bioconductor_validate <- function(project, version) {
 renv_load_switch <- function(project) {
 
   # skip when testing
-  if (is_testing())
+  if (testing())
     return(project)
 
   # safety check: avoid recursive unload attempts

R/package.R

@@ -400,13 +400,6 @@ renv_package_built <- function(path) {
 
 }
 
-renv_package_checking <- function() {
-  is_testing() ||
-    "CheckExEnv" %in% search() ||
-    renv_envvar_exists("_R_CHECK_PACKAGE_NAME_") ||
-    renv_envvar_exists("_R_CHECK_SIZE_OF_TARBALL_")
-}
-
 renv_package_unpack <- function(package, path, subdir = "", force = FALSE) {
 
   # if this isn't an archive, nothing to do

R/patch.R

@@ -161,7 +161,7 @@ renv_patch_repos <- function() {
     return()
 
   # nothing to do if we're not running tests
-  checking <- renv_package_checking()
+  checking <- checking()
   if (!checking)
     return()
 

R/paths.R

@@ -191,7 +191,7 @@ renv_paths_root_default <- function() {
     # use tempdir for cache when running tests
     # this check is necessary here to support packages which might use renv
     # during testing (and we don't want those to try to use the user dir)
-    checking <- renv_package_checking()
+    checking <- checking()
 
     # compute the root directory
     if (checking)

R/ppm.R

@@ -252,7 +252,7 @@ renv_ppm_enabled <- function() {
 
   # TODO: can we remove this check?
   # https://github.com/rstudio/renv/issues/1132
-  if (!is_testing()) {
+  if (!testing()) {
 
     disabled <-
       renv_platform_linux() &&

R/report.R

@@ -2,7 +2,7 @@
 renv_report_ok <- function(message, elapsed = 0) {
 
   # treat 'quick' times specially
-  if (!is_testing() && elapsed < 0.1)
+  if (!testing() && elapsed < 0.1)
     return(writef("OK [%s]", message))
 
   # otherwise, report step with elapsed time

R/sandbox.R

@@ -4,7 +4,7 @@ renv_sandbox_init <- function() {
   # check for envvar override
   enabled <- Sys.getenv("RENV_SANDBOX_LOCKING_ENABLED", unset = NA)
   if (!is.na(enabled)) {
-    enabled <- truthy(enabled, default = TRUE)
+    enabled <- truthy(enabled, default = FALSE)
     options(renv.sandbox.locking_enabled = enabled)
   }
 

R/snapshot.R

@@ -329,7 +329,7 @@ renv_snapshot_validate_report <- function(valid, prompt, force) {
 
   # in interactive sessions, if 'prompt' is set, then ask the user
   # if they would like to proceed
-  if (interactive() && !is_testing() && prompt) {
+  if (interactive() && !testing() && prompt) {
     cancel_if(!proceed())
     return(TRUE)
   }

R/tests.R

@@ -1,7 +1,7 @@
 
 the$tests_root <- NULL
 
-# NOTE: Prefer using 'is_testing()' to 'renv_tests_running()' for behavior
+# NOTE: Prefer using 'testing()' to 'renv_tests_running()' for behavior
 # that should apply regardless of the package currently being tested.
 #
 # renv_tests_running() is appropriate when running renv's own tests.

R/utils.R

@@ -169,7 +169,7 @@ menu <- function(choices, title, default = 1L) {
   if (length(testing)) {
     selected <- testing[[1]]
     options(renv.menu.choice = testing[-1])
-  } else if (is_testing()) {
+  } else if (testing()) {
     selected <- default
   } else {
     selected <- NULL
@@ -507,7 +507,7 @@ take <- function(data, index = NULL) {
 cancel <- function() {
 
   renv_snapshot_auto_suppress_next()
-  if (is_testing())
+  if (testing())
     stop("Operation canceled", call. = FALSE)
 
   message("- Operation canceled.")

R/verbose.R

@@ -9,17 +9,9 @@ renv_verbose <- function() {
   if (!is.na(verbose))
     return(as.logical(verbose))
 
-  if (is_testing())
+  if (testing())
     return(FALSE)
 
   interactive() || !renv_tests_running()
 
 }
-
-# NOTE: Prefer using 'is_testing()' to 'renv_tests_running()' for behavior
-# that should apply regardless of the package currently being tested.
-#
-# renv_tests_running() is appropriate when running renv's own tests.
-is_testing <- function() {
-  identical(Sys.getenv("TESTTHAT"), "true")
-}

R/watchdog.R

@@ -43,7 +43,7 @@ renv_watchdog_enabled_impl <- function() {
 
   # skip during R CMD check (but not when running tests)
   checking <- renv_envvar_exists("_R_CHECK_PACKAGE_NAME_")
-  if (checking && !is_testing())
+  if (checking && !testing())
     return(FALSE)
 
   # skip during R CMD build or R CMD INSTALL

R/zzz.R

@@ -38,6 +38,13 @@ renv_zzz_load <- function() {
   # NOTE: needs to be visible to embedded instances of renv as well
   the$envir_self <<- renv_envir_self()
 
+  # make sure renv (and packages using renv!!!) use tempdir for storage
+  # when running tests, or R CMD check
+  if (checking() || testing()) {
+    Sys.setenv(RENV_PATHS_ROOT = tempfile("renv-root-"))
+    options(renv.sandbox.locking_enabled = FALSE)
+  }
+
   renv_metadata_init()
   renv_platform_init()
   renv_virtualization_init()
@@ -195,7 +202,7 @@ renv_zzz_bootstrap_config <- function() {
 renv_zzz_repos <- function() {
 
   # don't run if we're running tests
-  if (renv_package_checking())
+  if (checking())
     return()
 
   # prevent recursion

tests/testthat/test-index.R

@@ -62,6 +62,10 @@ test_that("a timeout of 0 forces index to be re-computed", {
 
 test_that("other processes can use the index", {
 
+  path <- renv_scope_tempfile("renv-index-")
+  ensure_directory(path)
+  renv_scope_envvars(RENV_PATHS_INDEX = path)
+
   key <- renv_id_generate()
 
   index(
@@ -76,7 +80,6 @@ test_that("other processes can use the index", {
   }, list(scope = scope, key = key, value = FALSE))
 
   output <- local({
-    renv_scope_envvars(RENV_PATHS_ROOT = renv_paths_root())
     renv_system_exec(
       command = R(),
       args    = c("--vanilla", "-s", "-f", shQuote(script)),