Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Globalenv variables are not picked up by future::getGlobalsAndPackages #548

Open
dipterix opened this issue Oct 11, 2021 · 4 comments
Open
Labels

Comments

@dipterix
Copy link

Describe the bug

I found variables in the globalenv are not correctly picked up. Not sure if this is on purpose

Reproduce example

env <- new.env()
d <- 1
env$a <- function(b){
  b + d
}
future::plan("multisession")
f <- future::future({
  env$a(1)
})
future::value(f)
#> Error in env$a(1) : object 'd' not found

Expected behavior

Variable d is not picked up by future::getGlobalsAndPackages, otherwise the result should be 2

Session information
Please share your session information after the error has occurred so that we also see which packages and versions are involved, e.g.

> sessionInfo()
R version 4.1.1 (2021-08-10)
Platform: aarch64-apple-darwin20 (64-bit)
Running under: macOS Big Sur 11.5.2

Matrix products: default
LAPACK: /Library/Frameworks/R.framework/Versions/4.1-arm64/Resources/lib/libRlapack.dylib

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

attached base packages:
[1] stats     graphics  grDevices utils     datasets  methods   base     

loaded via a namespace (and not attached):
[1] compiler_4.1.1    parallelly_1.28.1 parallel_4.1.1    tools_4.1.1      
[5] listenv_0.8.0     codetools_0.2-18  digest_0.6.27     globals_0.14.0   
[9] future_1.22.1 
@DarwinAwardWinner
Copy link

I think I am seeing a similar problem (reprex below). Basically, I set up a situation where h_good and h_bad both call g which calls f, BUT h_bad references g as an element of a list, rather than referring to it by name in the global environment. This evidently causes future not to search the body of g for global references, which means it doesn't find f, leading to the error.

library(future)
library(future.callr)
plan(callr)
library(assertthat)
options(future.debug = TRUE)

