BUG FIX: Attributes 'add' and 'ignore' of argument 'future.globals' w…

…ere ignored [#37]
futureverse · Feb 6, 2019 · bb723da · bb723da
1 parent 88820ba
commit bb723da
Show file tree

Hide file tree

Showing 3 changed files with 36 additions and 20 deletions.
diff --git a/NEWS b/NEWS
@@ -1,9 +1,12 @@
 Package: future.apply
 =====================
 
-Version: 1.1.0-9000 [2019-01-16]
+Version: 1.1.0-9000 [2019-02-06]
 
- * ...
+BUG FIXES:
+
+ * Attributes 'add' and 'ignore' of argument 'future.globals' were ignored
+   although support for them was added in future (>= 1.10.0).
 
 
 Version: 1.1.0 [2019-01-16]

diff --git a/R/globals.R b/R/globals.R
@@ -1,9 +1,5 @@
 getGlobalsAndPackagesXApply <- function(FUN, args = NULL, MoreArgs = NULL, envir, future.globals = TRUE, future.packages = NULL, debug = getOption("future.debug", FALSE)) {
-  if (is.null(args)) {
-    use_args <- FALSE
-  } else {
-    use_args <- TRUE
-  }
+  use_args <- !is.null(args)
 
   packages <- NULL
   globals <- future.globals
@@ -15,20 +11,20 @@ getGlobalsAndPackagesXApply <- function(FUN, args = NULL, MoreArgs = NULL, envir
       scanForGlobals <- TRUE
       expr <- do.call(call, args = c(list("FUN"),
                                      if (use_args) args else MoreArgs))
-      gp <- getGlobalsAndPackages(expr, envir = envir, globals = TRUE)
-      globals <- gp$globals
-      packages <- gp$packages
-      gp <- NULL
-
-      if (debug) {
-        mdebug(" - globals found: [%d] %s", length(globals), hpaste(sQuote(names(globals))))
-        mdebug(" - needed namespaces: [%d] %s", length(packages), hpaste(sQuote(packages)))
-        mdebug("Finding globals ... DONE")
-      }
     } else {
-      ## globals = FALSE
-      globals <- c("FUN", if (use_args) "..." else "MoreArgs")
-      globals <- globalsByName(globals, envir = envir, mustExist = FALSE)
+      expr <- NULL
+      attr(globals, "add") <- c(attr(globals, "add"),
+                                c("FUN", if (use_args) "..." else "MoreArgs"))
+    }
+    gp <- getGlobalsAndPackages(expr, envir = envir, globals = globals)
+    globals <- gp$globals
+    packages <- gp$packages
+    gp <- NULL
+
+    if (debug) {
+      mdebug(" - globals found/used: [%d] %s", length(globals), hpaste(sQuote(names(globals))))
+      mdebug(" - needed namespaces: [%d] %s", length(packages), hpaste(sQuote(packages)))
+      mdebug("Finding globals ... DONE")
     }
   } else if (is.character(globals)) {
     globals <- unique(c(globals, "FUN", if (use_args) "..." else "MoreArgs"))

diff --git a/tests/future_lapply,globals.R b/tests/future_lapply,globals.R
@@ -36,6 +36,23 @@ for (name in names(globals_set)) {
 message("*** future_lapply() - globals ... DONE")
 
 
+message("*** future_lapply() - manual globals ...")
+
+d <- 42
+y <- future_lapply(1:2, FUN = function(x) { x * d },
+                   future.globals = structure(FALSE, add = "d"))
+stopifnot(identical(y, list(42, 84)))
+
+e <- 42
+res <- tryCatch({
+  future_lapply(1:2, FUN = function(x) { 2 * e },
+                future.globals = structure(TRUE, ignore = "e"))
+}, error = identity)
+stopifnot(inherits(res, "error"))
+
+message("*** future_lapply() - manual globals ... DONE")
+
+
 
 ## Test adopted from http://stackoverflow.com/questions/42561088/nested-do-call-within-a-foreach-dopar-environment-cant-find-function-passed-w