From 07059d9898052446e4ee0dbb083de15e417d340e Mon Sep 17 00:00:00 2001
From: Kevin Ushey <kevinushey@gmail.com>
Date: Sat, 12 Oct 2024 11:41:06 -0700
Subject: [PATCH 1/2] support command-line arguments in run

---
 R/run.R                   | 47 ++++++++++++++++++++++++++++++++-------
 R/utils.R                 |  6 +++++
 man/run.Rd                |  6 ++++-
 tests/testthat/test-run.R | 26 ++++++++++++++++++++++
 4 files changed, 76 insertions(+), 9 deletions(-)
 create mode 100644 tests/testthat/test-run.R

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

From 5c7c9428adacab4e1ee8e510d004dda4ecd04bc0 Mon Sep 17 00:00:00 2001
From: Kevin Ushey <kevinushey@gmail.com>
Date: Sat, 12 Oct 2024 11:41:57 -0700
Subject: [PATCH 2/2] update NEWS

---
 NEWS.md | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 6a593421d..62c375b98 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 1.0.11