Skip to content

Commit bcc7db6

Browse files
HenrikBengtssonHenrikBengtsson
committed
evalFuture(): Temporarily hide variables in parent environments that masks global variables
1 parent f4489d5 commit bcc7db6

File tree

5 files changed

+59
-32
lines changed

5 files changed

+59
-32
lines changed

‎DESCRIPTION‎

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,5 @@
11
Package: future
2-
Version: 1.34.0-9110
2+
Version: 1.34.0-9111
33
Title: Unified Parallel and Distributed Processing in R for Everyone
44
Imports:
55
digest,

‎R/expressions.R‎

Lines changed: 33 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -331,7 +331,7 @@ evalFuture <- function(
331331
## /HB 2018-12-28
332332
skip <- getOption("future.makeExpression.skip", c(6L, 3L))
333333
}
334-
334+
335335
## Ignore, capture or discard standard output?
336336
if (is.na(stdout)) { ## stdout = NA
337337
## Don't capture, but also don't block any output
@@ -448,26 +448,44 @@ evalFuture <- function(
448448
## Attach globals to the global environment
449449
## Undo changes on exit
450450
if (length(globals) > 0) {
451-
## Preserve globals
452-
genvOld <- new.env(parent = emptyenv())
453-
genv <- globalenv()
454-
for (name in names(globals)) {
455-
if (exists(name, envir = genv, inherits = FALSE)) {
456-
value <- get(name, envir = genv, inherits = FALSE)
457-
assign(name, value = value, envir = genvOld, inherits = FALSE)
451+
## Preserve globals in all environments until the global environment
452+
names <- names(globals)
453+
envs <- list()
454+
oldEnvs <- list()
455+
env <- envir
456+
repeat {
457+
if (identical(env, emptyenv())) break
458+
if (isNamespace(env)) {
459+
env <- parent.env(env)
460+
next
461+
}
462+
463+
oldEnv <- new.env(parent = emptyenv())
464+
for (name in names) {
465+
if (exists(name, envir = env, inherits = FALSE)) {
466+
value <- get(name, envir = env, inherits = FALSE)
467+
assign(name, value = value, envir = oldEnv, inherits = FALSE)
468+
rm(list = name, envir = env, inherits = FALSE)
469+
}
458470
}
471+
envs <- c(envs, env)
472+
oldEnvs <- c(oldEnvs, oldEnv)
473+
if (identical(env, globalenv())) break
474+
env <- parent.env(env)
459475
}
476+
460477
on.exit({
461478
## Remove globals from the global environment
462479
rm(list = names(globals), envir = genv, inherits = FALSE)
463-
## Restore overwritten objects in the global environment
464-
for (name in names(genvOld)) {
465-
if (exists(name, envir = genvOld, inherits = FALSE)) {
466-
value <- get(name, envir = genvOld, inherits = FALSE)
467-
assign(name, value = value, envir = genv, inherits = FALSE)
480+
## Restore objects in all modified environments
481+
for (ee in seq_along(envs)) {
482+
oldEnv <- oldEnvs[[ee]]
483+
env <- envs[[ee]]
484+
for (name in names(oldEnv)) {
485+
value <- get(name, envir = oldEnv, inherits = FALSE)
486+
assign(name, value = value, envir = env, inherits = FALSE)
468487
}
469-
}
470-
rm(list = "genvOld")
488+
} ## for (ee ...)
471489
}, add = TRUE)
472490

473491
assign_globals(globalenv(), globals = globals)

‎R/futureAssign.R‎

Lines changed: 5 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -23,13 +23,11 @@
2323
futureAssign <- function(x, value, envir = parent.frame(), substitute = TRUE, lazy = FALSE, seed = FALSE, globals = TRUE, packages = NULL, stdout = TRUE, conditions = "condition", earlySignal = FALSE, label = NULL, gc = FALSE, ..., assign.env = envir) {
2424
stop_if_not(is.character(x), !is.na(x), nzchar(x))
2525
if (substitute) value <- substitute(value)
26-
27-
26+
2827
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
2928
## (1) Arguments passed to future()
3029
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
3130
future.args <- list(value, envir = envir, lazy = lazy, seed = seed, globals = globals, packages = packages, stdout = stdout, conditions = conditions, earlySignal = earlySignal, label = label, gc = gc, ...)
32-
3331
## Any arguments set via disposible option?
3432
args <- getOption("future.disposable", NULL)
3533
if (!is.null(args)) {
@@ -43,16 +41,16 @@ futureAssign <- function(x, value, envir = parent.frame(), substitute = TRUE, la
4341
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
4442
## Name of "future" saved in parallel with the "promise"
4543
future_name <- sprintf(".future_%s", x)
46-
if (exists(future_name, envir = envir)) {
47-
msg <- sprintf("A future with name %s already exists in environment %s: %s", sQuote(future_name), sQuote(environmentName(envir)), hpaste(ls(envir = envir, all.names = TRUE)))
44+
if (exists(future_name, envir = assign.env)) {
45+
msg <- sprintf("A future with name %s already exists in environment %s: %s", sQuote(future_name), sQuote(environmentName(assign.env)), hpaste(ls(envir = assign.env, all.names = TRUE)))
4846
## warning(msg)
4947
}
5048

5149
## Evaluate expression/value as a "future" and assign its value to
5250
## a variable as a "promise".
5351
## NOTE: We make sure to pass 'envir' in order for globals to
5452
## be located properly.
55-
future <- do.call(future::future, args = future.args, envir = assign.env)
53+
future <- do.call(future::future, args = future.args, envir = envir)
5654

5755
## Assign future to assignment environment
5856
future_without_gc <- future
@@ -61,7 +59,7 @@ futureAssign <- function(x, value, envir = parent.frame(), substitute = TRUE, la
6159

6260

6361
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
64-
## (2) Create promise holding the future's value
62+
## (3) Create promise holding the future's value
6563
## - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
6664
## Here value may throw an error causing the assign value to be a
6765
## "delayed" error, which will be thrown each time the variable is

‎R/futureCall.R‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -28,7 +28,7 @@ futureCall <- function(FUN, args = list(), envir = parent.frame(), lazy = FALSE,
2828
## from the current environment in order to identify the globals of
2929
## arguments 'FUN' and 'args', cf. future.apply::future_lapply().
3030
## /HB 2018-03-06
31-
envir <- environment()
31+
globalEnv <- environment()
3232
# envir <- new.env(parent = envir)
3333

3434
expr <- quote(do.call(what = FUN, args = args))
@@ -42,7 +42,7 @@ futureCall <- function(FUN, args = list(), envir = parent.frame(), lazy = FALSE,
4242
if (debug) mdebug("Finding globals ...")
4343

4444
# expr <- do.call(call, args = c(list("FUN"), list(...)))
45-
gp <- getGlobalsAndPackages(expr, envir = envir, tweak = tweakExpression, globals = TRUE)
45+
gp <- getGlobalsAndPackages(expr, envir = globalEnv, tweak = tweakExpression, globals = TRUE)
4646
globals <- gp$globals
4747
packages <- unique(c(packages, gp$packages))
4848
gp <- NULL
@@ -55,11 +55,11 @@ futureCall <- function(FUN, args = list(), envir = parent.frame(), lazy = FALSE,
5555
} else {
5656
## globals = FALSE
5757
globals <- c("FUN", "args")
58-
globals <- globalsByName(globals, envir = envir, mustExist = FALSE)
58+
globals <- globalsByName(globals, envir = globalEnv, mustExist = FALSE)
5959
}
6060
} else if (is.character(globals)) {
6161
globals <- unique(c(globals, "FUN", "args"))
62-
globals <- globalsByName(globals, envir = envir, mustExist = FALSE)
62+
globals <- globalsByName(globals, envir = globalEnv, mustExist = FALSE)
6363
} else if (is.list(globals)) {
6464
names <- names(globals)
6565
if (length(globals) > 0 && is.null(names)) {

‎tests/futureCall.R‎

Lines changed: 16 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -58,11 +58,17 @@ for (cores in 1:availCores) {
5858
v1 <- value(f)
5959
}, error = identity)
6060
stopifnot(!inherits(res1, "FutureError"))
61+
utils::str(list(strategy = strategy, globals = globals, lazy = lazy, v0 = v0, res1 = res1))
6162
if (isTRUE(as.logical(Sys.getenv("R_CHECK_IDEAL")))) {
63+
message("R_CHECK_IDEAL=TRUE")
6264
if (globals) {
6365
stopifnot(all.equal(v1, v0))
6466
} else {
65-
stopifnot(inherits(res1, "error"))
67+
if (!lazy && strategy %in% c("sequential", "multicore")) {
68+
stopifnot(all.equal(v1, v0))
69+
} else {
70+
stopifnot(inherits(res1, "error"))
71+
}
6672
}
6773
} else {
6874
if (!inherits(res1, "error")) {
@@ -84,11 +90,13 @@ for (cores in 1:availCores) {
8490
v2 <- value(f)
8591
}, error = identity)
8692
stopifnot(!inherits(res2, "FutureError"))
93+
utils::str(list(strategy = strategy, globals = globals, lazy = lazy, v0 = v0, res2 = res2))
8794
if (isTRUE(as.logical(Sys.getenv("R_CHECK_IDEAL")))) {
95+
message("R_CHECK_IDEAL=TRUE")
8896
if (globals) {
8997
stopifnot(all.equal(v2, v0))
9098
} else {
91-
stopifnot(inherits(res2, "error"))
99+
stopifnot(all.equal(v2, v0))
92100
}
93101
} else {
94102
if (!inherits(res2, "error")) {
@@ -109,11 +117,13 @@ for (cores in 1:availCores) {
109117
v3 <- value(f)
110118
}, error = identity)
111119
stopifnot(!inherits(res3, "FutureError"))
120+
utils::str(list(strategy = strategy, globals = globals, lazy = lazy, v0 = v0, res3 = res3))
112121
if (isTRUE(as.logical(Sys.getenv("R_CHECK_IDEAL")))) {
122+
message("R_CHECK_IDEAL=TRUE")
113123
if (globals) {
114124
stopifnot(all.equal(v3, v0))
115125
} else {
116-
stopifnot(inherits(res3, "error"))
126+
stopifnot(all.equal(v3, v0))
117127
}
118128
} else {
119129
if (!inherits(res3, "error")) {
@@ -175,7 +185,7 @@ for (cores in 1:availCores) {
175185
} else if (lazy) {
176186
stopifnot(inherits(v4, "error"))
177187
} else if (strategy %in% c("sequential", "multicore")) {
178-
stopifnot(identical(v4, truth))
188+
stopifnot(inherits(v4, "error"))
179189
} else {
180190
stopifnot(inherits(v4, "error"))
181191
}
@@ -186,7 +196,8 @@ for (cores in 1:availCores) {
186196
} else if (lazy) {
187197
stopifnot(inherits(v4, "error"))
188198
} else {
189-
stopifnot(identical(v4, truth))
199+
stopifnot(inherits(v4, "error"))
200+
# stopifnot(identical(v4, truth))
190201
}
191202
}
192203
}

0 commit comments

Comments
 (0)