From ffa393fda4ee73b2d99f92a90217e21c77a85bb2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?G=C3=A1bor=20Cs=C3=A1rdi?= Date: Tue, 15 May 2018 11:38:34 +0100 Subject: [PATCH] Use .Renviron, but override repos and libpath To the specified values. Everything is set up in a fake profile now. --- NEWS.md | 3 +++ R/eval-bg.R | 2 +- R/eval.R | 2 +- R/options.R | 2 +- R/presets.R | 2 +- R/rcmd.R | 3 +-- R/setup.R | 54 +++++++++++++++++++++++++++++--------- man/r.Rd | 16 +++++------ man/r_bg.Rd | 6 ++--- man/r_copycat.Rd | 2 +- tests/testthat/test-eval.R | 52 ++++++++++++++++++++++++++++++++++++ 11 files changed, 114 insertions(+), 30 deletions(-) diff --git a/NEWS.md b/NEWS.md index c2e6ddf2..b91eb39b 100644 --- a/NEWS.md +++ b/NEWS.md @@ -3,6 +3,9 @@ * pkgdown web site at https://callr.r-lib.org (#52, #53). +* callr users `.Renviron` files now (and `R_ENVIRON_USER` as well), + but overrides the library path, as requested in `r()`, etc. (#30). + # callr 2.0.3 * The default behavior on error can be set now with the `callr.error` diff --git a/R/eval-bg.R b/R/eval-bg.R index 33139b4e..f33099db 100644 --- a/R/eval-bg.R +++ b/R/eval-bg.R @@ -28,7 +28,7 @@ r_bg <- function(func, args = list(), libpath = .libPaths(), c(CRAN = "https://cloud.r-project.org")), stdout = "|", stderr = "|", error = getOption("callr.error", "error"), - cmdargs = c("--no-site-file", "--no-environ", "--slave", + cmdargs = c("--no-site-file", "--slave", "--no-save", "--no-restore"), system_profile = FALSE, user_profile = FALSE, env = rcmd_safe_env(), supervise = FALSE) { diff --git a/R/eval.R b/R/eval.R index 4008f5db..c4975da2 100644 --- a/R/eval.R +++ b/R/eval.R @@ -121,7 +121,7 @@ r <- function(func, args = list(), libpath = .libPaths(), c(CRAN = "https://cloud.r-project.org")), stdout = NULL, stderr = NULL, error = getOption("callr.error", "error"), - cmdargs = c("--no-site-file", "--no-environ", "--slave", + cmdargs = c("--no-site-file", "--slave", "--no-save", "--no-restore"), show = FALSE, callback = NULL, block_callback = NULL, spinner = show && interactive(), diff --git a/R/options.R b/R/options.R index dcff1ab8..dc55360d 100644 --- a/R/options.R +++ b/R/options.R @@ -49,7 +49,7 @@ r_process_options_default <- function() { stdout = "|", stderr = "|", error = getOption("callr.error", "error"), - cmdargs = c("--no-site-file", "--no-environ", "--slave", + cmdargs = c("--no-site-file", "--slave", "--no-save", "--no-restore"), system_profile = FALSE, user_profile = FALSE, diff --git a/R/presets.R b/R/presets.R index c36ed74f..e2d9f3a6 100644 --- a/R/presets.R +++ b/R/presets.R @@ -40,7 +40,7 @@ r_safe <- r #' #' Differences to [r()]: #' * No extra repoditories are set up. -#' * The `--no-site-file`, `--no-environ`, `--no-save`, `--no-restore` +#' * The `--no-site-file`, `--no-save`, `--no-restore` #' command line arguments are not used. (But `--slave` still is.) #' * The system profile and the user profile are loaded. #' * No extra environment variables are set up. diff --git a/R/rcmd.R b/R/rcmd.R index d8a3821c..1878e63e 100644 --- a/R/rcmd.R +++ b/R/rcmd.R @@ -97,8 +97,7 @@ rcmd_safe_env <- function() { CYGWIN = "nodosfilewarning", R_TESTS = "", R_BROWSER = "false", - R_PDFVIEWER = "false", - R_ENVIRON_USER = tempfile() + R_PDFVIEWER = "false" ) vars diff --git a/R/setup.R b/R/setup.R index ac8c2e25..014661bc 100644 --- a/R/setup.R +++ b/R/setup.R @@ -22,28 +22,58 @@ setup_context <- function(options) { within(options, { ## profiles - profile <- make_profile(repos) + profile <- make_profile(system_profile, user_profile, repos, libpath) tmp_files <- c(tmp_files, profile) - ## Temporary library path - lib <- paste(libpath, collapse = .Platform$path.sep) - - ## Workaround, R ignores "", need to set to non-existant file - if (lib == "") lib <- tempfile() - - ## LIB and PROFILE env vars + ## Lib path is set in the profile + lib <- tempfile() if (is.na(env["R_LIBS"])) env["R_LIBS"] <- lib if (is.na(env["R_LIBS_USER"])) env["R_LIBS_USER"] <- lib if (is.na(env["R_LIBS_SITE"])) env["R_LIBS_SITE"] <- lib - if (!system_profile) env["R_PROFILE"] <- profile - if (!user_profile) env["R_PROFILE_USER"] <- profile + if (is.na(env["R_PROFILE"])) env["R_PROFILE"] <- lib + if (is.na(env["R_PROFILE_USER"])) env["R_PROFILE_USER"] <- profile }) } -make_profile <- function(repos) { +## We need to combine all profiles into a single one. The combined profile +## might include the system and user profile, depending on options. +## It always includes the `repos` and `.libPaths()` settingd. +## +## We set lib path here as well, in case it was set in .Renviron, etc., +## because the supplied libpath should take precedence over .Renviron. + +make_profile <- function(system, user, repos, libpath) { profile <- tempfile() - cat("options(repos=", deparse(repos), ")\n", sep = "", file = profile) + + ## Create file + cat("", file = profile) + + ## Add profiles + if (system) { + sys <- Sys.getenv("R_PROFILE", + file.path(R.home("etc"), "Rprofile.site")) + sys <- path.expand(sys) + if (file.exists(sys)) file.append(profile, sys) + } + + if (user) { + 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) + } + + ## Override repos and library path, as requested + cat("options(repos=", deparse(repos), ")\n", sep = "", file = profile, + append = TRUE) + if (!is.null(libpath)) { + cat(".libPaths(", deparse(libpath), ")\n", sep = "", file = profile, + append = TRUE) + } + profile } diff --git a/man/r.Rd b/man/r.Rd index 5a34792a..2a06d18f 100644 --- a/man/r.Rd +++ b/man/r.Rd @@ -8,18 +8,18 @@ r(func, args = list(), libpath = .libPaths(), repos = c(getOption("repos"), c(CRAN = "https://cloud.r-project.org")), stdout = NULL, stderr = NULL, error = getOption("callr.error", "error"), - cmdargs = c("--no-site-file", "--no-environ", "--slave", "--no-save", - "--no-restore"), show = FALSE, callback = NULL, block_callback = NULL, - spinner = show && interactive(), system_profile = FALSE, - user_profile = FALSE, env = rcmd_safe_env(), timeout = Inf) + cmdargs = c("--no-site-file", "--slave", "--no-save", "--no-restore"), + show = FALSE, callback = NULL, block_callback = NULL, spinner = show + && interactive(), system_profile = FALSE, user_profile = FALSE, + env = rcmd_safe_env(), timeout = Inf) r_safe(func, args = list(), libpath = .libPaths(), repos = c(getOption("repos"), c(CRAN = "https://cloud.r-project.org")), stdout = NULL, stderr = NULL, error = getOption("callr.error", "error"), - cmdargs = c("--no-site-file", "--no-environ", "--slave", "--no-save", - "--no-restore"), show = FALSE, callback = NULL, block_callback = NULL, - spinner = show && interactive(), system_profile = FALSE, - user_profile = FALSE, env = rcmd_safe_env(), timeout = Inf) + cmdargs = c("--no-site-file", "--slave", "--no-save", "--no-restore"), + show = FALSE, callback = NULL, block_callback = NULL, spinner = show + && interactive(), system_profile = FALSE, user_profile = FALSE, + env = rcmd_safe_env(), timeout = Inf) } \arguments{ \item{func}{Function object to call in the new R process. diff --git a/man/r_bg.Rd b/man/r_bg.Rd index 445fa9c0..299e5732 100644 --- a/man/r_bg.Rd +++ b/man/r_bg.Rd @@ -7,9 +7,9 @@ r_bg(func, args = list(), libpath = .libPaths(), repos = c(getOption("repos"), c(CRAN = "https://cloud.r-project.org")), stdout = "|", stderr = "|", error = getOption("callr.error", "error"), - cmdargs = c("--no-site-file", "--no-environ", "--slave", "--no-save", - "--no-restore"), system_profile = FALSE, user_profile = FALSE, - env = rcmd_safe_env(), supervise = FALSE) + cmdargs = c("--no-site-file", "--slave", "--no-save", "--no-restore"), + system_profile = FALSE, user_profile = FALSE, env = rcmd_safe_env(), + supervise = FALSE) } \arguments{ \item{func}{Function object to call in the new R process. diff --git a/man/r_copycat.Rd b/man/r_copycat.Rd index bef44db0..4b4c270f 100644 --- a/man/r_copycat.Rd +++ b/man/r_copycat.Rd @@ -51,7 +51,7 @@ supplied function and some error handling code.} Differences to \code{\link[=r]{r()}}: \itemize{ \item No extra repoditories are set up. -\item The \code{--no-site-file}, \code{--no-environ}, \code{--no-save}, \code{--no-restore} +\item The \code{--no-site-file}, \code{--no-save}, \code{--no-restore} command line arguments are not used. (But \code{--slave} still is.) \item The system profile and the user profile are loaded. \item No extra environment variables are set up. diff --git a/tests/testthat/test-eval.R b/tests/testthat/test-eval.R index f159b283..19d8de10 100644 --- a/tests/testthat/test-eval.R +++ b/tests/testthat/test-eval.R @@ -74,3 +74,55 @@ test_that("stdout and stderr in the same file", { expect_equal(readLines(tmp), paste0("hello", 1:3)) }) + +test_that("profiles are used as requested", { + do <- function(system, user) { + tmp1 <- tempfile() + tmp2 <- tempfile() + on.exit(unlink(c(tmp1, tmp2)), add = TRUE) + cat("Sys.setenv(FOO = 'bar')\n", file = tmp1) + cat("Sys.setenv(NAH = 'doh')\n", file = tmp2) + withr::with_envvar(list(R_PROFILE = tmp1, R_PROFILE_USER = tmp2), { + res <- r( + function() c(Sys.getenv("FOO", ""), Sys.getenv("NAH", "")), + system_profile = system, user_profile = user) + }) + } + + ## None + res <- do(FALSE, FALSE) + expect_equal(res, c("", "")) + + ## System + res <- do(TRUE, FALSE) + expect_equal(res, c("bar", "")) + + ## User + res <- do(FALSE, TRUE) + expect_equal(res, c("", "doh")) + + ## Both + res <- do(TRUE, TRUE) + expect_equal(res, c("bar", "doh")) +}) + +test_that(".Renviron is used, but lib path is set over it", { + dir.create(tmp <- tempfile()) + on.exit(unlink(tmp, recursive = TRUE), add = TRUE) + withr::with_dir(tmp, { + ## Create .Renviron file + dir.create("not") + dir.create("yes") + cat("R_LIBS=\"", file.path(getwd(), "not"), "\"\n", + sep = "", file = ".Renviron") + cat("FOO=bar\n", file = ".Renviron", append = TRUE) + + res <- r( + function() list(.libPaths(), Sys.getenv("FOO")), + libpath = file.path(getwd(), "yes") + ) + }) + + expect_equal(basename(res[[1]][1]), "yes") + expect_equal(res[[2]], "bar") +})