Fix forwarding of missing arguments

NEWS.md

@@ -25,6 +25,9 @@
    everywhere. It was still 500 MiB is some cases, e.g. `futureCall()`
    had a limit although `future()` did not.
 
+ * Missing arguments can now be forwarded in a future expression without
+   being retrieved as ordinary global objects (#756).
+
  * On MS Windows, a future startup script specified by environment
    variable `R_FUTURE_STARTUP_SCRIPT` was silently ignored due to a
    bug in parsing the value.

R/protected_api-globals.R

@@ -31,6 +31,8 @@
 #'
 #' @keywords internal
 getGlobalsAndPackages <- function(expr, envir = parent.frame(), tweak = tweakExpression, globals = TRUE, locals = getOption("future.globals.globalsOf.locals", TRUE), resolve = getOption("future.globals.resolve"), persistent = FALSE, maxSize = getOption("future.globals.maxSize", +Inf), onReference = getOption("future.globals.onReference", "ignore"), ...) {
+  exprOrg <- expr
+
   if (is.null(resolve)) {
     resolve <- FALSE
   } else {
@@ -121,19 +123,70 @@ getGlobalsAndPackages <- function(expr, envir = parent.frame(), tweak = tweakExp
       }
 
       ## Combine results from different methods
-      globals <- globalsOf(
-        ## Passed to globals::findGlobals()
-        expr, envir = envir, substitute = FALSE, tweak = tweak,
-        ## Include globals part of a local closure environment?
-        locals = locals,
-        ## Passed to globals::findGlobals() via '...'
-        dotdotdot = "return",
-        method = globals.method,
-        unlist = TRUE,
-        ## Passed to globals::globalsByName()
-        mustExist = mustExist,
-        recursive = TRUE
-      )
+      collect_globals <- function(expr) {
+        globalsOf(
+          ## Passed to globals::findGlobals()
+          expr, envir = envir, substitute = FALSE, tweak = tweak,
+          ## Include globals part of a local closure environment?
+          locals = locals,
+          ## Passed to globals::findGlobals() via '...'
+          dotdotdot = "return",
+          method = globals.method,
+          unlist = TRUE,
+          ## Passed to globals::globalsByName()
+          mustExist = mustExist,
+          recursive = TRUE
+        )
+      }
+      globals <- tryCatch(collect_globals(expr), error = identity)
+
+      ## Missing function arguments can be forwarded to another function,
+      ## but they cannot be retrieved as ordinary globals. On this rare error
+      ## path, preserve them as missing formals around the future expression.
+      if (inherits(globals, "error")) {
+        global_names <- findGlobals(
+          expr, envir = envir, substitute = FALSE, tweak = tweak,
+          dotdotdot = "return", method = globals.method, unlist = TRUE
+        )
+        global_names <- setdiff(
+          global_names,
+          c("...", grep("^[.][.][0-9]+$", global_names, value = TRUE))
+        )
+
+        missing_value <- alist(arg = )
+        names(missing_value) <- NULL
+        missing_value <- as.call(c(list(as.name("list")), missing_value))
+
+        is_missing_global <- function(name) {
+          env <- envir
+          repeat {
+            if (exists(name, envir = env, inherits = FALSE)) {
+              template <- call("list", as.name(name))
+              value <- do.call("substitute", list(template, env))
+              return(identical(value, missing_value))
+            }
+            if (identical(env, emptyenv())) return(FALSE)
+            env <- parent.env(env)
+          }
+        }
+
+        missing_globals <- global_names[vapply(
+          global_names, FUN = is_missing_global, FUN.VALUE = FALSE
+        )]
+        if (length(missing_globals) == 0L) stop(globals)
+
+        if (debug) {
+          mdebugf(
+            "missing globals found: [%d] %s",
+            length(missing_globals), commaq(missing_globals)
+          )
+        }
+        formals <- rep(alist(arg = ), times = length(missing_globals))
+        names(formals) <- missing_globals
+        fcn <- as.call(list(as.name("function"), as.pairlist(formals), expr))
+        expr <- as.call(list(fcn))
+        globals <- collect_globals(expr)
+      }
 
       if (debug) mdebugf("globals found: [%d] %s", length(globals), commaq(names(globals)))
       if (debug) mdebug_pop()
@@ -191,8 +244,6 @@ getGlobalsAndPackages <- function(expr, envir = parent.frame(), tweak = tweakExp
   }
   stop_if_not(is.logical(resolve), length(resolve) == 1L, !is.na(resolve))
 
-  exprOrg <- expr
-
   ## Tweak expression to be called with global ... arguments?
   if (length(globals) > 0 && inherits(globals[["..."]], "DotDotDotList")) {
     if (debug) mdebug_push("Tweak future expression to call with '...' arguments ...")

inst/testme/test-globals,missing.R

@@ -0,0 +1,43 @@
+#' @tags globals
+#' @tags sequential multisession multicore
+
+library(future)
+
+message("*** Forwarding missing arguments as globals ...")
+
+consume <- function(x, y, z) {
+  if (!missing(y)) x <- x + y
+  if (!missing(z)) x <- x + z
+  x
+}
+
+forward <- function(x, y, z) {
+  future(consume(x = x, y = y, z = z))
+}
+
+forward_default <- function(x, y = 2) {
+  future(consume(x = x, y = y))
+}
+
+for (strategy in supportedStrategies()) {
+  message(sprintf("- Strategy: %s ...", strategy))
+  plan(strategy)
+
+  f <- forward(1)
+  stopifnot(identical(value(f), 1))
+
+  f <- forward(1, 2)
+  stopifnot(identical(value(f), 3))
+
+  f <- forward(1, 2, 4)
+  stopifnot(identical(value(f), 7))
+
+  ## A missing argument with a default forwards its default value.
+  f <- forward_default(1)
+  stopifnot(identical(value(f), 3))
+
+  plan(sequential)
+  message(sprintf("- Strategy: %s ... DONE", strategy))
+}
+
+message("*** Forwarding missing arguments as globals ... DONE")

tests/test-globals,missing.R

@@ -0,0 +1,4 @@
+#! /usr/bin/env Rscript
+## This runs testme test script inst/testme/test-globals,missing.R
+## Don't edit - it was autogenerated by inst/testme/deploy.R
+future:::testme("globals,missing")