BUG FIX: future(fcn(), globals=list(a=42, fcn=function() a)) would fail

with "Error in fcn() : object 'a' not found" when using sequential or
multicore futures.

This affected also map-reduce calls such as:

  future.apply::future_lapply(1, function(x) a, future.globals=list(a=42))

Fixes #515

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: future
-Version: 1.21.0-9002
+Version: 1.21.0-9003
 Title: Unified Parallel and Distributed Processing in R for Everyone
 Imports:
     digest,

NEWS

@@ -1,7 +1,7 @@
 Package: future
 ===============
 
-Version: 1.21.0-9002 [2021-06-08]
+Version: 1.21.0-9003 [2021-06-15]
 
 SIGNIFICANT CHANGES:
 
@@ -77,6 +77,11 @@ BUG FIXES:
    'future.apply' or 'furrr' map-reduce functions when using a 'multisession'
    backend.
 
+ * future(fcn(), globals=list(a=42, fcn=function() a)) would fail with "Error
+   in fcn() : object 'a' not found" when using sequential or multicore futures.
+   This affected also map-reduce calls such as future.apply::future_lapply(1,
+   function(x) a, future.globals=list(a=42)).
+
  * Resolving a 'sequential' future without globals would result in internal
    several '...future.*' objects being written to the calling environment,
    which might be the global environment.

R/MulticoreFuture-class.R

@@ -25,22 +25,16 @@ MulticoreFuture <- function(expr = NULL, substitute = TRUE, envir = parent.frame
     if (length(gp) > 0L) {
       if (lazy || assignToTarget || !identical(expr, gp$expr)) {
         expr <- gp$expr
-        target <- new.env(parent = envir)
-        globalsT <- gp$globals
-        for (name in names(globalsT)) {
-          target[[name]] <- globalsT[[name]]
-        }
-        globalsT <- NULL
-        envir <- target
+        globals <- gp$globals
+        envir <- new.env(parent = envir)
+        envir <- assign_globals(envir, globals = globals)
+        globals <- NULL
       }
     }
     gp <- NULL
   } else {
-    target <- new.env(parent = envir)
-    for (name in names(globals)) {
-      target[[name]] <- globals[[name]]
-    }
-    envir <- target
+    envir <- new.env(parent = envir)
+    envir <- assign_globals(envir, globals = globals)
   }
 
   future <- MultiprocessFuture(expr = expr, substitute = FALSE, envir = envir, lazy = lazy, ...)

R/UniprocessFuture-class.R

@@ -62,9 +62,7 @@ run.UniprocessFuture <- function(future, ...) {
   ## Assign globals to separate "globals" enclosure environment?
   globals <- future$globals
   if (length(globals) > 0) {
-    for (name in names(globals)) {
-      envir[[name]] <- globals[[name]]
-    }
+    envir <- assign_globals(envir, globals = globals)
   }
 
   ## Run future

R/utils.R

@@ -129,6 +129,43 @@ envname <- function(env) {
   name
 }
 
+
+inherits_from_namespace <- function(env) {
+  while (!identical(env, emptyenv())) {
+    if (is.null(env)) return(TRUE) ## primitive functions, e.g. base::sum()
+    if (isNamespace(env)) return(TRUE)
+    if (identical(env, globalenv())) return(FALSE)
+    env <- parent.env(env)
+  }
+  FALSE
+}
+
+
+## Assign globals to an specific environment and set that environment
+## for functions, unless they are functions of namespaces/packages
+## https://github.com/HenrikBengtsson/future/issues/515
+assign_globals <- function(envir, globals) {
+  stop_if_not(is.environment(envir), is.list(globals))
+  if (length(globals) == 0L) return(envir)
+  names <- names(globals)
+  where <- attr(globals, "where")
+  for (name in names) {
+    global <- globals[[name]]
+    e <- environment(global)
+    if (!inherits_from_namespace(e)) {
+      where <- where[[name]]
+      ## FIXME: Can we remove this?
+      ## Here I'm just being overly conservative ## /HB 2021-06-15
+      if (identical(where, emptyenv())) {
+        environment(global) <- envir
+      }
+    }
+    envir[[name]] <- global
+  }
+  invisible(envir)
+}
+
+
 now <- function(x = Sys.time(), format = "[%H:%M:%OS3] ") {
   ## format(x, format = format) ## slower
   format(as.POSIXlt(x, tz = ""), format = format)

tests/globals,manual.R

@@ -24,7 +24,7 @@ message("*** Globals manually specified as named list ...")
 globals <- list(
   a = 1,
   b = 2,
-  sumtwo = function(x) x[1] + x[2]
+  sumtwo = function(x) x[a] + x[b]
 )
 
 ## Assign 'globals' globally