From fcfe748225a88bf56b1964868604353c2e73bf7c Mon Sep 17 00:00:00 2001
From: Kevin Ushey <kevinushey@gmail.com>
Date: Thu, 22 Aug 2024 12:06:30 -0400
Subject: [PATCH] fix checkout tests

---
 R/checkout.R                   | 24 ++++++++++++++++++------
 R/zzz.R                        |  9 +++++++++
 man/install.Rd                 |  2 +-
 man/restore.Rd                 |  2 +-
 tests/testthat/helper-scope.R  |  5 +++++
 tests/testthat/test-checkout.R |  4 +++-
 6 files changed, 37 insertions(+), 9 deletions(-)

diff --git a/R/checkout.R b/R/checkout.R
index 2db7f31c0..17393c770 100644
--- a/R/checkout.R
+++ b/R/checkout.R
@@ -111,16 +111,28 @@ checkout <- function(repos = NULL,
     restore(lockfile = lockfile, clean = clean)
 
     # re-generate the activate script
-    args <- c("--vanilla", "-s", "-e", shQuote("renv::activate()"))
-    r(args)
+    local({
+
+      # make sure we can find 'renv' on the library paths
+      renv_scope_libpaths(the$library_path)
+
+      # invoke activate
+      args <- c("--vanilla", "-s", "-e", shQuote("renv::activate()"))
+      r(args)
+
+    })
 
     # update the renv lockfile record
+    # (note: it might not be available when running tests)
     local({
+
+      renv <- renv_lockfile_records(lockfile)[["renv"]]
+      if (is.null(renv))
+        return()
+
       renv_scope_options(renv.verbose = FALSE)
-      record(
-        records = renv_lockfile_records(lockfile)["renv"],
-        project = project
-      )
+      record(records = list(renv = renv), project = project)
+
     })
 
   }
diff --git a/R/zzz.R b/R/zzz.R
index e0dbd0993..b1b13664f 100644
--- a/R/zzz.R
+++ b/R/zzz.R
@@ -4,6 +4,15 @@
   # NOTE: needs to be visible to embedded instances of renv as well
   the$envir_self <<- renv_envir_self()
 
+  # figure out where 'renv' was loaded from -- if tests are running
+  # and we're using devtools::load_all(), we might need to fall back
+  # to whatever version of renv is available on the library paths
+  load <- Sys.getenv("DEVTOOLS_LOAD", unset = NA)
+  the$library_path <<- if (identical(load, .packageName))
+    dirname(renv_package_find(.packageName))
+  else
+    libname
+
   # make sure renv (and packages using renv!!!) use tempdir for storage
   # when running tests, or R CMD check
   if (checking() || testing()) {
diff --git a/man/install.Rd b/man/install.Rd
index 456bd96ab..7307f7287 100644
--- a/man/install.Rd
+++ b/man/install.Rd
@@ -59,7 +59,7 @@ vector of package names indicating which packages should be rebuilt.}
 
 \item{repos}{The repositories to use when restoring packages installed
 from CRAN or a CRAN-like repository. By default, the repositories recorded
-in the lockfile will be, ensuring that (e.g.) CRAN packages are
+in the lockfile will be used, ensuring that (e.g.) CRAN packages are
 re-installed from the same CRAN mirror.
 
 Use \code{repos = getOption("repos")} to override with the repositories set
diff --git a/man/restore.Rd b/man/restore.Rd
index 488daabed..673363c11 100644
--- a/man/restore.Rd
+++ b/man/restore.Rd
@@ -49,7 +49,7 @@ vector of package names indicating which packages should be rebuilt.}
 
 \item{repos}{The repositories to use when restoring packages installed
 from CRAN or a CRAN-like repository. By default, the repositories recorded
-in the lockfile will be, ensuring that (e.g.) CRAN packages are
+in the lockfile will be used, ensuring that (e.g.) CRAN packages are
 re-installed from the same CRAN mirror.
 
 Use \code{repos = getOption("repos")} to override with the repositories set
diff --git a/tests/testthat/helper-scope.R b/tests/testthat/helper-scope.R
index a403fa875..bb1ccb695 100644
--- a/tests/testthat/helper-scope.R
+++ b/tests/testthat/helper-scope.R
@@ -76,3 +76,8 @@ renv_scope_local <- function() {
   path <- renv_tests_path("local")
   renv_scope_envvars(RENV_PATHS_LOCAL = path, scope = parent.frame())
 }
+
+renv_tests_dependencies <- function(packages) {
+  code <- sprintf("library(%s)", packages)
+  cat(code, file = "dependencies.R", sep = "\n", append = TRUE)
+}
diff --git a/tests/testthat/test-checkout.R b/tests/testthat/test-checkout.R
index f65816091..69c3fc0a9 100644
--- a/tests/testthat/test-checkout.R
+++ b/tests/testthat/test-checkout.R
@@ -2,10 +2,12 @@
 test_that("we can check out packages from our local repository", {
 
   # enter test scope
-  project <- renv_tests_scope("breakfast")
+  project <- renv_tests_scope()
+  init()
 
   # check out a package + its dependencies; this invocation is
   # similar in spirit to a plain `install()` call
+  renv_tests_dependencies("breakfast")
   checkout(packages = "breakfast")
 
   # check that they were installed