Add support for globals = structure(TRUE, ignore = ..., add = ...) [#227

]

NEWS

@@ -7,8 +7,9 @@ NEW FEATURES:
 
  o Add support for manually specifying globals in addition to those that are
    automatically identified via argument 'globals' or %globals%. Two examples
-   are globals = structure(TRUE, add = c("a", "b")) and
-   globals = structure(TRUE, add = list(a = 42L, b = 3.14)).
+   are globals = structure(TRUE, add = list(a = 42L, b = 3.14)) and
+   globals = structure(TRUE, add = c("a", "b")).  Analogously, attribute
+   'ignore' can be used to exclude automatically identified globals.
 
  o Add makeClusterMPI(n) for creating MPI-based clusters of a similar kind as
    parallel::makeCluster(n, type = "MPI") but that also attempts to workaound

R/future.R

@@ -162,6 +162,14 @@
 #' }
 #' Both are effectively the same.
 #'
+#'
+#' Although rarely needed, a combination of automatic identification and manual
+#' specification of globals is supported via attributes \code{add} and
+#' \code{ignore} on value \code{TRUE}.  For example, with
+#' \code{globals = structure(TRUE, ignore = "b", add = "a")} any globals
+#' automatically identified except \code{b} will be used in addition to
+#' global \code{a}.
+#'
 #' When using future assignments, globals can be specified analogously
 #' using the \code{\link{\%globals\%}} operator, e.g.
 #' \preformatted{

R/globals.R

@@ -45,29 +45,36 @@ getGlobalsAndPackages <- function(expr, envir = parent.frame(), tweak = tweakExp
     mustExist <- is.element(globals.onMissing, "error")
   }
 
-  ## Any manually added globals?
-  add <- attr(globals, "add", exact = TRUE)
-  if (!is.null(add)) {
-    if (is.character(add)) {
-      if (debug) mdebug("Retrieving 'add' globals ...")
-      add <- globalsByName(add, envir = envir, mustExist = mustExist)
-      if (debug) mdebug("- 'add' globals retrieved: [%d] %s", length(add), hpaste(sQuote(names(add))))
-      if (debug) mdebug("Retrieving 'add' globals ... DONE")
-    } else if (inherits(add, "Globals")) {
-      if (debug) mdebug("- 'add' globals passed as-is: [%d] %s", length(add), hpaste(sQuote(names(add))))
-    } else if (is.list(add)) {
-      if (debug) mdebug("- 'add' globals passed as-list: [%d] %s", length(add), hpaste(sQuote(names(add))))
-    } else {
-      stop("Attribute 'add' of argument 'globals' must be either a character vector or a named list: ", mode(add))
-    }
-    add <- as.FutureGlobals(add)
-    stop_if_not(inherits(add, "FutureGlobals"))
-  }
-
   if (is.logical(globals)) {
     stop_if_not(length(globals) == 1, !is.na(globals))
+
+    ## Any manually added globals?
+    add <- attr(globals, "add", exact = TRUE)
+    if (!is.null(add)) {
+      if (is.character(add)) {
+        if (debug) mdebug("Retrieving 'add' globals ...")
+        add <- globalsByName(add, envir = envir, mustExist = mustExist)
+        if (debug) mdebug("- 'add' globals retrieved: [%d] %s", length(add), hpaste(sQuote(names(add))))
+        if (debug) mdebug("Retrieving 'add' globals ... DONE")
+      } else if (inherits(add, "Globals")) {
+        if (debug) mdebug("- 'add' globals passed as-is: [%d] %s", length(add), hpaste(sQuote(names(add))))
+      } else if (is.list(add)) {
+        if (debug) mdebug("- 'add' globals passed as-list: [%d] %s", length(add), hpaste(sQuote(names(add))))
+      } else {
+        stop("Attribute 'add' of argument 'globals' must be either a character vector or a named list: ", mode(add))
+      }
+      add <- as.FutureGlobals(add)
+      stop_if_not(inherits(add, "FutureGlobals"))
+    }
+
+    ## Any manually dropped/ignored globals?
+    ignore <- attr(globals, "ignore", exact = TRUE)
+    if (!is.null(ignore)) {
+      stop_if_not(is.character(ignore))
+    }
+
     if (globals) {
-      if (debug) mdebug("Searching for globals ...")
+      if (debug) mdebug("Searching for globals...")
       ## Algorithm for identifying globals
       globals.method <- getOption("future.globals.method", "ordered")
       globals <- globalsOf(
@@ -87,6 +94,19 @@ getGlobalsAndPackages <- function(expr, envir = parent.frame(), tweak = tweakExp
       if (debug) mdebug("Not searching for globals")
       globals <- FutureGlobals()
     }
+
+    ## Drop 'ignore' globals?
+    ## FIXME: This should really be implemented in globals::globalsOf()
+    if (!is.null(ignore)) {
+      if (any(ignore %in% names(globals))) {
+        globals <- globals[setdiff(names(globals), ignore)]
+      }
+    }
+
+    ## Append 'add' globals?
+    if (inherits(add, "FutureGlobals")) {
+      globals <- unique(c(globals, add))
+    }
   } else if (is.character(globals)) {
     if (debug) mdebug("Retrieving globals ...")
     globals <- globalsByName(globals, envir = envir, mustExist = mustExist)
@@ -103,11 +123,6 @@ getGlobalsAndPackages <- function(expr, envir = parent.frame(), tweak = tweakExp
   globals <- as.FutureGlobals(globals)
   stop_if_not(inherits(globals, "FutureGlobals"))
 
-  ## Append 'add' globals?
-  if (inherits(add, "FutureGlobals")) {
-    globals <- unique(c(globals, add))
-  }
-
   ## Nothing more to do?
   if (length(globals) == 0) {
     if (debug) {

tests/globals,manual.R

@@ -276,6 +276,24 @@ for (strategy in supportedStrategies()) {
 
   message("- Packages - manual ...")
 
+  a <- 42
+  message("  + future(..., globals = FALSE)")
+  res <- tryCatch({
+    f <- future({ 2 * a }, globals = FALSE)
+    v <- value(f)
+    print(head(v))
+  }, error = identity)
+  stopifnot(!inherits(f, "ClusterFuture") || inherits(res, "error"))
+
+  message("  + future(..., globals = structure(TRUE, ignore = 'a'))")
+  res <- tryCatch({
+    f <- future({ 2 * a }, globals = structure(TRUE, ignore = "a"))
+    v <- value(f)
+    print(head(v))
+  }, error = identity)
+  stopifnot(!inherits(f, "ClusterFuture") || inherits(res, "error"))
+
+  message("  + future(iris, globals = TRUE) without 'datasets'")
   ## Make sure 'iris', and thereby the 'datasets' package,
   ## is not picked up as a global
   unloadNamespace("datasets")