diff --git a/NEWS.md b/NEWS.md index eeca6188..6c74cb97 100644 --- a/NEWS.md +++ b/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. diff --git a/R/protected_api-globals.R b/R/protected_api-globals.R index 56e1b97a..dbd22f3d 100644 --- a/R/protected_api-globals.R +++ b/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 ...") diff --git a/inst/testme/test-globals,missing.R b/inst/testme/test-globals,missing.R new file mode 100644 index 00000000..66c965c2 --- /dev/null +++ b/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") diff --git a/tests/test-globals,missing.R b/tests/test-globals,missing.R new file mode 100755 index 00000000..5e06f661 --- /dev/null +++ b/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")