Merge pull request #575 from kevinushey/bugfix/package-installation-s…

…eparate-process invoke package installation in separate R process
r-lib · Aug 13, 2024 · c0c88f1 · c0c88f1
2 parents dd5286d + 4a5ee5a
commit c0c88f1
Show file tree

Hide file tree

Showing 7 changed files with 28 additions and 17 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,8 @@
 # covr (development version)
 
+* Fixed an issue where attempting to generate code coverage on an already-loaded
+  package could fail on Windows. (@kevinushey, #574)
+
 * Prevent `covr.record_tests` option from logging duplicate tests when the same
   line of testing code is hit repeatedly, as in a loop. (@dgkf, #528)
 

diff --git a/R/covr.R b/R/covr.R
@@ -441,18 +441,26 @@ package_coverage <- function(path = ".",
   if (isTRUE(pre_clean)) clean_objects(pkg$path)
 
   # install the package in a temporary directory
-  withr::with_makevars(flags, assignment = "+=",
-    utils::install.packages(repos = NULL,
-                            lib = install_path,
-                            pkg$path,
-                            type = "source",
-                            INSTALL_opts = c("--example",
-                                             "--install-tests",
-                                             "--with-keep.source",
-                                             "--with-keep.parse.data",
-                                             "--no-staged-install",
-                                             "--no-multiarch"),
-                            quiet = quiet))
+  withr::with_envvar(
+    list(R_LIBS = paste(.libPaths(), collapse = .Platform$path.sep)),
+    withr::with_makevars(flags, assignment = "+=", {
+      args <- c(
+        "--vanilla", "CMD", "INSTALL",
+        "-l", shQuote(install_path),
+        "--example",
+        "--install-tests",
+        "--with-keep.source",
+        "--with-keep.parse.data",
+        "--no-staged-install",
+        "--no-multiarch",
+        shQuote(pkg$path)
+      )
+
+      name <- if (.Platform$OS.type == "windows") "R.exe" else "R"
+      path <- file.path(R.home("bin"), name)
+      system2(path, args)
+    })
+  )
 
   # add hooks to the package startup
   add_hooks(pkg$package, install_path,

diff --git a/tests/testthat/Test+Char/TestCompiled/src/simple.cc b/tests/testthat/Test+Char/TestCompiled/src/simple.cc
@@ -6,7 +6,7 @@
 extern "C" SEXP simple_(SEXP x) {
   double *px, *pout;
 
-  SEXP out = PROTECT(allocVector(REALSXP, 1));
+  SEXP out = PROTECT(Rf_allocVector(REALSXP, 1));
 
   px = REAL(x);
   pout = REAL(out);

diff --git a/tests/testthat/TestCompiled/src/simple-header.h b/tests/testthat/TestCompiled/src/simple-header.h
@@ -9,7 +9,7 @@ template <typename R, int R_SXP>
 SEXP simple2_(SEXP x) {
   R *px, *pout;
 
-  SEXP out = PROTECT(allocVector(R_SXP, 1));
+  SEXP out = PROTECT(Rf_allocVector(R_SXP, 1));
 
   px = (R *) DATAPTR(x);
   pout = (R *) DATAPTR(out);

diff --git a/tests/testthat/TestCompiled/src/simple.cc b/tests/testthat/TestCompiled/src/simple.cc
@@ -7,7 +7,7 @@
 extern "C" SEXP simple_(SEXP x) {
   double *px, *pout;
 
-  SEXP out = PROTECT(allocVector(REALSXP, 1));
+  SEXP out = PROTECT(Rf_allocVector(REALSXP, 1));
 
   px = REAL(x);
   pout = REAL(out);

diff --git a/tests/testthat/TestCompiledSubdir/src/lib/simple.c b/tests/testthat/TestCompiledSubdir/src/lib/simple.c
@@ -6,7 +6,7 @@
 SEXP simple_(SEXP x) {
   double *px, *pout;
 
-  SEXP out = PROTECT(allocVector(REALSXP, 1));
+  SEXP out = PROTECT(Rf_allocVector(REALSXP, 1));
 
   px = REAL(x);
   pout = REAL(out);

diff --git a/tests/testthat/test-record_tests.R b/tests/testthat/test-record_tests.R
@@ -194,7 +194,7 @@ test_that("covr.record_tests: safely handles extremely large calls", {
     res <- system2(file.path(R.home("bin"), "R"), list("-q", "-s", "--vanilla", "-f", r_script), stdout = TRUE, stderr = TRUE)
   })
 
-  if (attr(res, "status") == 0L) {
+  if (identical(attr(res, "status"), 0L)) {
     warning(paste0(collapse = "\n", strwrap(paste0(
       "Looks like R was updated and the work-around for Rds ",
       "deserialization segfaults can now be made to apply conditionally to only ",