Record R option 'future.globals.onReference' when future is created

Author: HenrikBengtsson

R/backend_api-Future-class.R

@@ -124,6 +124,11 @@ Future <- function(expr = NULL, envir = parent.frame(), substitute = TRUE, stdou
 
   args <- list(...)
   args_names <- names(args)
+  if ("onReference" %in% args_names) {
+    onReference <- args[["onReference"]]
+  } else {
+    onReference <- getOption("future.globals.onReference", "ignore")
+  }
 
   ## WORKAROUND: Skip scanning of globals if already done /HB 2021-01-18
   if (!is.null(globals)) {
@@ -132,7 +137,7 @@ Future <- function(expr = NULL, envir = parent.frame(), substitute = TRUE, stdou
       ## Global objects?
       ## 'persistent' is only allowed for ClusterFuture:s, which will be
       ## asserted when run() is called /HB 2023-01-17
-      gp <- getGlobalsAndPackages(expr, envir = envir, tweak = tweakExpression, globals = globals, persistent = isTRUE(args[["persistent"]]))
+      gp <- getGlobalsAndPackages(expr, envir = envir, tweak = tweakExpression, globals = globals, persistent = isTRUE(args[["persistent"]]), onReference = onReference)
       globals <- gp[["globals"]]
       expr <- gp[["expr"]]
 
@@ -230,6 +235,7 @@ Future <- function(expr = NULL, envir = parent.frame(), substitute = TRUE, stdou
   core[["label"]] <- label
   core[["earlySignal"]] <- earlySignal
   core[["gc"]] <- gc
+  core[["onReference"]] <- onReference
   core[["owner"]] <- session_uuid()
   counter <- .package[["futureCounter"]] <- .package[["futureCounter"]] + 1L
   core[["uuid"]] <- future_uuid(owner = core[["owner"]], counter = counter)
@@ -792,7 +798,7 @@ getFutureContext <- function(future, mc.cores = NULL, local = TRUE, ..., debug =
     ## Pass down other future.* options
     future.globals.maxSize            = getOption("future.globals.maxSize"),
     future.globals.method             = getOption("future.globals.method"),
-    future.globals.onReference        = getOption("future.globals.onReference"),
+    future.globals.onReference        = future[["onReference"]],
     future.globals.resolve            = getOption("future.globals.resolve"),
     future.resolve.recursive          = getOption("future.resolve.recursive"),
     future.rng.onMisuse               = getOption("future.rng.onMisuse"),

R/core_api-future.R

@@ -191,8 +191,10 @@ future <- function(expr, envir = parent.frame(), substitute = TRUE, lazy = FALSE
   if (substitute) expr <- substitute(expr)
   t_start <- Sys.time()
 
+  onReference <- getOption("future.globals.onReference", "ignore")
+
   if (!is.null(globals)) {
-    gp <- getGlobalsAndPackages(expr, envir = envir, tweak = tweakExpression, globals = globals)
+    gp <- getGlobalsAndPackages(expr, envir = envir, tweak = tweakExpression, globals = globals, onReference = onReference)
     expr <- gp[["expr"]]
     globals <- gp[["globals"]]
     ## Record packages?
@@ -202,7 +204,7 @@ future <- function(expr, envir = parent.frame(), substitute = TRUE, lazy = FALSE
     gp <- NULL
     attr(globals, "already-done") <- TRUE
   }
-  
+
   future <- Future(expr, substitute = FALSE,
                    envir = envir,
                    lazy = TRUE,
@@ -214,6 +216,7 @@ future <- function(expr, envir = parent.frame(), substitute = TRUE, lazy = FALSE
                    earlySignal = earlySignal,
                    label = label,
                    gc = gc,
+                   onReference = onReference,
                    ...)
 
   ## WORKAROUND: Was argument 'local' specified?

R/core_api-value.R

@@ -45,7 +45,6 @@ value.Future <- function(future, stdout = TRUE, signal = TRUE, ...) {
 
   value <- result[["value"]]
   visible <- result[["visible"]]
-  if (is.null(visible)) visible <- TRUE
 
   ## Always signal immediateCondition:s and as soon as possible.
   ## They will always be signaled if they exist.
@@ -156,7 +155,7 @@ value.Future <- function(future, stdout = TRUE, signal = TRUE, ...) {
 
 
   ## Check for non-exportable objects in the value?
-  onReference <- getOption("future.globals.onReference", "ignore")
+  onReference <- future[["onReference"]]
   if (onReference %in% c("error", "warning")) {
     new <- tryCatch({
       assert_no_references(value, action = onReference, source = "value")
@@ -208,7 +207,7 @@ value.Future <- function(future, stdout = TRUE, signal = TRUE, ...) {
     }
   }
 
-  if (visible) value else invisible(value)
+  if (isTRUE(visible)) value else invisible(value)
 }
 
 

R/protected_api-globals.R

@@ -30,7 +30,7 @@
 #' @export
 #'
 #' @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", 500 * 1024 ^ 2), ...) {
+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", 500 * 1024 ^ 2), onReference = getOption("future.globals.onReference", "ignore"), ...) {
   if (is.null(resolve)) {
     resolve <- FALSE
   } else {
@@ -385,13 +385,12 @@ getGlobalsAndPackages <- function(expr, envir = parent.frame(), tweak = tweakExp
 
   ## Protect against references?
   if (length(globals) > 0L) {
-    action <- getOption("future.globals.onReference", "ignore")
-    if (action != "ignore") {
+    if (onReference != "ignore") {
       if (debug) {
-        mdebugf("Checking for globals with references (future.globals.onReference = \"%s\") ...", action, appendLF = FALSE)
+        mdebugf("Checking for globals with references (future.globals.onReference = \"%s\") ...", onReference, appendLF = FALSE)
       }
       t <- system.time({
-        assert_no_references(globals, action = action)
+        assert_no_references(globals, action = onReference)
       }, gcFirst = FALSE)
       if (debug) mdebugf("[%.3f s]", t[3])
     }

R/protected_api-signalConditions.R

@@ -25,6 +25,9 @@
 #'
 #' @keywords internal
 signalConditions <- function(future, include = "condition", exclude = NULL, resignal = TRUE, ...) {
+  ## Nothing to do?
+  if (length(include) == 0L) return(invisible(future))
+  
   ## Future is not yet launched
   if (!future[["state"]] %in% c("finished", "failed")) {
     stop(FutureError(
@@ -34,9 +37,6 @@ signalConditions <- function(future, include = "condition", exclude = NULL, resi
       future = future))
   }
 
-  ## Nothing to do?
-  if (length(include) == 0L) return(invisible(future))
-  
   result <- result(future)
   stop_if_not(inherits(result, "FutureResult"))
 

R/utils_api-futureCall.R

@@ -32,17 +32,18 @@ futureCall <- function(FUN, args = list(), envir = parent.frame(), lazy = FALSE,
 #  envir <- new.env(parent = envir)
 
   expr <- quote(do.call(what = FUN, args = args))
-  
+
+
   ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   ## 1. Global variables
   ## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
   if (is.logical(globals)) {
     ## Gather all globals?
     if (globals) {
       if (debug) mdebug("Finding globals ...")
-
+      onReference <- getOption("future.globals.onReference", "ignore")
 #      expr <- do.call(call, args = c(list("FUN"), list(...)))
-      gp <- getGlobalsAndPackages(expr, envir = globalEnv, tweak = tweakExpression, globals = TRUE)
+      gp <- getGlobalsAndPackages(expr, envir = globalEnv, tweak = tweakExpression, globals = TRUE, onReference = onReference)
       globals <- gp[["globals"]]
       packages <- unique(c(packages, gp[["packages"]]))
       gp <- NULL