Merge pull request #164 from r-lib/fix/session-info

Rewrite session info extraction

R/background.R

@@ -36,6 +36,8 @@
 #' * `repos`: The `repos` option to set for the check.
 #'   This is needed for cyclic dependency checks if you use the
 #'   `--as-cran` argument. The default uses the current value.
+#' * `env`: A named character vector, extra environment variables to
+#'   set in the check process.
 #'
 #' @section Details:
 #' Most methods are inherited from [callr::rcmd_process] and
@@ -61,9 +63,9 @@ rcmdcheck_process <- R6Class(
 
     initialize = function(path = ".", args = character(),
       build_args = character(), check_dir = NULL, libpath = .libPaths(),
-      repos = getOption("repos"))
+      repos = getOption("repos"), env = character())
       rcc_init(self, private, super, path, args, build_args, check_dir,
-               libpath, repos),
+               libpath, repos, env),
 
     parse_results = function()
       rcc_parse_results(self, private),
@@ -103,7 +105,7 @@ rcmdcheck_process <- R6Class(
 #' @importFrom desc desc
 
 rcc_init <- function(self, private, super, path, args, build_args,
-                     check_dir, libpath, repos) {
+                     check_dir, libpath, repos, env) {
 
   if (file.info(path)$isdir) {
     path <- find_package_root_file(path = path)
@@ -134,26 +136,37 @@ rcc_init <- function(self, private, super, path, args, build_args,
 
   set_env(path, targz, private$description)
 
-  private$session_output <- tempfile()
-  profile <- make_fake_profile(session_output = private$session_output)
-  private$tempfiles  <- c(private$session_output, profile)
+  # set up environment, start with callr safe set
+  chkenv <- callr::rcmd_safe_env()
+
+  package <- private$description$get("Package")[[1]]
+  libdir <- file.path(dirname(targz), paste0(package, ".Rcheck"))
+
+  # if R_TESTS is set here, we'll skip the session_info, because we are
+  # probably inside test cases of some package
+  if (Sys.getenv("R_TESTS", "") == "") {
+    private$session_output <- tempfile()
+    private$tempfiles  <- c(private$session_output, profile)
+    profile <- make_fake_profile(package, private$session_output, libdir)
+    chkenv["R_TESTS"] <- profile
+  }
+
+  # user supplied env vars take precedence
+  if (length(env)) chkenv[names(env)] <- env
 
   options <- rcmd_process_options(
     cmd = "check",
     cmdargs = c(basename(targz), args),
-    libpath = libpath,
+    libpath = c(libdir, libpath),
     repos = repos,
-    user_profile = TRUE,
-    stderr = "2>&1"
+    user_profile = FALSE,
+    stderr = "2>&1",
+    env = chkenv
   )
 
-  with_envvar(
-    c(R_PROFILE_USER = profile,
-      R_LIBS_USER = paste(libpath, collapse = .Platform$path.sep)),
-    with_dir(
-      dirname(targz),
-      super$initialize(options)
-    )
+  with_dir(
+    dirname(targz),
+    super$initialize(options)
   )
 
   invisible(self)

R/package.R

@@ -97,7 +97,7 @@ NULL
 #'   errors as well. If `"note"`, then any check failure generated an
 #'   error. Its default can be modified with the `RCMDCHECK_ERROR_ON`
 #'   environment variable. If that is not set, then `"never"` is used.
-#' @param env A named character vector, rxtra environment variables to
+#' @param env A named character vector, extra environment variables to
 #'   set in the check process.
 #' @return An S3 object (list) with fields `errors`,
 #'   `warnings` and `notes`. These are all character
@@ -191,37 +191,42 @@ rcmdcheck <- function(
 do_check <- function(targz, package, args, libpath, repos,
                      quiet, timeout, env) {
 
-  session_output <- tempfile()
-  profile <- make_fake_profile(session_output = session_output)
-  on.exit(unlink(profile), add = TRUE)
-
   # if the pkg.Rcheck directory already exists, unlink it
   unlink(paste0(package, ".Rcheck"), recursive = TRUE)
 
-  callr_version <- package_version(getNamespaceVersion("callr"))
-  rlibsuser <- if (callr_version < "3.0.0.9001")
-    paste(libpath, collapse = .Platform$path.sep)
-
+  # set up environment, start with callr safe set
   chkenv <- callr::rcmd_safe_env()
+
+  libdir <- file.path(dirname(targz), paste0(package, ".Rcheck"))
+
+  # if R_TESTS is set here, we'll skip the session_info, because we are
+  # probably inside test cases of some package
+  if (Sys.getenv("R_TESTS", "") == "") {
+    session_output <- tempfile()
+    profile <- make_fake_profile(package, session_output, libdir)
+    on.exit(unlink(profile), add = TRUE)
+    chkenv["R_TESTS"] <- profile
+  } else {
+    session_output <- NULL
+  }
+
+  # user supplied env vars take precedence
   if (length(env)) chkenv[names(env)] <- env
 
   if (!quiet) cat_head("R CMD check")
   callback <- if (!quiet) detect_callback(as_cran = "--as-cran" %in% args)
-  res <- with_envvar(
-    c(R_PROFILE_USER = profile, R_LIBS_USER = rlibsuser),
-    rcmd_safe(
-      "check",
-      cmdargs = c(basename(targz), args),
-      libpath = libpath,
-      user_profile = TRUE,
-      repos = repos,
-      stderr = "2>&1",
-      block_callback = callback,
-      spinner = !quiet && should_add_spinner(),
-      timeout = timeout,
-      fail_on_status = FALSE,
-      env = chkenv
-    )
+  res <- rcmd_safe(
+    "check",
+    cmdargs = c(basename(targz), args),
+    libpath = c(libdir, libpath),
+    user_profile = FALSE,
+    repos = repos,
+    stderr = "2>&1",
+    block_callback = callback,
+    spinner = !quiet && should_add_spinner(),
+    timeout = timeout,
+    fail_on_status = FALSE,
+    env = chkenv
   )
 
   # To print an incomplete line on timeout or crash

R/session-info.R

@@ -1,31 +1,32 @@
 
-make_fake_profile  <- function(session_output) {
+make_fake_profile  <- function(package, session_output, libdir) {
   profile <- tempfile()
 
-  ## Include the real profile as well, if any
-  user <- Sys.getenv("R_PROFILE_USER", NA_character_)
-  local <- ".Rprofile"
-  home  <- path.expand("~/.Rprofile")
-  if (is.na(user) && file.exists(local)) user <- local
-  if (is.na(user) && file.exists(home)) user <- home
-  if (!is.na(user) && file.exists(user)) file.append(profile, user)
-
-  last <- substitute(
-    function() {
-      si <- tryCatch(sessioninfo::session_info(), error = identity)
-      l <- if (file.exists(`__output__`)) {
-        readRDS(`__output__`)
-      } else {
-        list()
-      }
-      saveRDS(c(l, list(si)), `__output__`)
-    },
-    list(`__output__` = session_output)
+  args <- list(
+    `__output__` = session_output,
+    `__package__` = package,
+    `__libdir__` = libdir
   )
 
-  cat(".Last <-", deparse(last), sep = "\n", file = profile,
-      append = TRUE)
-
+  expr <- substitute({
+    local({
+      reg.finalizer(
+        .GlobalEnv,
+        function(...) {
+          tryCatch({
+            .libPaths(c(`__libdir__`, .libPaths()))
+            si <- sessioninfo::session_info(pkgs = `__package__`)
+            saveRDS(si, `__output__`)
+          }, error = function(e) NULL)
+        },
+        onexit = TRUE
+      )
+      Sys.unsetenv("R_TESTS")
+    })
+  }, args)
+
+  cat(deparse(expr), sep = "\n", file = profile)
+
   profile
 }
 
@@ -37,10 +38,5 @@ get_session_info <- function(package, session_output) {
     error = function(e) NULL
   )
 
-  session_info <- Filter(
-    function(so) package %in% so$packages$package,
-    session_info
-  )
-
-  if (length(session_info) > 0) session_info[[1]] else NULL
+  session_info
 }

tests/testthat/test-rcmdcheck.R

@@ -65,8 +65,6 @@ test_that("rcmdcheck works", {
   expect_match(det$description, "^Package: badpackage")
   det$description <- NULL
 
-  ## This currently fails with rcmdcheck() (why?), so it also fails GHA
-  skip_on_ci()
   expect_s3_class(si, "session_info")
 })
 
@@ -116,8 +114,6 @@ test_that("background gives same results", {
   # check.env file was loaded
   expect_equal(lp1$env[['_R_CHECK_PKG_SIZES_THRESHOLD_']], "142")
 
-  ## This currently fails with rcmdcheck() (why?), so it also fails GHA
-  skip_on_ci()
   expect_s3_class(res$session_info, "session_info")
 })