f <- function(x) x+1
g <- function(x) f(x) + 1
my_function_list <- list(g=g)
h_good <- function(x) g(x) + 1
h_bad <- function(x) my_function_list[["g"]](x) + 1
assert_that(h_good(0) == 3)
#> [1] TRUE
assert_that(h_bad(0) == 3)
#> [1] TRUE
assert_that(value(future(h_good(0))) == 3)
#> [15:05:51.884] getGlobalsAndPackages() ...
#> [15:05:51.885] Searching for globals...
#> [15:05:51.891] - globals found: [4] 'h_good', '+', 'g', 'f'
#> [15:05:51.891] Searching for globals ... DONE
#> [15:05:51.891] Resolving globals: FALSE
#> [15:05:51.892] The total size of the 3 globals is 10.37 KiB (10616 bytes)
#> [15:05:51.892] The total size of the 3 globals exported for future expression ('h_good(0)') is 10.37 KiB.. This exceeds the maximum allowed size of 500.00 MiB (option 'future.globals.maxSize'). There are three globals: 'g' (5.59 KiB of class 'function'), 'f' (3.20 KiB of class 'function') and 'h_good' (1.57 KiB of class 'function')
#> [15:05:51.892] - globals: [3] 'h_good', 'g', 'f'
#> [15:05:51.893]
#> [15:05:51.893] getGlobalsAndPackages() ... DONE
#> [15:05:51.893] run() for 'Future' ...
#> [15:05:51.893] - state: 'created'
#> [15:05:51.894] - Future backend: 'FutureStrategy', 'callr', 'multiprocess', 'future', 'function'
#> [15:05:51.895] getGlobalsAndPackages() ...
#> [15:05:51.895] - globals passed as-is: [3] 'h_good', 'g', 'f'
#> [15:05:51.895] Resolving globals: FALSE
#> [15:05:51.895] - globals: [3] 'h_good', 'g', 'f'
#> [15:05:51.895]
#> [15:05:51.895] getGlobalsAndPackages() ... DONE
#> [15:05:51.896] - Future class: 'CallrFuture', 'MultiprocessFuture', 'Future', 'environment'
#> [15:05:51.896] - Copy elements of temporary 'CallrFuture' to final 'Future' object ...
#> [15:05:51.896]   - Field: 'label'
#> [15:05:51.896]   - Field: 'local'
#> [15:05:51.896]   - Field: 'owner'
#> [15:05:51.896]   - Field: 'envir'
#> [15:05:51.896]   - Field: 'workers'
#> [15:05:51.896]   - Field: 'packages'
#> [15:05:51.896]   - Field: 'gc'
#> [15:05:51.897]   - Field: 'conditions'
#> [15:05:51.897]   - Field: 'expr'
#> [15:05:51.897]   - Field: 'uuid'
#> [15:05:51.897]   - Field: 'supervise'
#> [15:05:51.897]   - Field: 'seed'
#> [15:05:51.897]   - Field: 'version'
#> [15:05:51.897]   - Field: 'result'
#> [15:05:51.897]   - Field: 'asynchronous'
#> [15:05:51.897]   - Field: 'calls'
#> [15:05:51.897]   - Field: 'globals'
#> [15:05:51.897]   - Field: 'stdout'
#> [15:05:51.897]   - Field: 'earlySignal'
#> [15:05:51.897]   - Field: 'lazy'
#> [15:05:51.898]   - Field: 'state'
#> [15:05:51.898] - Copy elements of temporary 'CallrFuture' to final 'Future' object ... done
#> [15:05:51.898] - Launch lazy future ...
#> [15:05:51.898] Packages needed by the future expression (n = 0): <none>
#> [15:05:51.899] Packages needed by future strategies (n = 0): <none>
#> [15:05:51.899] {
#> [15:05:51.899]     {
#> [15:05:51.899]         {
#> [15:05:51.899]             ...future.startTime <- base::Sys.time()
#> [15:05:51.899]             {
#> [15:05:51.899]                 {
#> [15:05:51.899]                   {
#> [15:05:51.899]                     {
#> [15:05:51.899]                       base::local({
#> [15:05:51.899]                         has_future <- base::requireNamespace("future", 
#> [15:05:51.899]                           quietly = TRUE)
#> [15:05:51.899]                         if (has_future) {
#> [15:05:51.899]                           ns <- base::getNamespace("future")
#> [15:05:51.899]                           version <- ns[[".package"]][["version"]]
#> [15:05:51.899]                           if (is.null(version)) 
#> [15:05:51.899]                             version <- utils::packageVersion("future")
#> [15:05:51.899]                         }
#> [15:05:51.899]                         else {
#> [15:05:51.899]                           version <- NULL
#> [15:05:51.899]                         }
#> [15:05:51.899]                         if (!has_future || version < "1.8.0") {
#> [15:05:51.899]                           info <- base::c(r_version = base::gsub("R version ", 
#> [15:05:51.899]                             "", base::R.version$version.string), 
#> [15:05:51.899]                             platform = base::sprintf("%s (%s-bit)", 
#> [15:05:51.899]                               base::R.version$platform, 8 * base::.Machine$sizeof.pointer), 
#> [15:05:51.899]                             os = base::paste(base::Sys.info()[base::c("sysname", 
#> [15:05:51.899]                               "release", "version")], collapse = " "), 
#> [15:05:51.899]                             hostname = base::Sys.info()[["nodename"]])
#> [15:05:51.899]                           info <- base::sprintf("%s: %s", base::names(info), 
#> [15:05:51.899]                             info)
#> [15:05:51.899]                           info <- base::paste(info, collapse = "; ")
#> [15:05:51.899]                           if (!has_future) {
#> [15:05:51.899]                             msg <- base::sprintf("Package 'future' is not installed on worker (%s)", 
#> [15:05:51.899]                               info)
#> [15:05:51.899]                           }
#> [15:05:51.899]                           else {
#> [15:05:51.899]                             msg <- base::sprintf("Package 'future' on worker (%s) must be of version >= 1.8.0: %s", 
#> [15:05:51.899]                               info, version)
#> [15:05:51.899]                           }
#> [15:05:51.899]                           base::stop(msg)
#> [15:05:51.899]                         }
#> [15:05:51.899]                       })
#> [15:05:51.899]                     }
#> [15:05:51.899]                     ...future.mc.cores.old <- base::getOption("mc.cores")
#> [15:05:51.899]                     base::options(mc.cores = 1L)
#> [15:05:51.899]                   }
#> [15:05:51.899]                   options(future.plan = NULL)
#> [15:05:51.899]                   Sys.unsetenv("R_FUTURE_PLAN")
#> [15:05:51.899]                   future::plan("default", .cleanup = FALSE, .init = FALSE)
#> [15:05:51.899]                 }
#> [15:05:51.899]                 ...future.workdir <- getwd()
#> [15:05:51.899]             }
#> [15:05:51.899]             ...future.oldOptions <- base::as.list(base::.Options)
#> [15:05:51.899]             ...future.oldEnvVars <- base::Sys.getenv()
#> [15:05:51.899]         }
#> [15:05:51.899]         base::options(future.startup.script = FALSE, future.globals.onMissing = NULL, 
#> [15:05:51.899]             future.globals.maxSize = NULL, future.globals.method = NULL, 
#> [15:05:51.899]             future.globals.onMissing = NULL, future.globals.onReference = NULL, 
#> [15:05:51.899]             future.globals.resolve = NULL, future.resolve.recursive = NULL, 
#> [15:05:51.899]             future.rng.onMisuse = NULL, future.rng.onMisuse.keepFuture = NULL, 
#> [15:05:51.899]             future.stdout.windows.reencode = NULL, width = 80L)
#> [15:05:51.899]         ...future.futureOptionsAdded <- base::setdiff(base::names(base::.Options), 
#> [15:05:51.899]             base::names(...future.oldOptions))
#> [15:05:51.899]     }
#> [15:05:51.899]     if (FALSE) {
#> [15:05:51.899]     }
#> [15:05:51.899]     else {
#> [15:05:51.899]         if (TRUE) {
#> [15:05:51.899]             ...future.stdout <- base::rawConnection(base::raw(0L), 
#> [15:05:51.899]                 open = "w")
#> [15:05:51.899]         }
#> [15:05:51.899]         else {
#> [15:05:51.899]             ...future.stdout <- base::file(base::switch(.Platform$OS.type, 
#> [15:05:51.899]                 windows = "NUL", "/dev/null"), open = "w")
#> [15:05:51.899]         }
#> [15:05:51.899]         base::sink(...future.stdout, type = "output", split = FALSE)
#> [15:05:51.899]         base::on.exit(if (!base::is.null(...future.stdout)) {
#> [15:05:51.899]             base::sink(type = "output", split = FALSE)
#> [15:05:51.899]             base::close(...future.stdout)
#> [15:05:51.899]         }, add = TRUE)
#> [15:05:51.899]     }
#> [15:05:51.899]     ...future.frame <- base::sys.nframe()
#> [15:05:51.899]     ...future.conditions <- base::list()
#> [15:05:51.899]     ...future.rng <- base::globalenv()$.Random.seed
#> [15:05:51.899]     if (FALSE) {
#> [15:05:51.899]         ...future.globalenv.names <- c(base::names(base::.GlobalEnv), 
#> [15:05:51.899]             "...future.value", "...future.globalenv.names", ".Random.seed")
#> [15:05:51.899]     }
#> [15:05:51.899]     ...future.result <- base::tryCatch({
#> [15:05:51.899]         base::withCallingHandlers({
#> [15:05:51.899]             ...future.value <- base::withVisible(base::local(h_good(0)))
#> [15:05:51.899]             future::FutureResult(value = ...future.value$value, 
#> [15:05:51.899]                 visible = ...future.value$visible, rng = !identical(base::globalenv()$.Random.seed, 
#> [15:05:51.899]                   ...future.rng), globalenv = if (FALSE) 
#> [15:05:51.899]                   list(added = base::setdiff(base::names(base::.GlobalEnv), 
#> [15:05:51.899]                     ...future.globalenv.names))
#> [15:05:51.899]                 else NULL, started = ...future.startTime, version = "1.8")
#> [15:05:51.899]         }, condition = base::local({
#> [15:05:51.899]             c <- base::c
#> [15:05:51.899]             inherits <- base::inherits
#> [15:05:51.899]             invokeRestart <- base::invokeRestart
#> [15:05:51.899]             length <- base::length
#> [15:05:51.899]             list <- base::list
#> [15:05:51.899]             seq.int <- base::seq.int
#> [15:05:51.899]             signalCondition <- base::signalCondition
#> [15:05:51.899]             sys.calls <- base::sys.calls
#> [15:05:51.899]             `[[` <- base::`[[`
#> [15:05:51.899]             `+` <- base::`+`
#> [15:05:51.899]             `<<-` <- base::`<<-`
#> [15:05:51.899]             sysCalls <- function(calls = sys.calls(), from = 1L) {
#> [15:05:51.899]                 calls[seq.int(from = from + 12L, to = length(calls) - 
#> [15:05:51.899]                   3L)]
#> [15:05:51.899]             }
#> [15:05:51.899]             function(cond) {
#> [15:05:51.899]                 is_error <- inherits(cond, "error")
#> [15:05:51.899]                 ignore <- !is_error && !is.null(NULL) && inherits(cond, 
#> [15:05:51.899]                   NULL)
#> [15:05:51.899]                 if (is_error) {
#> [15:05:51.899]                   sessionInformation <- function() {
#> [15:05:51.899]                     list(r = base::R.Version(), locale = base::Sys.getlocale(), 
#> [15:05:51.899]                       rngkind = base::RNGkind(), namespaces = base::loadedNamespaces(), 
#> [15:05:51.899]                       search = base::search(), system = base::Sys.info())
#> [15:05:51.899]                   }
#> [15:05:51.899]                   ...future.conditions[[length(...future.conditions) + 
#> [15:05:51.899]                     1L]] <<- list(condition = cond, calls = c(sysCalls(from = ...future.frame), 
#> [15:05:51.899]                     cond$call), session = sessionInformation(), 
#> [15:05:51.899]                     timestamp = base::Sys.time(), signaled = 0L)
#> [15:05:51.899]                   signalCondition(cond)
#> [15:05:51.899]                 }
#> [15:05:51.899]                 else if (!ignore && TRUE && inherits(cond, "condition")) {
#> [15:05:51.899]                   signal <- FALSE && inherits(cond, character(0))
#> [15:05:51.899]                   ...future.conditions[[length(...future.conditions) + 
#> [15:05:51.899]                     1L]] <<- list(condition = cond, signaled = base::as.integer(signal))
#> [15:05:51.899]                   if (FALSE && !signal) {
#> [15:05:51.899]                     muffleCondition <- function (cond, pattern = "^muffle") 
#> [15:05:51.899]                     {
#> [15:05:51.899]                       inherits <- base::inherits
#> [15:05:51.899]                       invokeRestart <- base::invokeRestart
#> [15:05:51.899]                       is.null <- base::is.null
#> [15:05:51.899]                       muffled <- FALSE
#> [15:05:51.899]                       if (inherits(cond, "message")) {
#> [15:05:51.899]                         muffled <- grepl(pattern, "muffleMessage")
#> [15:05:51.899]                         if (muffled) 
#> [15:05:51.899]                           invokeRestart("muffleMessage")
#> [15:05:51.899]                       }
#> [15:05:51.899]                       else if (inherits(cond, "warning")) {
#> [15:05:51.899]                         muffled <- grepl(pattern, "muffleWarning")
#> [15:05:51.899]                         if (muffled) 
#> [15:05:51.899]                           invokeRestart("muffleWarning")
#> [15:05:51.899]                       }
#> [15:05:51.899]                       else if (inherits(cond, "condition")) {
#> [15:05:51.899]                         if (!is.null(pattern)) {
#> [15:05:51.899]                           computeRestarts <- base::computeRestarts
#> [15:05:51.899]                           grepl <- base::grepl
#> [15:05:51.899]                           restarts <- computeRestarts(cond)
#> [15:05:51.899]                           for (restart in restarts) {
#> [15:05:51.899]                             name <- restart$name
#> [15:05:51.899]                             if (is.null(name)) 
#> [15:05:51.899]                               next
#> [15:05:51.899]                             if (!grepl(pattern, name)) 
#> [15:05:51.899]                               next
#> [15:05:51.899]                             invokeRestart(restart)
#> [15:05:51.899]                             muffled <- TRUE
#> [15:05:51.899]                             break
#> [15:05:51.899]                           }
#> [15:05:51.899]                         }
#> [15:05:51.899]                       }
#> [15:05:51.899]                       invisible(muffled)
#> [15:05:51.899]                     }
#> [15:05:51.899]                     muffleCondition(cond, pattern = "^muffle")
#> [15:05:51.899]                   }
#> [15:05:51.899]                 }
#> [15:05:51.899]                 else {
#> [15:05:51.899]                   if (TRUE) {
#> [15:05:51.899]                     muffleCondition <- function (cond, pattern = "^muffle") 
#> [15:05:51.899]                     {
#> [15:05:51.899]                       inherits <- base::inherits
#> [15:05:51.899]                       invokeRestart <- base::invokeRestart
#> [15:05:51.899]                       is.null <- base::is.null
#> [15:05:51.899]                       muffled <- FALSE
#> [15:05:51.899]                       if (inherits(cond, "message")) {
#> [15:05:51.899]                         muffled <- grepl(pattern, "muffleMessage")
#> [15:05:51.899]                         if (muffled) 
#> [15:05:51.899]                           invokeRestart("muffleMessage")
#> [15:05:51.899]                       }
#> [15:05:51.899]                       else if (inherits(cond, "warning")) {
#> [15:05:51.899]                         muffled <- grepl(pattern, "muffleWarning")
#> [15:05:51.899]                         if (muffled) 
#> [15:05:51.899]                           invokeRestart("muffleWarning")
#> [15:05:51.899]                       }
#> [15:05:51.899]                       else if (inherits(cond, "condition")) {
#> [15:05:51.899]                         if (!is.null(pattern)) {
#> [15:05:51.899]                           computeRestarts <- base::computeRestarts
#> [15:05:51.899]                           grepl <- base::grepl
#> [15:05:51.899]                           restarts <- computeRestarts(cond)
#> [15:05:51.899]                           for (restart in restarts) {
#> [15:05:51.899]                             name <- restart$name
#> [15:05:51.899]                             if (is.null(name)) 
#> [15:05:51.899]                               next
#> [15:05:51.899]                             if (!grepl(pattern, name)) 
#> [15:05:51.899]                               next
#> [15:05:51.899]                             invokeRestart(restart)
#> [15:05:51.899]                             muffled <- TRUE
#> [15:05:51.899]                             break
#> [15:05:51.899]                           }
#> [15:05:51.899]                         }
#> [15:05:51.899]                       }
#> [15:05:51.899]                       invisible(muffled)
#> [15:05:51.899]                     }
#> [15:05:51.899]                     muffleCondition(cond, pattern = "^muffle")
#> [15:05:51.899]                   }
#> [15:05:51.899]                 }
#> [15:05:51.899]             }
#> [15:05:51.899]         }))
#> [15:05:51.899]     }, error = function(ex) {
#> [15:05:51.899]         base::structure(base::list(value = NULL, visible = NULL, 
#> [15:05:51.899]             conditions = ...future.conditions, rng = !identical(base::globalenv()$.Random.seed, 
#> [15:05:51.899]                 ...future.rng), started = ...future.startTime, 
#> [15:05:51.899]             finished = Sys.time(), session_uuid = NA_character_, 
#> [15:05:51.899]             version = "1.8"), class = "FutureResult")
#> [15:05:51.899]     }, finally = {
#> [15:05:51.899]         if (!identical(...future.workdir, getwd())) 
#> [15:05:51.899]             setwd(...future.workdir)
#> [15:05:51.899]         {
#> [15:05:51.899]             if (identical(getOption("nwarnings"), ...future.oldOptions$nwarnings)) {
#> [15:05:51.899]                 ...future.oldOptions$nwarnings <- NULL
#> [15:05:51.899]             }
#> [15:05:51.899]             base::options(...future.oldOptions)
#> [15:05:51.899]             if (.Platform$OS.type == "windows") {
#> [15:05:51.899]                 old_names <- names(...future.oldEnvVars)
#> [15:05:51.899]                 envs <- base::Sys.getenv()
#> [15:05:51.899]                 names <- names(envs)
#> [15:05:51.899]                 common <- intersect(names, old_names)
#> [15:05:51.899]                 added <- setdiff(names, old_names)
#> [15:05:51.899]                 removed <- setdiff(old_names, names)
#> [15:05:51.899]                 changed <- common[...future.oldEnvVars[common] != 
#> [15:05:51.899]                   envs[common]]
#> [15:05:51.899]                 NAMES <- toupper(changed)
#> [15:05:51.899]                 args <- list()
#> [15:05:51.899]                 for (kk in seq_along(NAMES)) {
#> [15:05:51.899]                   name <- changed[[kk]]
#> [15:05:51.899]                   NAME <- NAMES[[kk]]
#> [15:05:51.899]                   if (name != NAME && is.element(NAME, old_names)) 
#> [15:05:51.899]                     next
#> [15:05:51.899]                   args[[name]] <- ...future.oldEnvVars[[name]]
#> [15:05:51.899]                 }
#> [15:05:51.899]                 NAMES <- toupper(added)
#> [15:05:51.899]                 for (kk in seq_along(NAMES)) {
#> [15:05:51.899]                   name <- added[[kk]]
#> [15:05:51.899]                   NAME <- NAMES[[kk]]
#> [15:05:51.899]                   if (name != NAME && is.element(NAME, old_names)) 
#> [15:05:51.899]                     next
#> [15:05:51.899]                   args[[name]] <- ""
#> [15:05:51.899]                 }
#> [15:05:51.899]                 NAMES <- toupper(removed)
#> [15:05:51.899]                 for (kk in seq_along(NAMES)) {
#> [15:05:51.899]                   name <- removed[[kk]]
#> [15:05:51.899]                   NAME <- NAMES[[kk]]
#> [15:05:51.899]                   if (name != NAME && is.element(NAME, old_names)) 
#> [15:05:51.899]                     next
#> [15:05:51.899]                   args[[name]] <- ...future.oldEnvVars[[name]]
#> [15:05:51.899]                 }
#> [15:05:51.899]                 if (length(args) > 0) 
#> [15:05:51.899]                   base::do.call(base::Sys.setenv, args = args)
#> [15:05:51.899]                 args <- names <- old_names <- NAMES <- envs <- common <- added <- removed <- NULL
#> [15:05:51.899]             }
#> [15:05:51.899]             else {
#> [15:05:51.899]                 base::do.call(base::Sys.setenv, args = base::as.list(...future.oldEnvVars))
#> [15:05:51.899]             }
#> [15:05:51.899]             {
#> [15:05:51.899]                 if (base::length(...future.futureOptionsAdded) > 
#> [15:05:51.899]                   0L) {
#> [15:05:51.899]                   opts <- base::vector("list", length = base::length(...future.futureOptionsAdded))
#> [15:05:51.899]                   base::names(opts) <- ...future.futureOptionsAdded
#> [15:05:51.899]                   base::options(opts)
#> [15:05:51.899]                 }
#> [15:05:51.899]                 {
#> [15:05:51.899]                   {
#> [15:05:51.899]                     base::options(mc.cores = ...future.mc.cores.old)
#> [15:05:51.899]                     NULL
#> [15:05:51.899]                   }
#> [15:05:51.899]                   options(future.plan = NULL)
#> [15:05:51.899]                   if (is.na(NA_character_)) 
#> [15:05:51.899]                     Sys.unsetenv("R_FUTURE_PLAN")
#> [15:05:51.899]                   else Sys.setenv(R_FUTURE_PLAN = NA_character_)
#> [15:05:51.899]                   future::plan(list(function (expr, envir = parent.frame(), 
#> [15:05:51.899]                     substitute = TRUE, globals = TRUE, label = NULL, 
#> [15:05:51.899]                     workers = availableCores(), ...) 
#> [15:05:51.899]                   {
#> [15:05:51.899]                     if (substitute) 
#> [15:05:51.899]                       expr <- substitute(expr)
#> [15:05:51.899]                     if (is.null(workers)) 
#> [15:05:51.899]                       workers <- availableCores()
#> [15:05:51.899]                     future <- CallrFuture(expr = expr, envir = envir, 
#> [15:05:51.899]                       substitute = FALSE, globals = globals, 
#> [15:05:51.899]                       label = label, workers = workers, ...)
#> [15:05:51.899]                     if (!future$lazy) 
#> [15:05:51.899]                       future <- run(future)
#> [15:05:51.899]                     future
#> [15:05:51.899]                   }), .cleanup = FALSE, .init = FALSE)
#> [15:05:51.899]                 }
#> [15:05:51.899]             }
#> [15:05:51.899]         }
#> [15:05:51.899]     })
#> [15:05:51.899]     if (TRUE) {
#> [15:05:51.899]         base::sink(type = "output", split = FALSE)
#> [15:05:51.899]         if (TRUE) {
#> [15:05:51.899]             ...future.result$stdout <- base::rawToChar(base::rawConnectionValue(...future.stdout))
#> [15:05:51.899]         }
#> [15:05:51.899]         else {
#> [15:05:51.899]             ...future.result["stdout"] <- base::list(NULL)
#> [15:05:51.899]         }
#> [15:05:51.899]         base::close(...future.stdout)
#> [15:05:51.899]         ...future.stdout <- NULL
#> [15:05:51.899]     }
#> [15:05:51.899]     ...future.result$conditions <- ...future.conditions
#> [15:05:51.899]     ...future.result$finished <- base::Sys.time()
#> [15:05:51.899]     ...future.result
#> [15:05:51.899] }
#> [15:05:51.934] Launched future (PID=23938)
#> [15:05:51.935] - Launch lazy future ... done
#> [15:05:51.935] run() for 'CallrFuture' ... done
#> [15:05:51.936] callr::wait() ...
#> [15:05:52.095] - iteration 100: callr::wait(timeout = 2.67803)
#> [15:05:52.431] - callr process: finished
#> [15:05:52.432] callr::wait() ... done
#> [15:05:52.432] - callr:::get_result() ...
#> [15:05:52.432] - callr:::get_result() ... done (after 4 attempts)
#> [15:05:52.432] Results:
#> [15:05:52.442] List of 11
#> [15:05:52.442]  $ value       : num 3
#> [15:05:52.442]  $ visible     : logi TRUE
#> [15:05:52.442]  $ stdout      : chr ""
#> [15:05:52.442]  $ conditions  : list()
#> [15:05:52.442]  $ rng         : logi FALSE
#> [15:05:52.442]  $ globalenv   : NULL
#> [15:05:52.442]  $ started     : POSIXct[1:1], format: "2023-09-14 15:05:52"
#> [15:05:52.442]  $ finished    : POSIXct[1:1], format: "2023-09-14 15:05:52"
#> [15:05:52.442]  $ session_uuid: chr "1bb79356-34b4-98da-727d-761fe689ab81"
#> [15:05:52.442]   ..- attr(*, "source")=List of 5
#> [15:05:52.442]   .. ..$ host  : chr "melete-2.local"
#> [15:05:52.442]   .. ..$ info  : Named chr [1:8] "Darwin" "22.6.0" "Darwin Kernel Version 22.6.0: Wed Jul  5 22:21:53 PDT 2023; root:xnu-8796.141.3~6/RELEASE_ARM64_T6020" "melete-2.local" ...
#> [15:05:52.442]   .. .. ..- attr(*, "names")= chr [1:8] "sysname" "release" "version" "nodename" ...
#> [15:05:52.442]   .. ..$ pid   : int 23938
#> [15:05:52.442]   .. ..$ time  : POSIXct[1:1], format: "2023-09-14 15:05:52"
#> [15:05:52.442]   .. ..$ random: int 2147483647
#> [15:05:52.442]  $ r_info      :List of 4
#> [15:05:52.442]   ..$ version      :Classes 'R_system_version', 'package_version', 'numeric_version'  hidden list of 1
#> [15:05:52.442]   .. ..$ : int [1:3] 4 3 1
#> [15:05:52.442]   ..$ os           : chr "unix"
#> [15:05:52.442]   ..$ os_name      : chr "Darwin"
#> [15:05:52.442]   ..$ captures_utf8: logi TRUE
#> [15:05:52.442]  $ version     : chr "1.8"
#> [15:05:52.442]  - attr(*, "class")= chr "FutureResult"
#> [15:05:52.442]
#> [1] TRUE
assert_that(value(future(h_bad(0))) == 3)
#> [15:05:52.446] getGlobalsAndPackages() ...
#> [15:05:52.446] Searching for globals...
#> [15:05:52.447] - globals found: [4] 'h_bad', '+', '[[', 'my_function_list'
#> [15:05:52.447] Searching for globals ... DONE
#> [15:05:52.447] Resolving globals: FALSE
#> [15:05:52.448] The total size of the 2 globals is 7.49 KiB (7672 bytes)
#> [15:05:52.448] The total size of the 2 globals exported for future expression ('h_bad(0)') is 7.49 KiB.. This exceeds the maximum allowed size of 500.00 MiB (option 'future.globals.maxSize'). There are two globals: 'my_function_list' (5.59 KiB of class 'list') and 'h_bad' (1.90 KiB of class 'function')
#> [15:05:52.448] - globals: [2] 'h_bad', 'my_function_list'
#> [15:05:52.449] 
#> [15:05:52.449] getGlobalsAndPackages() ... DONE
#> [15:05:52.449] run() for 'Future' ...
#> [15:05:52.449] - state: 'created'
#> [15:05:52.449] - Future backend: 'FutureStrategy', 'callr', 'multiprocess', 'future', 'function'
#> [15:05:52.451] getGlobalsAndPackages() ...
#> [15:05:52.451] - globals passed as-is: [2] 'h_bad', 'my_function_list'
#> [15:05:52.451] Resolving globals: FALSE
#> [15:05:52.451] - globals: [2] 'h_bad', 'my_function_list'
#> [15:05:52.451] 
#> [15:05:52.451] getGlobalsAndPackages() ... DONE
#> [15:05:52.452] - Future class: 'CallrFuture', 'MultiprocessFuture', 'Future', 'environment'
#> [15:05:52.452] - Copy elements of temporary 'CallrFuture' to final 'Future' object ...
#> [15:05:52.452]   - Field: 'label'
#> [15:05:52.452]   - Field: 'local'
#> [15:05:52.452]   - Field: 'owner'
#> [15:05:52.452]   - Field: 'envir'
#> [15:05:52.452]   - Field: 'workers'
#> [15:05:52.452]   - Field: 'packages'
#> [15:05:52.452]   - Field: 'gc'
#> [15:05:52.452]   - Field: 'conditions'
#> [15:05:52.452]   - Field: 'expr'
#> [15:05:52.453]   - Field: 'uuid'
#> [15:05:52.453]   - Field: 'supervise'
#> [15:05:52.453]   - Field: 'seed'
#> [15:05:52.453]   - Field: 'version'
#> [15:05:52.453]   - Field: 'result'
#> [15:05:52.453]   - Field: 'asynchronous'
#> [15:05:52.453]   - Field: 'calls'
#> [15:05:52.453]   - Field: 'globals'
#> [15:05:52.453]   - Field: 'stdout'
#> [15:05:52.453]   - Field: 'earlySignal'
#> [15:05:52.453]   - Field: 'lazy'
#> [15:05:52.453]   - Field: 'state'
#> [15:05:52.454] - Copy elements of temporary 'CallrFuture' to final 'Future' object ... done
#> [15:05:52.454] - Launch lazy future ...
#> [15:05:52.454] Packages needed by the future expression (n = 0): <none>
#> [15:05:52.454] Packages needed by future strategies (n = 0): <none>
#> [15:05:52.454] {
#> [15:05:52.454]     {
#> [15:05:52.454]         {
#> [15:05:52.454]             ...future.startTime <- base::Sys.time()
#> [15:05:52.454]             {
#> [15:05:52.454]                 {
#> [15:05:52.454]                   {
#> [15:05:52.454]                     {
#> [15:05:52.454]                       base::local({
#> [15:05:52.454]                         has_future <- base::requireNamespace("future", 
#> [15:05:52.454]                           quietly = TRUE)
#> [15:05:52.454]                         if (has_future) {
#> [15:05:52.454]                           ns <- base::getNamespace("future")
#> [15:05:52.454]                           version <- ns[[".package"]][["version"]]
#> [15:05:52.454]                           if (is.null(version)) 
#> [15:05:52.454]                             version <- utils::packageVersion("future")
#> [15:05:52.454]                         }
#> [15:05:52.454]                         else {
#> [15:05:52.454]                           version <- NULL
#> [15:05:52.454]                         }
#> [15:05:52.454]                         if (!has_future || version < "1.8.0") {
#> [15:05:52.454]                           info <- base::c(r_version = base::gsub("R version ", 
#> [15:05:52.454]                             "", base::R.version$version.string), 
#> [15:05:52.454]                             platform = base::sprintf("%s (%s-bit)", 
#> [15:05:52.454]                               base::R.version$platform, 8 * base::.Machine$sizeof.pointer), 
#> [15:05:52.454]                             os = base::paste(base::Sys.info()[base::c("sysname", 
#> [15:05:52.454]                               "release", "version")], collapse = " "), 
#> [15:05:52.454]                             hostname = base::Sys.info()[["nodename"]])
#> [15:05:52.454]                           info <- base::sprintf("%s: %s", base::names(info), 
#> [15:05:52.454]                             info)
#> [15:05:52.454]                           info <- base::paste(info, collapse = "; ")
#> [15:05:52.454]                           if (!has_future) {
#> [15:05:52.454]                             msg <- base::sprintf("Package 'future' is not installed on worker (%s)", 
#> [15:05:52.454]                               info)
#> [15:05:52.454]                           }
#> [15:05:52.454]                           else {
#> [15:05:52.454]                             msg <- base::sprintf("Package 'future' on worker (%s) must be of version >= 1.8.0: %s", 
#> [15:05:52.454]                               info, version)
#> [15:05:52.454]                           }
#> [15:05:52.454]                           base::stop(msg)
#> [15:05:52.454]                         }
#> [15:05:52.454]                       })
#> [15:05:52.454]                     }
#> [15:05:52.454]                     ...future.mc.cores.old <- base::getOption("mc.cores")
#> [15:05:52.454]                     base::options(mc.cores = 1L)
#> [15:05:52.454]                   }
#> [15:05:52.454]                   options(future.plan = NULL)
#> [15:05:52.454]                   Sys.unsetenv("R_FUTURE_PLAN")
#> [15:05:52.454]                   future::plan("default", .cleanup = FALSE, .init = FALSE)
#> [15:05:52.454]                 }
#> [15:05:52.454]                 ...future.workdir <- getwd()
#> [15:05:52.454]             }
#> [15:05:52.454]             ...future.oldOptions <- base::as.list(base::.Options)
#> [15:05:52.454]             ...future.oldEnvVars <- base::Sys.getenv()
#> [15:05:52.454]         }
#> [15:05:52.454]         base::options(future.startup.script = FALSE, future.globals.onMissing = NULL, 
#> [15:05:52.454]             future.globals.maxSize = NULL, future.globals.method = NULL, 
#> [15:05:52.454]             future.globals.onMissing = NULL, future.globals.onReference = NULL, 
#> [15:05:52.454]             future.globals.resolve = NULL, future.resolve.recursive = NULL, 
#> [15:05:52.454]             future.rng.onMisuse = NULL, future.rng.onMisuse.keepFuture = NULL, 
#> [15:05:52.454]             future.stdout.windows.reencode = NULL, width = 80L)
#> [15:05:52.454]         ...future.futureOptionsAdded <- base::setdiff(base::names(base::.Options), 
#> [15:05:52.454]             base::names(...future.oldOptions))
#> [15:05:52.454]     }
#> [15:05:52.454]     if (FALSE) {
#> [15:05:52.454]     }
#> [15:05:52.454]     else {
#> [15:05:52.454]         if (TRUE) {
#> [15:05:52.454]             ...future.stdout <- base::rawConnection(base::raw(0L), 
#> [15:05:52.454]                 open = "w")
#> [15:05:52.454]         }
#> [15:05:52.454]         else {
#> [15:05:52.454]             ...future.stdout <- base::file(base::switch(.Platform$OS.type, 
#> [15:05:52.454]                 windows = "NUL", "/dev/null"), open = "w")
#> [15:05:52.454]         }
#> [15:05:52.454]         base::sink(...future.stdout, type = "output", split = FALSE)
#> [15:05:52.454]         base::on.exit(if (!base::is.null(...future.stdout)) {
#> [15:05:52.454]             base::sink(type = "output", split = FALSE)
#> [15:05:52.454]             base::close(...future.stdout)
#> [15:05:52.454]         }, add = TRUE)
#> [15:05:52.454]     }
#> [15:05:52.454]     ...future.frame <- base::sys.nframe()
#> [15:05:52.454]     ...future.conditions <- base::list()
#> [15:05:52.454]     ...future.rng <- base::globalenv()$.Random.seed
#> [15:05:52.454]     if (FALSE) {
#> [15:05:52.454]         ...future.globalenv.names <- c(base::names(base::.GlobalEnv), 
#> [15:05:52.454]             "...future.value", "...future.globalenv.names", ".Random.seed")
#> [15:05:52.454]     }
#> [15:05:52.454]     ...future.result <- base::tryCatch({
#> [15:05:52.454]         base::withCallingHandlers({
#> [15:05:52.454]             ...future.value <- base::withVisible(base::local(h_bad(0)))
#> [15:05:52.454]             future::FutureResult(value = ...future.value$value, 
#> [15:05:52.454]                 visible = ...future.value$visible, rng = !identical(base::globalenv()$.Random.seed, 
#> [15:05:52.454]                   ...future.rng), globalenv = if (FALSE) 
#> [15:05:52.454]                   list(added = base::setdiff(base::names(base::.GlobalEnv), 
#> [15:05:52.454]                     ...future.globalenv.names))
#> [15:05:52.454]                 else NULL, started = ...future.startTime, version = "1.8")
#> [15:05:52.454]         }, condition = base::local({
#> [15:05:52.454]             c <- base::c
#> [15:05:52.454]             inherits <- base::inherits
#> [15:05:52.454]             invokeRestart <- base::invokeRestart
#> [15:05:52.454]             length <- base::length
#> [15:05:52.454]             list <- base::list
#> [15:05:52.454]             seq.int <- base::seq.int
#> [15:05:52.454]             signalCondition <- base::signalCondition
#> [15:05:52.454]             sys.calls <- base::sys.calls
#> [15:05:52.454]             `[[` <- base::`[[`
#> [15:05:52.454]             `+` <- base::`+`
#> [15:05:52.454]             `<<-` <- base::`<<-`
#> [15:05:52.454]             sysCalls <- function(calls = sys.calls(), from = 1L) {
#> [15:05:52.454]                 calls[seq.int(from = from + 12L, to = length(calls) - 
#> [15:05:52.454]                   3L)]
#> [15:05:52.454]             }
#> [15:05:52.454]             function(cond) {
#> [15:05:52.454]                 is_error <- inherits(cond, "error")
#> [15:05:52.454]                 ignore <- !is_error && !is.null(NULL) && inherits(cond, 
#> [15:05:52.454]                   NULL)
#> [15:05:52.454]                 if (is_error) {
#> [15:05:52.454]                   sessionInformation <- function() {
#> [15:05:52.454]                     list(r = base::R.Version(), locale = base::Sys.getlocale(), 
#> [15:05:52.454]                       rngkind = base::RNGkind(), namespaces = base::loadedNamespaces(), 
#> [15:05:52.454]                       search = base::search(), system = base::Sys.info())
#> [15:05:52.454]                   }
#> [15:05:52.454]                   ...future.conditions[[length(...future.conditions) + 
#> [15:05:52.454]                     1L]] <<- list(condition = cond, calls = c(sysCalls(from = ...future.frame), 
#> [15:05:52.454]                     cond$call), session = sessionInformation(), 
#> [15:05:52.454]                     timestamp = base::Sys.time(), signaled = 0L)
#> [15:05:52.454]                   signalCondition(cond)
#> [15:05:52.454]                 }
#> [15:05:52.454]                 else if (!ignore && TRUE && inherits(cond, "condition")) {
#> [15:05:52.454]                   signal <- FALSE && inherits(cond, character(0))
#> [15:05:52.454]                   ...future.conditions[[length(...future.conditions) + 
#> [15:05:52.454]                     1L]] <<- list(condition = cond, signaled = base::as.integer(signal))
#> [15:05:52.454]                   if (FALSE && !signal) {
#> [15:05:52.454]                     muffleCondition <- function (cond, pattern = "^muffle") 
#> [15:05:52.454]                     {
#> [15:05:52.454]                       inherits <- base::inherits
#> [15:05:52.454]                       invokeRestart <- base::invokeRestart
#> [15:05:52.454]                       is.null <- base::is.null
#> [15:05:52.454]                       muffled <- FALSE
#> [15:05:52.454]                       if (inherits(cond, "message")) {
#> [15:05:52.454]                         muffled <- grepl(pattern, "muffleMessage")
#> [15:05:52.454]                         if (muffled) 
#> [15:05:52.454]                           invokeRestart("muffleMessage")
#> [15:05:52.454]                       }
#> [15:05:52.454]                       else if (inherits(cond, "warning")) {
#> [15:05:52.454]                         muffled <- grepl(pattern, "muffleWarning")
#> [15:05:52.454]                         if (muffled) 
#> [15:05:52.454]                           invokeRestart("muffleWarning")
#> [15:05:52.454]                       }
#> [15:05:52.454]                       else if (inherits(cond, "condition")) {
#> [15:05:52.454]                         if (!is.null(pattern)) {
#> [15:05:52.454]                           computeRestarts <- base::computeRestarts
#> [15:05:52.454]                           grepl <- base::grepl
#> [15:05:52.454]                           restarts <- computeRestarts(cond)
#> [15:05:52.454]                           for (restart in restarts) {
#> [15:05:52.454]                             name <- restart$name
#> [15:05:52.454]                             if (is.null(name)) 
#> [15:05:52.454]                               next
#> [15:05:52.454]                             if (!grepl(pattern, name)) 
#> [15:05:52.454]                               next
#> [15:05:52.454]                             invokeRestart(restart)
#> [15:05:52.454]                             muffled <- TRUE
#> [15:05:52.454]                             break
#> [15:05:52.454]                           }
#> [15:05:52.454]                         }
#> [15:05:52.454]                       }
#> [15:05:52.454]                       invisible(muffled)
#> [15:05:52.454]                     }
#> [15:05:52.454]                     muffleCondition(cond, pattern = "^muffle")
#> [15:05:52.454]                   }
#> [15:05:52.454]                 }
#> [15:05:52.454]                 else {
#> [15:05:52.454]                   if (TRUE) {
#> [15:05:52.454]                     muffleCondition <- function (cond, pattern = "^muffle") 
#> [15:05:52.454]                     {
#> [15:05:52.454]                       inherits <- base::inherits
#> [15:05:52.454]                       invokeRestart <- base::invokeRestart
#> [15:05:52.454]                       is.null <- base::is.null
#> [15:05:52.454]                       muffled <- FALSE
#> [15:05:52.454]                       if (inherits(cond, "message")) {
#> [15:05:52.454]                         muffled <- grepl(pattern, "muffleMessage")
#> [15:05:52.454]                         if (muffled) 
#> [15:05:52.454]                           invokeRestart("muffleMessage")
#> [15:05:52.454]                       }
#> [15:05:52.454]                       else if (inherits(cond, "warning")) {
#> [15:05:52.454]                         muffled <- grepl(pattern, "muffleWarning")
#> [15:05:52.454]                         if (muffled) 
#> [15:05:52.454]                           invokeRestart("muffleWarning")
#> [15:05:52.454]                       }
#> [15:05:52.454]                       else if (inherits(cond, "condition")) {
#> [15:05:52.454]                         if (!is.null(pattern)) {
#> [15:05:52.454]                           computeRestarts <- base::computeRestarts
#> [15:05:52.454]                           grepl <- base::grepl
#> [15:05:52.454]                           restarts <- computeRestarts(cond)
#> [15:05:52.454]                           for (restart in restarts) {
#> [15:05:52.454]                             name <- restart$name
#> [15:05:52.454]                             if (is.null(name)) 
#> [15:05:52.454]                               next
#> [15:05:52.454]                             if (!grepl(pattern, name)) 
#> [15:05:52.454]                               next
#> [15:05:52.454]                             invokeRestart(restart)
#> [15:05:52.454]                             muffled <- TRUE
#> [15:05:52.454]                             break
#> [15:05:52.454]                           }
#> [15:05:52.454]                         }
#> [15:05:52.454]                       }
#> [15:05:52.454]                       invisible(muffled)
#> [15:05:52.454]                     }
#> [15:05:52.454]                     muffleCondition(cond, pattern = "^muffle")
#> [15:05:52.454]                   }
#> [15:05:52.454]                 }
#> [15:05:52.454]             }
#> [15:05:52.454]         }))
#> [15:05:52.454]     }, error = function(ex) {
#> [15:05:52.454]         base::structure(base::list(value = NULL, visible = NULL, 
#> [15:05:52.454]             conditions = ...future.conditions, rng = !identical(base::globalenv()$.Random.seed, 
#> [15:05:52.454]                 ...future.rng), started = ...future.startTime, 
#> [15:05:52.454]             finished = Sys.time(), session_uuid = NA_character_, 
#> [15:05:52.454]             version = "1.8"), class = "FutureResult")
#> [15:05:52.454]     }, finally = {
#> [15:05:52.454]         if (!identical(...future.workdir, getwd())) 
#> [15:05:52.454]             setwd(...future.workdir)
#> [15:05:52.454]         {
#> [15:05:52.454]             if (identical(getOption("nwarnings"), ...future.oldOptions$nwarnings)) {
#> [15:05:52.454]                 ...future.oldOptions$nwarnings <- NULL
#> [15:05:52.454]             }
#> [15:05:52.454]             base::options(...future.oldOptions)
#> [15:05:52.454]             if (.Platform$OS.type == "windows") {
#> [15:05:52.454]                 old_names <- names(...future.oldEnvVars)
#> [15:05:52.454]                 envs <- base::Sys.getenv()
#> [15:05:52.454]                 names <- names(envs)
#> [15:05:52.454]                 common <- intersect(names, old_names)
#> [15:05:52.454]                 added <- setdiff(names, old_names)
#> [15:05:52.454]                 removed <- setdiff(old_names, names)
#> [15:05:52.454]                 changed <- common[...future.oldEnvVars[common] != 
#> [15:05:52.454]                   envs[common]]
#> [15:05:52.454]                 NAMES <- toupper(changed)
#> [15:05:52.454]                 args <- list()
#> [15:05:52.454]                 for (kk in seq_along(NAMES)) {
#> [15:05:52.454]                   name <- changed[[kk]]
#> [15:05:52.454]                   NAME <- NAMES[[kk]]
#> [15:05:52.454]                   if (name != NAME && is.element(NAME, old_names)) 
#> [15:05:52.454]                     next
#> [15:05:52.454]                   args[[name]] <- ...future.oldEnvVars[[name]]
#> [15:05:52.454]                 }
#> [15:05:52.454]                 NAMES <- toupper(added)
#> [15:05:52.454]                 for (kk in seq_along(NAMES)) {
#> [15:05:52.454]                   name <- added[[kk]]
#> [15:05:52.454]                   NAME <- NAMES[[kk]]
#> [15:05:52.454]                   if (name != NAME && is.element(NAME, old_names)) 
#> [15:05:52.454]                     next
#> [15:05:52.454]                   args[[name]] <- ""
#> [15:05:52.454]                 }
#> [15:05:52.454]                 NAMES <- toupper(removed)
#> [15:05:52.454]                 for (kk in seq_along(NAMES)) {
#> [15:05:52.454]                   name <- removed[[kk]]
#> [15:05:52.454]                   NAME <- NAMES[[kk]]
#> [15:05:52.454]                   if (name != NAME && is.element(NAME, old_names)) 
#> [15:05:52.454]                     next
#> [15:05:52.454]                   args[[name]] <- ...future.oldEnvVars[[name]]
#> [15:05:52.454]                 }
#> [15:05:52.454]                 if (length(args) > 0) 
#> [15:05:52.454]                   base::do.call(base::Sys.setenv, args = args)
#> [15:05:52.454]                 args <- names <- old_names <- NAMES <- envs <- common <- added <- removed <- NULL
#> [15:05:52.454]             }
#> [15:05:52.454]             else {
#> [15:05:52.454]                 base::do.call(base::Sys.setenv, args = base::as.list(...future.oldEnvVars))
#> [15:05:52.454]             }
#> [15:05:52.454]             {
#> [15:05:52.454]                 if (base::length(...future.futureOptionsAdded) > 
#> [15:05:52.454]                   0L) {
#> [15:05:52.454]                   opts <- base::vector("list", length = base::length(...future.futureOptionsAdded))
#> [15:05:52.454]                   base::names(opts) <- ...future.futureOptionsAdded
#> [15:05:52.454]                   base::options(opts)
#> [15:05:52.454]                 }
#> [15:05:52.454]                 {
#> [15:05:52.454]                   {
#> [15:05:52.454]                     base::options(mc.cores = ...future.mc.cores.old)
#> [15:05:52.454]                     NULL
#> [15:05:52.454]                   }
#> [15:05:52.454]                   options(future.plan = NULL)
#> [15:05:52.454]                   if (is.na(NA_character_)) 
#> [15:05:52.454]                     Sys.unsetenv("R_FUTURE_PLAN")
#> [15:05:52.454]                   else Sys.setenv(R_FUTURE_PLAN = NA_character_)
#> [15:05:52.454]                   future::plan(list(function (expr, envir = parent.frame(), 
#> [15:05:52.454]                     substitute = TRUE, globals = TRUE, label = NULL, 
#> [15:05:52.454]                     workers = availableCores(), ...) 
#> [15:05:52.454]                   {
#> [15:05:52.454]                     if (substitute) 
#> [15:05:52.454]                       expr <- substitute(expr)
#> [15:05:52.454]                     if (is.null(workers)) 
#> [15:05:52.454]                       workers <- availableCores()
#> [15:05:52.454]                     future <- CallrFuture(expr = expr, envir = envir, 
#> [15:05:52.454]                       substitute = FALSE, globals = globals, 
#> [15:05:52.454]                       label = label, workers = workers, ...)
#> [15:05:52.454]                     if (!future$lazy) 
#> [15:05:52.454]                       future <- run(future)
#> [15:05:52.454]                     future
#> [15:05:52.454]                   }), .cleanup = FALSE, .init = FALSE)
#> [15:05:52.454]                 }
#> [15:05:52.454]             }
#> [15:05:52.454]         }
#> [15:05:52.454]     })
#> [15:05:52.454]     if (TRUE) {
#> [15:05:52.454]         base::sink(type = "output", split = FALSE)
#> [15:05:52.454]         if (TRUE) {
#> [15:05:52.454]             ...future.result$stdout <- base::rawToChar(base::rawConnectionValue(...future.stdout))
#> [15:05:52.454]         }
#> [15:05:52.454]         else {
#> [15:05:52.454]             ...future.result["stdout"] <- base::list(NULL)
#> [15:05:52.454]         }
#> [15:05:52.454]         base::close(...future.stdout)
#> [15:05:52.454]         ...future.stdout <- NULL
#> [15:05:52.454]     }
#> [15:05:52.454]     ...future.result$conditions <- ...future.conditions
#> [15:05:52.454]     ...future.result$finished <- base::Sys.time()
#> [15:05:52.454]     ...future.result
#> [15:05:52.454] }
#> [15:05:52.474] Launched future (PID=23952)
#> [15:05:52.475] - Launch lazy future ... done
#> [15:05:52.475] run() for 'CallrFuture' ... done
#> [15:05:52.475] callr::wait() ...
#> [15:05:52.637] - iteration 100: callr::wait(timeout = 2.67803)
#> [15:05:52.834] - callr process: finished
#> [15:05:52.834] callr::wait() ... done
#> [15:05:52.835] - callr:::get_result() ...
#> [15:05:52.835] - callr:::get_result() ... done (after 4 attempts)
#> [15:05:52.835] Results:
#> [15:05:52.846] List of 9
#> [15:05:52.846]  $ value       : NULL
#> [15:05:52.846]  $ visible     : NULL
#> [15:05:52.846]  $ conditions  :List of 1
#> [15:05:52.846]   ..$ :List of 5
#> [15:05:52.846]   .. ..$ condition:List of 2
#> [15:05:52.846]   .. .. ..$ message: chr "could not find function \"f\""
#> [15:05:52.846]   .. .. ..$ call   : language f(x)
#> [15:05:52.846]   .. .. ..- attr(*, "class")= chr [1:3] "simpleError" "error" "condition"
#> [15:05:52.846]   .. ..$ calls    :List of 4
#> [15:05:52.846]   .. .. ..$ : language eval(quote(h_bad(0)), new.env())
#> [15:05:52.846]   .. .. ..$ : language h_bad(0)
#> [15:05:52.846]   .. .. ..$ : language my_function_list[["g"]](x)
#> [15:05:52.846]   .. .. .. ..- attr(*, "srcref")= 'srcref' int [1:8] 11 10 11 51 10 51 11 11
#> [15:05:52.846]   .. .. .. .. ..- attr(*, "srcfile")=Classes 'srcfilecopy', 'srcfile' <environment: 0x7f9e7248ef88> 
#> [15:05:52.846]   .. .. ..$ : language f(x)
#> [15:05:52.846]   .. ..$ session  :List of 6
#> [15:05:52.846]   .. .. ..$ r         :List of 14
#> [15:05:52.846]   .. .. .. ..$ platform      : chr "x86_64-apple-darwin22.4.0"
#> [15:05:52.846]   .. .. .. ..$ arch          : chr "x86_64"
#> [15:05:52.846]   .. .. .. ..$ os            : chr "darwin22.4.0"
#> [15:05:52.846]   .. .. .. ..$ system        : chr "x86_64, darwin22.4.0"
#> [15:05:52.846]   .. .. .. ..$ status        : chr ""
#> [15:05:52.846]   .. .. .. ..$ major         : chr "4"
#> [15:05:52.846]   .. .. .. ..$ minor         : chr "3.1"
#> [15:05:52.846]   .. .. .. ..$ year          : chr "2023"
#> [15:05:52.846]   .. .. .. ..$ month         : chr "06"
#> [15:05:52.846]   .. .. .. ..$ day           : chr "16"
#> [15:05:52.846]   .. .. .. ..$ svn rev       : chr "84548"
#> [15:05:52.846]   .. .. .. ..$ language      : chr "R"
#> [15:05:52.846]   .. .. .. ..$ version.string: chr "R version 4.3.1 (2023-06-16)"
#> [15:05:52.846]   .. .. .. ..$ nickname      : chr "Beagle Scouts"
#> [15:05:52.846]   .. .. ..$ locale    : chr "en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8"
#> [15:05:52.846]   .. .. ..$ rngkind   : chr [1:3] "Mersenne-Twister" "Inversion" "Rejection"
#> [15:05:52.846]   .. .. ..$ namespaces: chr [1:20] "processx" "compiler" "parallelly" "graphics" ...
#> [15:05:52.846]   .. .. ..$ search    : chr [1:11] ".GlobalEnv" "r_bg_arguments" "package:stats" "package:graphics" ...
#> [15:05:52.846]   .. .. ..$ system    : Named chr [1:8] "Darwin" "22.6.0" "Darwin Kernel Version 22.6.0: Wed Jul  5 22:21:53 PDT 2023; root:xnu-8796.141.3~6/RELEASE_ARM64_T6020" "melete-2.local" ...
#> [15:05:52.846]   .. .. .. ..- attr(*, "names")= chr [1:8] "sysname" "release" "version" "nodename" ...
#> [15:05:52.846]   .. ..$ timestamp: POSIXct[1:1], format: "2023-09-14 15:05:52"
#> [15:05:52.846]   .. ..$ signaled : int 0
#> [15:05:52.846]  $ rng         : logi FALSE
#> [15:05:52.846]  $ started     : POSIXct[1:1], format: "2023-09-14 15:05:52"
#> [15:05:52.846]  $ finished    : POSIXct[1:1], format: "2023-09-14 15:05:52"
#> [15:05:52.846]  $ session_uuid: chr NA
#> [15:05:52.846]  $ version     : chr "1.8"
#> [15:05:52.846]  $ stdout      : chr ""
#> [15:05:52.846]  - attr(*, "class")= chr "FutureResult"
#> [15:05:52.846] [15:05:52.846] signalConditions() ...
#> [15:05:52.846]  - include = 'immediateCondition'
#> [15:05:52.846]  - exclude = 
#> [15:05:52.846]  - resignal = FALSE
#> [15:05:52.847]  - Number of conditions: 1
#> [15:05:52.847] signalConditions() ... done
#> [15:05:52.847] Future state: 'finished'
#> [15:05:52.847] signalConditions() ...
#> [15:05:52.847]  - include = 'condition'
#> [15:05:52.847]  - exclude = 'immediateCondition'
#> [15:05:52.847]  - resignal = TRUE
#> [15:05:52.847]  - Number of conditions: 1
#> [15:05:52.847]  - Condition #1: 'simpleError', 'error', 'condition'
#> Error in f(x): could not find function "f"
#> [15:05:52.848] signalConditions() ... done

