From 054b9f4b0dbbb1838b73fcd7a3570942a12dd8e5 Mon Sep 17 00:00:00 2001 From: Henrik Bengtsson Date: Fri, 6 May 2022 17:49:45 -0700 Subject: [PATCH] BUG FIX: Globals tied to a function environment would get decoupled from the function for some future backends, including sequential and multicore [#608] --- DESCRIPTION | 2 +- NEWS | 11 ++++++++++- R/utils.R | 15 ++++++++++----- tests/globals,S4methods.R | 35 +++++++++++++++++++++-------------- 4 files changed, 42 insertions(+), 21 deletions(-) diff --git a/DESCRIPTION b/DESCRIPTION index d1961873..f33f3032 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,5 +1,5 @@ Package: future -Version: 1.25.0-9010 +Version: 1.25.0-9011 Title: Unified Parallel and Distributed Processing in R for Everyone Imports: digest, diff --git a/NEWS b/NEWS index 3e9790b2..79be1560 100644 --- a/NEWS +++ b/NEWS @@ -1,7 +1,7 @@ Package: future =============== -Version: 1.25.0-9010 [2022-05-06] +Version: 1.25.0-9011 [2022-05-06] SIGNIFICANT CHANGES: @@ -21,6 +21,15 @@ SIGNIFICANT CHANGES: BUG FIXES: + * Globals tied to a function environment would get decoupled from the + function for some future backends, including sequential and + multicore. For example, with 'a' would be decoupled from g() in + g <- local({ a <- 0; function() a }). This would cause problems if + we also defined h <-local({ a <- 1; function() a }) and attempted a + future as future({ h() - g() }). This future would incorrectly + resolve to value 0 for sequential and multicore futures, although + the value should be h() - g() = 1. + * Use of data.table in cluster and multisession futures broke in future 1.25.0, resulting in errors such as "Error in setalloccol(ans) : verbose must be TRUE or FALSE". See above diff --git a/R/utils.R b/R/utils.R index da0b7ed9..e46ca0ee 100644 --- a/R/utils.R +++ b/R/utils.R @@ -176,14 +176,19 @@ assign_globals <- function(envir, globals, exclude = getOption("future.assign_gl e <- environment(global) if (!inherits_from_namespace(e)) { w <- where[[name]] - ## FIXME: Can we remove this? - ## Here I'm just being overly conservative ## /HB 2021-06-15 - if (identical(w, emptyenv())) { + + ## If a global has 'where' %in% emptyenv() or globalenv(), + ## then it should be moved to the 'envir' environment. + ## Related to: + ## * https://github.com/HenrikBengtsson/future/issues/475 + ## * https://github.com/HenrikBengtsson/future/issues/515 + ## * https://github.com/HenrikBengtsson/future/issues/608 + if (identical(w, emptyenv()) || identical(w, globalenv())) { environment(global) <- envir + where[[name]] <- envir + globals[[name]] <- global if (debug) { mdebugf("- reassign environment for %s", sQuote(name)) - where[[name]] <- envir - globals[[name]] <- global } } } diff --git a/tests/globals,S4methods.R b/tests/globals,S4methods.R index ec9d8fd4..40acf8ce 100644 --- a/tests/globals,S4methods.R +++ b/tests/globals,S4methods.R @@ -5,13 +5,9 @@ keepWhere <- getOption("future.globals.keepWhere") message("*** Globals - S4 methods ...") -setGeneric("my_fcn", function(x) { - standardGeneric("my_fcn") -}) +setGeneric("my_fcn", function(x) standardGeneric("my_fcn")) -setMethod("my_fcn", methods::signature(x = "numeric"), function(x) { - x^2 -}) +setMethod("my_fcn", signature(x = "numeric"), function(x) { x^2 }) truth <- my_fcn(3) @@ -19,16 +15,27 @@ for (strategy in supportedStrategies()) { message("Type of future: ", strategy) plan(strategy) - ## WORKAROUND: https://github.com/HenrikBengtsson/future/issues/615 - ## Apply workaround if and only if 'future.globals.keepWhere' is not set - if (is.null(keepWhere) && strategy %in% c("sequential", "multicore")) { - options(future.globals.keepWhere = TRUE) - } - - f <- future({ my_fcn(3) }) + ## Assert that S4 generic function 'my_fcn()' is exported + f <- future({ my_fcn }, lazy = TRUE) + rm(list = "my_fcn") v <- value(f) print(v) - stopifnot(v == truth) + stopifnot( + is.function(v), + inherits(v, "nonstandardGenericFunction") + ) + my_fcn <- v + + ## FIXME: + ## Just like S3 methods, S4 methods are not picked up + ## https://github.com/HenrikBengtsson/future/issues/615 + f <- future({ my_fcn(3) }, lazy = TRUE) + res <- tryCatch({ + v <- value(f) + }, error = identity) + print(res) + stopifnot(inherits(res, "error")) + ## stopifnot(v == truth) ## Make sure to reset option, if changed options(future.globals.keepWhere = keepWhere)