From 5544634aba0000fc1db8910e911aa71fdfdc4e84 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 23 Sep 2021 11:22:16 +0200 Subject: [PATCH 1/3] Rewrite session info extraction Do not require fake profiles, use R_TESTS instead. --- R/background.R | 42 ++++++++++++++++++++----------- R/package.R | 52 ++++++++++++++++++++------------------ R/session-info.R | 54 +++++++++++++++++++--------------------- man/rcmdcheck_process.Rd | 2 ++ 4 files changed, 82 insertions(+), 68 deletions(-) diff --git a/R/background.R b/R/background.R index 0f72df1..284974f 100644 --- a/R/background.R +++ b/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,36 @@ 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() + + # 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) + package <- private$description$get("Package")[[1]] + libdir <- file.path(dirname(targz), paste0(package, ".Rcheck")) + 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, 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) diff --git a/R/package.R b/R/package.R index 74cdc6e..8b02c44 100644 --- a/R/package.R +++ b/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,41 @@ 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() + + # 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() + libdir <- file.path(dirname(targz), paste0(package, ".Rcheck")) + 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 = 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 diff --git a/R/session-info.R b/R/session-info.R index d6eedff..8eb19f4 100644 --- a/R/session-info.R +++ b/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 } diff --git a/man/rcmdcheck_process.Rd b/man/rcmdcheck_process.Rd index 1ae0445..ede5597 100644 --- a/man/rcmdcheck_process.Rd +++ b/man/rcmdcheck_process.Rd @@ -41,6 +41,8 @@ package to check. \item \code{repos}: The \code{repos} option to set for the check. This is needed for cyclic dependency checks if you use the \code{--as-cran} argument. The default uses the current value. +\item \code{env}: A named character vector, extra environment variables to +set in the check process. } } From 5d031bd8281d0a29faaa94463862268057233df9 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 23 Sep 2021 11:39:42 +0200 Subject: [PATCH 2/3] Add the check library to libpath This is needed because callr has a bug when the sub-process ignores .Renviron and .Rprofile, but a sub-sub-process does not. Closes #134. --- R/background.R | 9 +++++---- R/package.R | 5 +++-- 2 files changed, 8 insertions(+), 6 deletions(-) diff --git a/R/background.R b/R/background.R index 284974f..b8d9976 100644 --- a/R/background.R +++ b/R/background.R @@ -139,24 +139,25 @@ rcc_init <- function(self, private, super, path, args, build_args, # 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) - package <- private$description$get("Package")[[1]] - libdir <- file.path(dirname(targz), paste0(package, ".Rcheck")) 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 = FALSE, stderr = "2>&1", diff --git a/R/package.R b/R/package.R index 8b02c44..b967c74 100644 --- a/R/package.R +++ b/R/package.R @@ -197,11 +197,12 @@ do_check <- function(targz, package, args, libpath, repos, # 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() - libdir <- file.path(dirname(targz), paste0(package, ".Rcheck")) profile <- make_fake_profile(package, session_output, libdir) on.exit(unlink(profile), add = TRUE) chkenv["R_TESTS"] <- profile @@ -217,7 +218,7 @@ do_check <- function(targz, package, args, libpath, repos, res <- rcmd_safe( "check", cmdargs = c(basename(targz), args), - libpath = libpath, + libpath = c(libdir, libpath), user_profile = FALSE, repos = repos, stderr = "2>&1", From d2b9cf0735a181278280d7c32b49ca02ba06c038 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Thu, 23 Sep 2021 11:52:48 +0200 Subject: [PATCH 3/3] Do not skip session info tests on CI It should work now. --- tests/testthat/test-rcmdcheck.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/tests/testthat/test-rcmdcheck.R b/tests/testthat/test-rcmdcheck.R index 1318712..7b0b397 100644 --- a/tests/testthat/test-rcmdcheck.R +++ b/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") })