R version 4.6.0 RC (2026-04-22 r89945 ucrt) -- "Because it was There" Copyright (C) 2026 The R Foundation for Statistical Computing Platform: x86_64-w64-mingw32/x64 R is free software and comes with ABSOLUTELY NO WARRANTY. You are welcome to redistribute it under certain conditions. Type 'license()' or 'licence()' for distribution details. R is a collaborative project with many contributors. Type 'contributors()' for more information and 'citation()' on how to cite R or R packages in publications. Type 'demo()' for some demos, 'help()' for on-line help, or 'help.start()' for an HTML browser interface to help. Type 'q()' to quit R. > #! /usr/bin/env Rscript > ## This runs testme test script inst/testme/test-zzz,future_lapply.R > ## Don't edit - it was autogenerated by inst/testme/deploy.R > future.batchtools:::testme("zzz,future_lapply") Test 'zzz,future_lapply' ... chr "none" > library(future) > library(future.batchtools) > if (requireNamespace("future.apply", quietly = TRUE)) { + future_lapply <- future.apply::future_lapply + library(listenv) + print(all_st .... [TRUNCATED] [1] "sequential" "multisession" "cluster" All HPC strategies: [00:53:09.389] [1] "batchtools_lsf" "batchtools_openlava" "batchtools_sge" [00:53:09.389] [4] "batchtools_slurm" "batchtools_torque" Supported HPC strategies: [00:53:09.390] character(0) Strategies to test with: [00:53:09.391] [1] "batchtools_local" *** future_lapply() ... - future_lapply(x, FUN = vector, ...) ... List of 1 $ x:List of 3 ..$ a: chr "integer" ..$ c: chr "character" ..$ c: chr "list" List of 1 $ y0:List of 3 ..$ a: int [1:2] 0 0 ..$ c: chr [1:2] "" "" ..$ c:List of 2 .. ..$ : NULL .. ..$ : NULL - plan('batchtools_local') ... [00:53:09.461] function (strategy = NULL, ..., substitute = TRUE, .skip = FALSE, [00:53:09.461] .call = TRUE, .cleanup = NA, .init = TRUE) [00:53:09.461] { [00:53:09.461] if (substitute) [00:53:09.461] strategy <- substitute(strategy) [00:53:09.461] if (is.logical(.skip)) [00:53:09.461] stop_if_not(length(.skip) == 1L, !is.na(.skip)) [00:53:09.461] if (is.logical(.call)) [00:53:09.461] stop_if_not(length(.call) == 1L, !is.na(.call)) [00:53:09.461] debug <- isTRUE(getOption("future.debug")) [00:53:09.461] if (debug) { [00:53:09.461] if (inherits(strategy, "character")) { [00:53:09.461] first <- sprintf("\"%s\"", strategy) [00:53:09.461] } [00:53:09.461] else { [00:53:09.461] first <- sprintf("<%s>", commaq(class(strategy)[1])) [00:53:09.461] } [00:53:09.461] mdebugf_push("plan(%s, .skip = %s, .cleanup = %s, .init = %s) ...", [00:53:09.461] first, .skip, .cleanup, .init) [00:53:09.461] on.exit(mdebug_pop()) [00:53:09.461] } [00:53:09.461] if (is.null(stack)) { [00:53:09.461] stack <<- plan_default_stack() [00:53:09.461] if (debug) [00:53:09.461] mdebug("Created default stack") [00:53:09.461] } [00:53:09.461] if (identical(strategy, "backend")) { [00:53:09.461] strategy <- stack[[1L]] [00:53:09.461] backend <- attr(strategy, "backend") [00:53:09.461] if (is.null(backend)) { [00:53:09.461] strategy <- plan_init(strategy, debug = debug) [00:53:09.461] stack[[1L]] <<- strategy [00:53:09.461] backend <- attr(strategy, "backend") [00:53:09.461] } [00:53:09.461] return(backend) [00:53:09.461] } [00:53:09.461] else if (is.null(strategy) || identical(strategy, "next")) { [00:53:09.461] strategy <- stack[[1L]] [00:53:09.461] if (!inherits(strategy, "FutureStrategy")) { [00:53:09.461] class(strategy) <- c("FutureStrategy", class(strategy)) [00:53:09.461] } [00:53:09.461] stop_if_not(is.function(strategy)) [00:53:09.461] if (debug) [00:53:09.461] mdebugf("Getting current (\"next\") strategy: %s", [00:53:09.461] commaq(class(strategy))) [00:53:09.461] return(strategy) [00:53:09.461] } [00:53:09.461] else if (identical(strategy, "default")) { [00:53:09.461] strategy <- getOption("future.plan") [00:53:09.461] if (is.null(strategy)) [00:53:09.461] strategy <- sequential [00:53:09.461] if (debug) [00:53:09.461] mdebugf("Getting default stack: %s", commaq(class(strategy))) [00:53:09.461] } [00:53:09.461] else if (identical(strategy, "list")) { [00:53:09.461] if (debug) [00:53:09.461] mdebugf("Getting full stack: [n=%d] %s", length(stack), [00:53:09.461] commaq(sapply(stack, FUN = class))) [00:53:09.461] if (all(c("codalm", "testthat") %in% loadedNamespaces())) { [00:53:09.461] ignore <- c("init", "backend") [00:53:09.461] class <- class(stack) [00:53:09.461] stack <- lapply(stack, FUN = function(s) { [00:53:09.461] for (name in ignore) attr(s, name) <- NULL [00:53:09.461] s [00:53:09.461] }) [00:53:09.461] class(stack) <- class [00:53:09.461] } [00:53:09.461] return(stack) [00:53:09.461] } [00:53:09.461] else if (identical(strategy, "tail")) { [00:53:09.461] stack <- stack[-1] [00:53:09.461] if (debug) [00:53:09.461] mdebugf("Getting stack without first backend: [n=%d] %s", [00:53:09.461] length(stack), commaq(sapply(stack, FUN = class))) [00:53:09.461] return(stack) [00:53:09.461] } [00:53:09.461] else if (identical(strategy, "reset")) { [00:53:09.461] if (debug) [00:53:09.461] mdebug_push("Resetting stack ...") [00:53:09.461] plan_cleanup(stack[[1]], cleanup = .cleanup, debug = debug) [00:53:09.461] stack <<- plan_default_stack() [00:53:09.461] if (debug) [00:53:09.461] mdebug_pop() [00:53:09.461] return(stack) [00:53:09.461] } [00:53:09.461] else if (identical(strategy, "pop")) { [00:53:09.461] if (debug) [00:53:09.461] mdebug_push("Popping stack ...") [00:53:09.461] oldStack <- stack [00:53:09.461] stack <<- stack[-1L] [00:53:09.461] if (length(stack) == 0L) [00:53:09.461] stack <<- plan_default_stack() [00:53:09.461] if (debug) [00:53:09.461] mdebug_pop() [00:53:09.461] return(oldStack) [00:53:09.461] } [00:53:09.461] oldStack <- stack [00:53:09.461] newStack <- NULL [00:53:09.461] targs <- list(...) [00:53:09.461] if (is.function(strategy)) { [00:53:09.461] if (length(targs) > 0) { [00:53:09.461] args <- c(list(strategy), targs, penvir = parent.frame()) [00:53:09.461] strategy <- do.call(tweak, args = args) [00:53:09.461] } [00:53:09.461] strategy <- list(strategy) [00:53:09.461] } [00:53:09.461] if (is.list(strategy)) { [00:53:09.461] oldStack <- plan_set(strategy, skip = .skip, cleanup = .cleanup, [00:53:09.461] init = .init, debug = debug) [00:53:09.461] return(invisible(oldStack)) [00:53:09.461] } [00:53:09.461] if (is.language(strategy)) { [00:53:09.461] first <- as.list(strategy)[[1]] [00:53:09.461] if (is.symbol(first)) { [00:53:09.461] if (is.call(strategy)) { [00:53:09.461] first <- get(as.character(first), mode = "function", [00:53:09.461] envir = parent.frame(), inherits = TRUE) [00:53:09.461] } [00:53:09.461] else { [00:53:09.461] first <- eval(first, envir = parent.frame(), [00:53:09.461] enclos = baseenv()) [00:53:09.461] } [00:53:09.461] if (is.list(first)) { [00:53:09.461] strategies <- first [00:53:09.461] res <- plan(strategies, substitute = FALSE, .cleanup = .cleanup, [00:53:09.461] .init = .init) [00:53:09.461] return(invisible(res)) [00:53:09.461] } [00:53:09.461] if (is.function(first) && !inherits(first, "future")) { [00:53:09.461] strategies <- eval(strategy, envir = parent.frame(), [00:53:09.461] enclos = baseenv()) [00:53:09.461] if (is.list(strategies)) { [00:53:09.461] for (kk in seq_along(strategies)) { [00:53:09.461] strategy_kk <- strategies[[kk]] [00:53:09.461] if (is.character(strategy_kk)) { [00:53:09.461] strategy_kk <- tweak(strategy_kk, penvir = parent.frame()) [00:53:09.461] strategies[[kk]] <- strategy_kk [00:53:09.461] } [00:53:09.461] } [00:53:09.461] newStack <- strategies [00:53:09.461] stop_if_not(!is.null(newStack), is.list(newStack), [00:53:09.461] length(newStack) >= 1L) [00:53:09.461] } [00:53:09.461] else if (is.function(strategies) && !inherits(strategies, [00:53:09.461] "future")) { [00:53:09.461] strategies <- list(strategies) [00:53:09.461] newStack <- strategies [00:53:09.461] stop_if_not(!is.null(newStack), is.list(newStack), [00:53:09.461] length(newStack) >= 1L) [00:53:09.461] } [00:53:09.461] } [00:53:09.461] } [00:53:09.461] } [00:53:09.461] if (is.null(newStack)) { [00:53:09.461] if (is.symbol(strategy)) { [00:53:09.461] strategy <- eval(strategy, envir = parent.frame(), [00:53:09.461] enclos = baseenv()) [00:53:09.461] } [00:53:09.461] else if (is.language(strategy)) { [00:53:09.461] strategyT <- as.list(strategy) [00:53:09.461] if (strategyT[[1]] == as.symbol("tweak")) { [00:53:09.461] strategy <- eval(strategy, envir = parent.frame(), [00:53:09.461] enclos = baseenv()) [00:53:09.461] } [00:53:09.461] else { [00:53:09.461] isSymbol <- sapply(strategyT, FUN = is.symbol) [00:53:09.461] if (!all(isSymbol)) { [00:53:09.461] strategy <- eval(strategyT[[1L]], envir = parent.frame(), [00:53:09.461] enclos = baseenv()) [00:53:09.461] if (length(strategyT) > 1L) { [00:53:09.461] args <- c(list(strategy), strategyT[-1L], [00:53:09.461] penvir = parent.frame()) [00:53:09.461] strategy <- do.call(tweak, args = args) [00:53:09.461] } [00:53:09.461] } [00:53:09.461] else { [00:53:09.461] strategy <- eval(strategy, envir = parent.frame(), [00:53:09.461] enclos = baseenv()) [00:53:09.461] } [00:53:09.461] } [00:53:09.461] } [00:53:09.461] args <- c(list(strategy), targs, penvir = parent.frame()) [00:53:09.461] tstrategy <- do.call(tweak, args = args, quote = TRUE) [00:53:09.461] newStack <- list(tstrategy) [00:53:09.461] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [00:53:09.461] 1L) [00:53:09.461] } [00:53:09.461] if (!is.null(.call)) { [00:53:09.461] call <- if (isTRUE(.call)) [00:53:09.461] sys.call() [00:53:09.461] else .call [00:53:09.461] for (kk in seq_along(newStack)) { [00:53:09.461] strategy <- newStack[[kk]] [00:53:09.461] if (!is.null(attr(strategy, "call", exact = TRUE))) [00:53:09.461] next [00:53:09.461] attr(strategy, "call") <- call [00:53:09.461] newStack[[kk]] <- strategy [00:53:09.461] } [00:53:09.461] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [00:53:09.461] 1L) [00:53:09.461] } [00:53:09.461] oldStack <- plan_set(newStack, skip = .skip, cleanup = .cleanup, [00:53:09.461] init = .init, debug = debug) [00:53:09.461] invisible(oldStack) [00:53:09.461] } [00:53:09.461] [00:53:09.461] List of 1 $ y:List of 3 ..$ a: int [1:2] 0 0 ..$ c: chr [1:2] "" "" ..$ c:List of 2 .. ..$ : NULL .. ..$ : NULL List of 1 $ y:List of 3 ..$ a: int [1:2] 0 0 ..$ c: chr [1:2] "" "" ..$ c:List of 2 .. ..$ : NULL .. ..$ : NULL - future_lapply(x, FUN = base::vector, ...) ... List of 1 $ x:List of 3 ..$ a: chr "integer" ..$ c: chr "character" ..$ c: chr "list" List of 1 $ y0:List of 3 ..$ a: int [1:2] 0 0 ..$ c: chr [1:2] "" "" ..$ c:List of 2 .. ..$ : NULL .. ..$ : NULL - plan('batchtools_local') ... [00:53:13.523] function (strategy = NULL, ..., substitute = TRUE, .skip = FALSE, [00:53:13.523] .call = TRUE, .cleanup = NA, .init = TRUE) [00:53:13.523] { [00:53:13.523] if (substitute) [00:53:13.523] strategy <- substitute(strategy) [00:53:13.523] if (is.logical(.skip)) [00:53:13.523] stop_if_not(length(.skip) == 1L, !is.na(.skip)) [00:53:13.523] if (is.logical(.call)) [00:53:13.523] stop_if_not(length(.call) == 1L, !is.na(.call)) [00:53:13.523] debug <- isTRUE(getOption("future.debug")) [00:53:13.523] if (debug) { [00:53:13.523] if (inherits(strategy, "character")) { [00:53:13.523] first <- sprintf("\"%s\"", strategy) [00:53:13.523] } [00:53:13.523] else { [00:53:13.523] first <- sprintf("<%s>", commaq(class(strategy)[1])) [00:53:13.523] } [00:53:13.523] mdebugf_push("plan(%s, .skip = %s, .cleanup = %s, .init = %s) ...", [00:53:13.523] first, .skip, .cleanup, .init) [00:53:13.523] on.exit(mdebug_pop()) [00:53:13.523] } [00:53:13.523] if (is.null(stack)) { [00:53:13.523] stack <<- plan_default_stack() [00:53:13.523] if (debug) [00:53:13.523] mdebug("Created default stack") [00:53:13.523] } [00:53:13.523] if (identical(strategy, "backend")) { [00:53:13.523] strategy <- stack[[1L]] [00:53:13.523] backend <- attr(strategy, "backend") [00:53:13.523] if (is.null(backend)) { [00:53:13.523] strategy <- plan_init(strategy, debug = debug) [00:53:13.523] stack[[1L]] <<- strategy [00:53:13.523] backend <- attr(strategy, "backend") [00:53:13.523] } [00:53:13.523] return(backend) [00:53:13.523] } [00:53:13.523] else if (is.null(strategy) || identical(strategy, "next")) { [00:53:13.523] strategy <- stack[[1L]] [00:53:13.523] if (!inherits(strategy, "FutureStrategy")) { [00:53:13.523] class(strategy) <- c("FutureStrategy", class(strategy)) [00:53:13.523] } [00:53:13.523] stop_if_not(is.function(strategy)) [00:53:13.523] if (debug) [00:53:13.523] mdebugf("Getting current (\"next\") strategy: %s", [00:53:13.523] commaq(class(strategy))) [00:53:13.523] return(strategy) [00:53:13.523] } [00:53:13.523] else if (identical(strategy, "default")) { [00:53:13.523] strategy <- getOption("future.plan") [00:53:13.523] if (is.null(strategy)) [00:53:13.523] strategy <- sequential [00:53:13.523] if (debug) [00:53:13.523] mdebugf("Getting default stack: %s", commaq(class(strategy))) [00:53:13.523] } [00:53:13.523] else if (identical(strategy, "list")) { [00:53:13.523] if (debug) [00:53:13.523] mdebugf("Getting full stack: [n=%d] %s", length(stack), [00:53:13.523] commaq(sapply(stack, FUN = class))) [00:53:13.523] if (all(c("codalm", "testthat") %in% loadedNamespaces())) { [00:53:13.523] ignore <- c("init", "backend") [00:53:13.523] class <- class(stack) [00:53:13.523] stack <- lapply(stack, FUN = function(s) { [00:53:13.523] for (name in ignore) attr(s, name) <- NULL [00:53:13.523] s [00:53:13.523] }) [00:53:13.523] class(stack) <- class [00:53:13.523] } [00:53:13.523] return(stack) [00:53:13.523] } [00:53:13.523] else if (identical(strategy, "tail")) { [00:53:13.523] stack <- stack[-1] [00:53:13.523] if (debug) [00:53:13.523] mdebugf("Getting stack without first backend: [n=%d] %s", [00:53:13.523] length(stack), commaq(sapply(stack, FUN = class))) [00:53:13.523] return(stack) [00:53:13.523] } [00:53:13.523] else if (identical(strategy, "reset")) { [00:53:13.523] if (debug) [00:53:13.523] mdebug_push("Resetting stack ...") [00:53:13.523] plan_cleanup(stack[[1]], cleanup = .cleanup, debug = debug) [00:53:13.523] stack <<- plan_default_stack() [00:53:13.523] if (debug) [00:53:13.523] mdebug_pop() [00:53:13.523] return(stack) [00:53:13.523] } [00:53:13.523] else if (identical(strategy, "pop")) { [00:53:13.523] if (debug) [00:53:13.523] mdebug_push("Popping stack ...") [00:53:13.523] oldStack <- stack [00:53:13.523] stack <<- stack[-1L] [00:53:13.523] if (length(stack) == 0L) [00:53:13.523] stack <<- plan_default_stack() [00:53:13.523] if (debug) [00:53:13.523] mdebug_pop() [00:53:13.523] return(oldStack) [00:53:13.523] } [00:53:13.523] oldStack <- stack [00:53:13.523] newStack <- NULL [00:53:13.523] targs <- list(...) [00:53:13.523] if (is.function(strategy)) { [00:53:13.523] if (length(targs) > 0) { [00:53:13.523] args <- c(list(strategy), targs, penvir = parent.frame()) [00:53:13.523] strategy <- do.call(tweak, args = args) [00:53:13.523] } [00:53:13.523] strategy <- list(strategy) [00:53:13.523] } [00:53:13.523] if (is.list(strategy)) { [00:53:13.523] oldStack <- plan_set(strategy, skip = .skip, cleanup = .cleanup, [00:53:13.523] init = .init, debug = debug) [00:53:13.523] return(invisible(oldStack)) [00:53:13.523] } [00:53:13.523] if (is.language(strategy)) { [00:53:13.523] first <- as.list(strategy)[[1]] [00:53:13.523] if (is.symbol(first)) { [00:53:13.523] if (is.call(strategy)) { [00:53:13.523] first <- get(as.character(first), mode = "function", [00:53:13.523] envir = parent.frame(), inherits = TRUE) [00:53:13.523] } [00:53:13.523] else { [00:53:13.523] first <- eval(first, envir = parent.frame(), [00:53:13.523] enclos = baseenv()) [00:53:13.523] } [00:53:13.523] if (is.list(first)) { [00:53:13.523] strategies <- first [00:53:13.523] res <- plan(strategies, substitute = FALSE, .cleanup = .cleanup, [00:53:13.523] .init = .init) [00:53:13.523] return(invisible(res)) [00:53:13.523] } [00:53:13.523] if (is.function(first) && !inherits(first, "future")) { [00:53:13.523] strategies <- eval(strategy, envir = parent.frame(), [00:53:13.523] enclos = baseenv()) [00:53:13.523] if (is.list(strategies)) { [00:53:13.523] for (kk in seq_along(strategies)) { [00:53:13.523] strategy_kk <- strategies[[kk]] [00:53:13.523] if (is.character(strategy_kk)) { [00:53:13.523] strategy_kk <- tweak(strategy_kk, penvir = parent.frame()) [00:53:13.523] strategies[[kk]] <- strategy_kk [00:53:13.523] } [00:53:13.523] } [00:53:13.523] newStack <- strategies [00:53:13.523] stop_if_not(!is.null(newStack), is.list(newStack), [00:53:13.523] length(newStack) >= 1L) [00:53:13.523] } [00:53:13.523] else if (is.function(strategies) && !inherits(strategies, [00:53:13.523] "future")) { [00:53:13.523] strategies <- list(strategies) [00:53:13.523] newStack <- strategies [00:53:13.523] stop_if_not(!is.null(newStack), is.list(newStack), [00:53:13.523] length(newStack) >= 1L) [00:53:13.523] } [00:53:13.523] } [00:53:13.523] } [00:53:13.523] } [00:53:13.523] if (is.null(newStack)) { [00:53:13.523] if (is.symbol(strategy)) { [00:53:13.523] strategy <- eval(strategy, envir = parent.frame(), [00:53:13.523] enclos = baseenv()) [00:53:13.523] } [00:53:13.523] else if (is.language(strategy)) { [00:53:13.523] strategyT <- as.list(strategy) [00:53:13.523] if (strategyT[[1]] == as.symbol("tweak")) { [00:53:13.523] strategy <- eval(strategy, envir = parent.frame(), [00:53:13.523] enclos = baseenv()) [00:53:13.523] } [00:53:13.523] else { [00:53:13.523] isSymbol <- sapply(strategyT, FUN = is.symbol) [00:53:13.523] if (!all(isSymbol)) { [00:53:13.523] strategy <- eval(strategyT[[1L]], envir = parent.frame(), [00:53:13.523] enclos = baseenv()) [00:53:13.523] if (length(strategyT) > 1L) { [00:53:13.523] args <- c(list(strategy), strategyT[-1L], [00:53:13.523] penvir = parent.frame()) [00:53:13.523] strategy <- do.call(tweak, args = args) [00:53:13.523] } [00:53:13.523] } [00:53:13.523] else { [00:53:13.523] strategy <- eval(strategy, envir = parent.frame(), [00:53:13.523] enclos = baseenv()) [00:53:13.523] } [00:53:13.523] } [00:53:13.523] } [00:53:13.523] args <- c(list(strategy), targs, penvir = parent.frame()) [00:53:13.523] tstrategy <- do.call(tweak, args = args, quote = TRUE) [00:53:13.523] newStack <- list(tstrategy) [00:53:13.523] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [00:53:13.523] 1L) [00:53:13.523] } [00:53:13.523] if (!is.null(.call)) { [00:53:13.523] call <- if (isTRUE(.call)) [00:53:13.523] sys.call() [00:53:13.523] else .call [00:53:13.523] for (kk in seq_along(newStack)) { [00:53:13.523] strategy <- newStack[[kk]] [00:53:13.523] if (!is.null(attr(strategy, "call", exact = TRUE))) [00:53:13.523] next [00:53:13.523] attr(strategy, "call") <- call [00:53:13.523] newStack[[kk]] <- strategy [00:53:13.523] } [00:53:13.523] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [00:53:13.523] 1L) [00:53:13.523] } [00:53:13.523] oldStack <- plan_set(newStack, skip = .skip, cleanup = .cleanup, [00:53:13.523] init = .init, debug = debug) [00:53:13.523] invisible(oldStack) [00:53:13.523] } [00:53:13.523] [00:53:13.523] List of 1 $ y:List of 3 ..$ a: int [1:2] 0 0 ..$ c: chr [1:2] "" "" ..$ c:List of 2 .. ..$ : NULL .. ..$ : NULL List of 1 $ y:List of 3 ..$ a: int [1:2] 0 0 ..$ c: chr [1:2] "" "" ..$ c:List of 2 .. ..$ : NULL .. ..$ : NULL - future_lapply(x, FUN = future:::hpaste, ...) ... List of 1 $ x:List of 1 ..$ a: Named chr [1:101] "hello" "1" "2" "3" ... .. ..- attr(*, "names")= chr [1:101] "" "b1" "b2" "b3" ... List of 1 $ y0:List of 1 ..$ a: chr "hello; 1; 2; ...; 100" - plan('batchtools_local') ... [00:53:17.322] function (strategy = NULL, ..., substitute = TRUE, .skip = FALSE, [00:53:17.322] .call = TRUE, .cleanup = NA, .init = TRUE) [00:53:17.322] { [00:53:17.322] if (substitute) [00:53:17.322] strategy <- substitute(strategy) [00:53:17.322] if (is.logical(.skip)) [00:53:17.322] stop_if_not(length(.skip) == 1L, !is.na(.skip)) [00:53:17.322] if (is.logical(.call)) [00:53:17.322] stop_if_not(length(.call) == 1L, !is.na(.call)) [00:53:17.322] debug <- isTRUE(getOption("future.debug")) [00:53:17.322] if (debug) { [00:53:17.322] if (inherits(strategy, "character")) { [00:53:17.322] first <- sprintf("\"%s\"", strategy) [00:53:17.322] } [00:53:17.322] else { [00:53:17.322] first <- sprintf("<%s>", commaq(class(strategy)[1])) [00:53:17.322] } [00:53:17.322] mdebugf_push("plan(%s, .skip = %s, .cleanup = %s, .init = %s) ...", [00:53:17.322] first, .skip, .cleanup, .init) [00:53:17.322] on.exit(mdebug_pop()) [00:53:17.322] } [00:53:17.322] if (is.null(stack)) { [00:53:17.322] stack <<- plan_default_stack() [00:53:17.322] if (debug) [00:53:17.322] mdebug("Created default stack") [00:53:17.322] } [00:53:17.322] if (identical(strategy, "backend")) { [00:53:17.322] strategy <- stack[[1L]] [00:53:17.322] backend <- attr(strategy, "backend") [00:53:17.322] if (is.null(backend)) { [00:53:17.322] strategy <- plan_init(strategy, debug = debug) [00:53:17.322] stack[[1L]] <<- strategy [00:53:17.322] backend <- attr(strategy, "backend") [00:53:17.322] } [00:53:17.322] return(backend) [00:53:17.322] } [00:53:17.322] else if (is.null(strategy) || identical(strategy, "next")) { [00:53:17.322] strategy <- stack[[1L]] [00:53:17.322] if (!inherits(strategy, "FutureStrategy")) { [00:53:17.322] class(strategy) <- c("FutureStrategy", class(strategy)) [00:53:17.322] } [00:53:17.322] stop_if_not(is.function(strategy)) [00:53:17.322] if (debug) [00:53:17.322] mdebugf("Getting current (\"next\") strategy: %s", [00:53:17.322] commaq(class(strategy))) [00:53:17.322] return(strategy) [00:53:17.322] } [00:53:17.322] else if (identical(strategy, "default")) { [00:53:17.322] strategy <- getOption("future.plan") [00:53:17.322] if (is.null(strategy)) [00:53:17.322] strategy <- sequential [00:53:17.322] if (debug) [00:53:17.322] mdebugf("Getting default stack: %s", commaq(class(strategy))) [00:53:17.322] } [00:53:17.322] else if (identical(strategy, "list")) { [00:53:17.322] if (debug) [00:53:17.322] mdebugf("Getting full stack: [n=%d] %s", length(stack), [00:53:17.322] commaq(sapply(stack, FUN = class))) [00:53:17.322] if (all(c("codalm", "testthat") %in% loadedNamespaces())) { [00:53:17.322] ignore <- c("init", "backend") [00:53:17.322] class <- class(stack) [00:53:17.322] stack <- lapply(stack, FUN = function(s) { [00:53:17.322] for (name in ignore) attr(s, name) <- NULL [00:53:17.322] s [00:53:17.322] }) [00:53:17.322] class(stack) <- class [00:53:17.322] } [00:53:17.322] return(stack) [00:53:17.322] } [00:53:17.322] else if (identical(strategy, "tail")) { [00:53:17.322] stack <- stack[-1] [00:53:17.322] if (debug) [00:53:17.322] mdebugf("Getting stack without first backend: [n=%d] %s", [00:53:17.322] length(stack), commaq(sapply(stack, FUN = class))) [00:53:17.322] return(stack) [00:53:17.322] } [00:53:17.322] else if (identical(strategy, "reset")) { [00:53:17.322] if (debug) [00:53:17.322] mdebug_push("Resetting stack ...") [00:53:17.322] plan_cleanup(stack[[1]], cleanup = .cleanup, debug = debug) [00:53:17.322] stack <<- plan_default_stack() [00:53:17.322] if (debug) [00:53:17.322] mdebug_pop() [00:53:17.322] return(stack) [00:53:17.322] } [00:53:17.322] else if (identical(strategy, "pop")) { [00:53:17.322] if (debug) [00:53:17.322] mdebug_push("Popping stack ...") [00:53:17.322] oldStack <- stack [00:53:17.322] stack <<- stack[-1L] [00:53:17.322] if (length(stack) == 0L) [00:53:17.322] stack <<- plan_default_stack() [00:53:17.322] if (debug) [00:53:17.322] mdebug_pop() [00:53:17.322] return(oldStack) [00:53:17.322] } [00:53:17.322] oldStack <- stack [00:53:17.322] newStack <- NULL [00:53:17.322] targs <- list(...) [00:53:17.322] if (is.function(strategy)) { [00:53:17.322] if (length(targs) > 0) { [00:53:17.322] args <- c(list(strategy), targs, penvir = parent.frame()) [00:53:17.322] strategy <- do.call(tweak, args = args) [00:53:17.322] } [00:53:17.322] strategy <- list(strategy) [00:53:17.322] } [00:53:17.322] if (is.list(strategy)) { [00:53:17.322] oldStack <- plan_set(strategy, skip = .skip, cleanup = .cleanup, [00:53:17.322] init = .init, debug = debug) [00:53:17.322] return(invisible(oldStack)) [00:53:17.322] } [00:53:17.322] if (is.language(strategy)) { [00:53:17.322] first <- as.list(strategy)[[1]] [00:53:17.322] if (is.symbol(first)) { [00:53:17.322] if (is.call(strategy)) { [00:53:17.322] first <- get(as.character(first), mode = "function", [00:53:17.322] envir = parent.frame(), inherits = TRUE) [00:53:17.322] } [00:53:17.322] else { [00:53:17.322] first <- eval(first, envir = parent.frame(), [00:53:17.322] enclos = baseenv()) [00:53:17.322] } [00:53:17.322] if (is.list(first)) { [00:53:17.322] strategies <- first [00:53:17.322] res <- plan(strategies, substitute = FALSE, .cleanup = .cleanup, [00:53:17.322] .init = .init) [00:53:17.322] return(invisible(res)) [00:53:17.322] } [00:53:17.322] if (is.function(first) && !inherits(first, "future")) { [00:53:17.322] strategies <- eval(strategy, envir = parent.frame(), [00:53:17.322] enclos = baseenv()) [00:53:17.322] if (is.list(strategies)) { [00:53:17.322] for (kk in seq_along(strategies)) { [00:53:17.322] strategy_kk <- strategies[[kk]] [00:53:17.322] if (is.character(strategy_kk)) { [00:53:17.322] strategy_kk <- tweak(strategy_kk, penvir = parent.frame()) [00:53:17.322] strategies[[kk]] <- strategy_kk [00:53:17.322] } [00:53:17.322] } [00:53:17.322] newStack <- strategies [00:53:17.322] stop_if_not(!is.null(newStack), is.list(newStack), [00:53:17.322] length(newStack) >= 1L) [00:53:17.322] } [00:53:17.322] else if (is.function(strategies) && !inherits(strategies, [00:53:17.322] "future")) { [00:53:17.322] strategies <- list(strategies) [00:53:17.322] newStack <- strategies [00:53:17.322] stop_if_not(!is.null(newStack), is.list(newStack), [00:53:17.322] length(newStack) >= 1L) [00:53:17.322] } [00:53:17.322] } [00:53:17.322] } [00:53:17.322] } [00:53:17.322] if (is.null(newStack)) { [00:53:17.322] if (is.symbol(strategy)) { [00:53:17.322] strategy <- eval(strategy, envir = parent.frame(), [00:53:17.322] enclos = baseenv()) [00:53:17.322] } [00:53:17.322] else if (is.language(strategy)) { [00:53:17.322] strategyT <- as.list(strategy) [00:53:17.322] if (strategyT[[1]] == as.symbol("tweak")) { [00:53:17.322] strategy <- eval(strategy, envir = parent.frame(), [00:53:17.322] enclos = baseenv()) [00:53:17.322] } [00:53:17.322] else { [00:53:17.322] isSymbol <- sapply(strategyT, FUN = is.symbol) [00:53:17.322] if (!all(isSymbol)) { [00:53:17.322] strategy <- eval(strategyT[[1L]], envir = parent.frame(), [00:53:17.322] enclos = baseenv()) [00:53:17.322] if (length(strategyT) > 1L) { [00:53:17.322] args <- c(list(strategy), strategyT[-1L], [00:53:17.322] penvir = parent.frame()) [00:53:17.322] strategy <- do.call(tweak, args = args) [00:53:17.322] } [00:53:17.322] } [00:53:17.322] else { [00:53:17.322] strategy <- eval(strategy, envir = parent.frame(), [00:53:17.322] enclos = baseenv()) [00:53:17.322] } [00:53:17.322] } [00:53:17.322] } [00:53:17.322] args <- c(list(strategy), targs, penvir = parent.frame()) [00:53:17.322] tstrategy <- do.call(tweak, args = args, quote = TRUE) [00:53:17.322] newStack <- list(tstrategy) [00:53:17.322] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [00:53:17.322] 1L) [00:53:17.322] } [00:53:17.322] if (!is.null(.call)) { [00:53:17.322] call <- if (isTRUE(.call)) [00:53:17.322] sys.call() [00:53:17.322] else .call [00:53:17.322] for (kk in seq_along(newStack)) { [00:53:17.322] strategy <- newStack[[kk]] [00:53:17.322] if (!is.null(attr(strategy, "call", exact = TRUE))) [00:53:17.322] next [00:53:17.322] attr(strategy, "call") <- call [00:53:17.322] newStack[[kk]] <- strategy [00:53:17.322] } [00:53:17.322] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [00:53:17.322] 1L) [00:53:17.322] } [00:53:17.322] oldStack <- plan_set(newStack, skip = .skip, cleanup = .cleanup, [00:53:17.322] init = .init, debug = debug) [00:53:17.322] invisible(oldStack) [00:53:17.322] } [00:53:17.322] [00:53:17.322] List of 1 $ y:List of 1 ..$ a: chr "hello; 1; 2; ...; 100" List of 1 $ y:List of 1 ..$ a: chr "hello; 1; 2; ...; 100" - future_lapply(x, FUN = listenv::listenv, ...) ... $a A 'listenv' vector with 1 element ('A'). $b A 'listenv' vector with 2 elements ('A', 'B'). List of 1 $ y0:List of 2 ..$ a: Named chr "A" .. ..- attr(*, "names")= chr "A" ..$ b: Named chr [1:2] "A" "B" .. ..- attr(*, "names")= chr [1:2] "A" "B" - plan('batchtools_local') ... List of 1 $ y:List of 2 ..$ a: Named chr "A" .. ..- attr(*, "names")= chr "A" ..$ b: Named chr [1:2] "A" "B" .. ..- attr(*, "names")= chr [1:2] "A" "B" List of 1 $ y:List of 2 ..$ a: Named chr "A" .. ..- attr(*, "names")= chr "A" ..$ b: Named chr [1:2] "A" "B" .. ..- attr(*, "names")= chr [1:2] "A" "B" - future_lapply(x, FUN, ...) for large length(x) ... - future_lapply() with global in non-attached package ... *** future_lapply() ... DONE Failed to undo environment variables: - Expected environment variables: [n=220] '!ExitCode', 'ALLUSERSPROFILE', 'APPDATA', ..., 'tempdirname' - Environment variables still there: [n=0] - Environment variables missing: [n=1] 'MAKEFLAGS' Differences environment variable by environment variable: Skipping, because path appears not to be an 'R CMD check' folder: 'D:/temp/2026_04_25_00_50_17_18966' Test time: user.self=4s, sys.self=0.4s, elapsed=2e+01s, user.child=NAs, sys.child=NAs Test 'tempdirname' ... success > > proc.time() user system elapsed 4.98 0.53 18.29