Created on 2023-09-14 with reprex v2.0.2

@DarwinAwardWinner
Copy link

Thinking about it, it's hard to see how one would fix this in the general case, for example:

h_worse <- function(x) {
    fun_name_to_get <- "g"
    fun_to_call <- get(fun_name_to_get, envir = globalenv())
    fun_to_call(x) + 1
}
assert_that(value(future(h_worse(0))) == 3)

However, I think the case of a referencing a function as an element of a list should at least be fixable.

@dipterix
Copy link
Author

Thinking about it, it's hard to see how one would fix this in the general case, for example:

h_worse <- function(x) {
    fun_name_to_get <- "g"
    fun_to_call <- get(fun_name_to_get, envir = globalenv())
    fun_to_call(x) + 1
}
assert_that(value(future(h_worse(0))) == 3)

However, I think the case of a referencing a function as an element of a list should at least be fixable.

I believe there are multi-level of efforts for this problem. Things like get or get0 are hard definitely, but & [, and [[ have very fixed and simple structure. For example

Level 1 would be expressions like env$f(...), if env is an environment that is within the globals object, then f (symbol) should be in globals as well when analyzing the call tree.

Level 2, env[[env2$f]], it might be hard to work this out since env2$f is not a symbol nor string, but a call, one can always use bquote to quasi-evaluate env2$f with bquote({env[[.(env2$f)]]}). I always wish that I could do something like

future({
	env[[.(env2$f)]]
})

without bquote. In this way users can tell future which variables are to be eagerly evaluated and which are lazy.

Currently future is implemented like this

future <- function(....) {
    if (substitute) 
        expr <- substitute(expr)
...
}

To enable .(...), you just need

future <- function(...., quasi_eval = TRUE) {
    if (substitute) 
        expr <- substitute(expr)
    if( quasi_eval )
       expr <- do.call(bquote, list(expr = expr, where = parent.frame()))
    ...
}

@DarwinAwardWinner
Copy link

DarwinAwardWinner commented Sep 21, 2023

For what it's worth, a workaround in my specific case (h_bad above) is to define the list of functions inside the function, e.g.

h_ok <- function(x) {
    my_function_list <- list(g=g)
    my_function_list[["g"]](x) + 1
}
# Both assertions pass
assert_that(h_ok(0) == 3)
assert_that(value(future(h_ok(0))) == 3)

This works because a reference to the global variable g now appears literally within the body of h_ok.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment
Labels
Projects
None yet
Development

No branches or pull requests

2 participants