Use .Renviron, but override repos and libpath

To the specified values. Everything is set up
in  a fake profile now.

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`

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) {

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(),

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,

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.

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

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
 }
 

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")
+})