diff --git a/NEWS.md b/NEWS.md index a10d73f95..d88a36461 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,6 +1,9 @@ # renv 1.1.0 (UNRELEASED) +* `renv::run()` gains the `args` parameter, which can be used to pass command-line + arguments to a script. (#2015) + * `renv` now infers a dependency on `rmarkdown` and `knitr` for R scripts which include YAML front-matter. (#2023) diff --git a/R/run.R b/R/run.R index e25b0cf5d..5e9e5b561 100644 --- a/R/run.R +++ b/R/run.R @@ -15,14 +15,23 @@ #' #' @param name The name to associate with the job, for scripts run as a job. #' +#' @param args description A character vector of command line arguments to be +#' passed to the launched job. These parameters can be accessed via +#' `commandArgs(trailingOnly = FALSE)`. +#' #' @param project The path to the renv project. This project will be loaded #' before the requested script is executed. When `NULL` (the default), renv #' will automatically determine the project root for the associated script #' if possible. #' #' @export -run <- function(script, ..., job = NULL, name = NULL, project = NULL) { - +run <- function(script, + ..., + job = NULL, + name = NULL, + args = NULL, + project = NULL) +{ renv_scope_error_handler() renv_dots_check(...) @@ -59,18 +68,37 @@ run <- function(script, ..., job = NULL, name = NULL, project = NULL) { stopf("cannot run script as job: required versions of RStudio + rstudioapi not available") if (jobbable) - renv_run_job(script = script, name = name, project = project) + renv_run_job(script = script, name = name, args = args, project = project) else - renv_run_impl(script = script, name = name, project = project) - + renv_run_impl(script = script, name = name, args = args, project = project) } -renv_run_job <- function(script, name, project) { +renv_run_job <- function(script, name, args, project) { activate <- renv_paths_activate(project = project) exprs <- expr({ + + # insert a shim for commandArg + local({ + + # unlock binding temporarily + base <- .BaseNamespaceEnv + base$unlockBinding("commandArgs", base) + on.exit(base$lockBinding("commandArgs", base), add = TRUE) + + # insert our shim + cargs <- commandArgs(trailingOnly = FALSE) + base$commandArgs <- function(trailingOnly = FALSE) { + result <- !!args + if (trailingOnly) result else union(cargs, result) + } + + }) + + # run the script source(!!activate) source(!!script) + }) code <- deparse(exprs) @@ -85,7 +113,10 @@ renv_run_job <- function(script, name, project) { } -renv_run_impl <- function(script, name, project) { +renv_run_impl <- function(script, name, args, project) { renv_scope_wd(project) - system2(R(), c("-s", "-f", renv_shell_path(script))) + system2(R(), c( + "-s", "-f", renv_shell_path(script), + if (length(args)) c("--args", args) + ), wait = FALSE) } diff --git a/R/utils.R b/R/utils.R index 74852f068..44e0b0ea0 100644 --- a/R/utils.R +++ b/R/utils.R @@ -593,3 +593,9 @@ warnify <- function(cnd) { not <- function(value) { if (value) FALSE else TRUE } + +wait <- function(predicate, ...) { + while (TRUE) + if (predicate(...)) + break +} diff --git a/man/run.Rd b/man/run.Rd index 7a5d8cfc8..4a26501ca 100644 --- a/man/run.Rd +++ b/man/run.Rd @@ -4,7 +4,7 @@ \alias{run} \title{Run a script} \usage{ -run(script, ..., job = NULL, name = NULL, project = NULL) +run(script, ..., job = NULL, name = NULL, args = NULL, project = NULL) } \arguments{ \item{script}{The path to an \R script.} @@ -19,6 +19,10 @@ launched by \code{\link[=system2]{system2()}} if not.} \item{name}{The name to associate with the job, for scripts run as a job.} +\item{args}{description A character vector of command line arguments to be +passed to the launched job. These parameters can be accessed via +\code{commandArgs(trailingOnly = FALSE)}.} + \item{project}{The path to the renv project. This project will be loaded before the requested script is executed. When \code{NULL} (the default), renv will automatically determine the project root for the associated script diff --git a/tests/testthat/test-run.R b/tests/testthat/test-run.R new file mode 100644 index 000000000..e197f39df --- /dev/null +++ b/tests/testthat/test-run.R @@ -0,0 +1,26 @@ + +test_that("run() can be called with arguments", { + + project <- renv_tests_scope() + dir.create("renv", recursive = TRUE, showWarnings = FALSE) + writeLines("# stub", con = "renv/activate.R") + + output <- tempfile("renv-output-") + script <- renv_test_code({ + writeLines(commandArgs(trailingOnly = TRUE), con = output) + }, list(output = output)) + + args <- c("--apple", "--banana", "--cherry") + + run( + script = script, + args = args, + project = getwd() + ) + + wait(file.exists, output) + + contents <- readLines(output) + expect_equal(contents, args) + +})