R Under development (unstable) (2025-09-19 r88859 ucrt) -- "Unsuffered Consequences" Copyright (C) 2025 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. > ## 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' ... Sourcing 9 prologue scripts ... 01/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_prologue/001.load.R' 02/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_prologue/002.record-state.R' 03/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_prologue/030.imports.R' 04/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_prologue/050.utils.R' 05/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_prologue/090.context.R' 06/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_prologue/090.options.R' 07/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_prologue/091.envvars.R' 08/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_prologue/099.future-setup.R' 09/09 prologue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_prologue/995.detrius-connections.R' Sourcing 9 prologue scripts ... done Running test script: 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/test-zzz,future_lapply.R' > library(future) > library(future.batchtools) Loading required package: parallelly > 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: [04:17:43.454] [1] "batchtools_lsf" "batchtools_openlava" "batchtools_sge" [04:17:43.454] [4] "batchtools_slurm" "batchtools_torque" Supported HPC strategies: [04:17:43.456] character(0) Strategies to test with: [04:17:43.456] [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') ... [04:17:43.534] function (strategy = NULL, ..., substitute = TRUE, .skip = FALSE, [04:17:43.534] .call = TRUE, .cleanup = NA, .init = TRUE) [04:17:43.534] { [04:17:43.534] if (substitute) [04:17:43.534] strategy <- substitute(strategy) [04:17:43.534] if (is.logical(.skip)) [04:17:43.534] stop_if_not(length(.skip) == 1L, !is.na(.skip)) [04:17:43.534] if (is.logical(.call)) [04:17:43.534] stop_if_not(length(.call) == 1L, !is.na(.call)) [04:17:43.534] debug <- isTRUE(getOption("future.debug")) [04:17:43.534] if (debug) { [04:17:43.534] if (inherits(strategy, "character")) { [04:17:43.534] first <- sprintf("\"%s\"", strategy) [04:17:43.534] } [04:17:43.534] else { [04:17:43.534] first <- sprintf("<%s>", commaq(class(strategy)[1])) [04:17:43.534] } [04:17:43.534] mdebugf_push("plan(%s, .skip = %s, .cleanup = %s, .init = %s) ...", [04:17:43.534] first, .skip, .cleanup, .init) [04:17:43.534] on.exit(mdebug_pop()) [04:17:43.534] } [04:17:43.534] if (is.null(stack)) { [04:17:43.534] stack <<- plan_default_stack() [04:17:43.534] if (debug) [04:17:43.534] mdebug("Created default stack") [04:17:43.534] } [04:17:43.534] if (identical(strategy, "backend")) { [04:17:43.534] strategy <- stack[[1L]] [04:17:43.534] backend <- attr(strategy, "backend") [04:17:43.534] if (is.null(backend)) { [04:17:43.534] strategy <- plan_init(strategy, debug = debug) [04:17:43.534] stack[[1L]] <<- strategy [04:17:43.534] backend <- attr(strategy, "backend") [04:17:43.534] } [04:17:43.534] return(backend) [04:17:43.534] } [04:17:43.534] else if (is.null(strategy) || identical(strategy, "next")) { [04:17:43.534] strategy <- stack[[1L]] [04:17:43.534] if (!inherits(strategy, "FutureStrategy")) { [04:17:43.534] class(strategy) <- c("FutureStrategy", class(strategy)) [04:17:43.534] } [04:17:43.534] stop_if_not(is.function(strategy)) [04:17:43.534] if (debug) [04:17:43.534] mdebugf("Getting current (\"next\") strategy: %s", [04:17:43.534] commaq(class(strategy))) [04:17:43.534] return(strategy) [04:17:43.534] } [04:17:43.534] else if (identical(strategy, "default")) { [04:17:43.534] strategy <- getOption("future.plan") [04:17:43.534] if (is.null(strategy)) [04:17:43.534] strategy <- sequential [04:17:43.534] if (debug) [04:17:43.534] mdebugf("Getting default stack: %s", commaq(class(strategy))) [04:17:43.534] } [04:17:43.534] else if (identical(strategy, "list")) { [04:17:43.534] if (debug) [04:17:43.534] mdebugf("Getting full stack: [n=%d] %s", length(stack), [04:17:43.534] commaq(sapply(stack, FUN = class))) [04:17:43.534] if (all(c("codalm", "testthat") %in% loadedNamespaces())) { [04:17:43.534] ignore <- c("init", "backend") [04:17:43.534] class <- class(stack) [04:17:43.534] stack <- lapply(stack, FUN = function(s) { [04:17:43.534] for (name in ignore) attr(s, name) <- NULL [04:17:43.534] s [04:17:43.534] }) [04:17:43.534] class(stack) <- class [04:17:43.534] } [04:17:43.534] return(stack) [04:17:43.534] } [04:17:43.534] else if (identical(strategy, "tail")) { [04:17:43.534] stack <- stack[-1] [04:17:43.534] if (debug) [04:17:43.534] mdebugf("Getting stack without first backend: [n=%d] %s", [04:17:43.534] length(stack), commaq(sapply(stack, FUN = class))) [04:17:43.534] return(stack) [04:17:43.534] } [04:17:43.534] else if (identical(strategy, "reset")) { [04:17:43.534] if (debug) [04:17:43.534] mdebug_push("Resetting stack ...") [04:17:43.534] plan_cleanup(stack[[1]], cleanup = .cleanup, debug = debug) [04:17:43.534] stack <<- plan_default_stack() [04:17:43.534] if (debug) [04:17:43.534] mdebug_pop() [04:17:43.534] return(stack) [04:17:43.534] } [04:17:43.534] else if (identical(strategy, "pop")) { [04:17:43.534] if (debug) [04:17:43.534] mdebug_push("Popping stack ...") [04:17:43.534] oldStack <- stack [04:17:43.534] stack <<- stack[-1L] [04:17:43.534] if (length(stack) == 0L) [04:17:43.534] stack <<- plan_default_stack() [04:17:43.534] if (debug) [04:17:43.534] mdebug_pop() [04:17:43.534] return(oldStack) [04:17:43.534] } [04:17:43.534] oldStack <- stack [04:17:43.534] newStack <- NULL [04:17:43.534] targs <- list(...) [04:17:43.534] if (is.function(strategy)) { [04:17:43.534] if (length(targs) > 0) { [04:17:43.534] args <- c(list(strategy), targs, penvir = parent.frame()) [04:17:43.534] strategy <- do.call(tweak, args = args) [04:17:43.534] } [04:17:43.534] strategy <- list(strategy) [04:17:43.534] } [04:17:43.534] if (is.list(strategy)) { [04:17:43.534] oldStack <- plan_set(strategy, skip = .skip, cleanup = .cleanup, [04:17:43.534] init = .init, debug = debug) [04:17:43.534] return(invisible(oldStack)) [04:17:43.534] } [04:17:43.534] if (is.language(strategy)) { [04:17:43.534] first <- as.list(strategy)[[1]] [04:17:43.534] if (is.symbol(first)) { [04:17:43.534] if (is.call(strategy)) { [04:17:43.534] first <- get(as.character(first), mode = "function", [04:17:43.534] envir = parent.frame(), inherits = TRUE) [04:17:43.534] } [04:17:43.534] else { [04:17:43.534] first <- eval(first, envir = parent.frame(), [04:17:43.534] enclos = baseenv()) [04:17:43.534] } [04:17:43.534] if (is.list(first)) { [04:17:43.534] strategies <- first [04:17:43.534] res <- plan(strategies, substitute = FALSE, .cleanup = .cleanup, [04:17:43.534] .init = .init) [04:17:43.534] return(invisible(res)) [04:17:43.534] } [04:17:43.534] if (is.function(first) && !inherits(first, "future")) { [04:17:43.534] strategies <- eval(strategy, envir = parent.frame(), [04:17:43.534] enclos = baseenv()) [04:17:43.534] if (is.list(strategies)) { [04:17:43.534] for (kk in seq_along(strategies)) { [04:17:43.534] strategy_kk <- strategies[[kk]] [04:17:43.534] if (is.character(strategy_kk)) { [04:17:43.534] strategy_kk <- tweak(strategy_kk, penvir = parent.frame()) [04:17:43.534] strategies[[kk]] <- strategy_kk [04:17:43.534] } [04:17:43.534] } [04:17:43.534] newStack <- strategies [04:17:43.534] stop_if_not(!is.null(newStack), is.list(newStack), [04:17:43.534] length(newStack) >= 1L) [04:17:43.534] } [04:17:43.534] else if (is.function(strategies) && !inherits(strategies, [04:17:43.534] "future")) { [04:17:43.534] strategies <- list(strategies) [04:17:43.534] newStack <- strategies [04:17:43.534] stop_if_not(!is.null(newStack), is.list(newStack), [04:17:43.534] length(newStack) >= 1L) [04:17:43.534] } [04:17:43.534] } [04:17:43.534] } [04:17:43.534] } [04:17:43.534] if (is.null(newStack)) { [04:17:43.534] if (is.symbol(strategy)) { [04:17:43.534] strategy <- eval(strategy, envir = parent.frame(), [04:17:43.534] enclos = baseenv()) [04:17:43.534] } [04:17:43.534] else if (is.language(strategy)) { [04:17:43.534] strategyT <- as.list(strategy) [04:17:43.534] if (strategyT[[1]] == as.symbol("tweak")) { [04:17:43.534] strategy <- eval(strategy, envir = parent.frame(), [04:17:43.534] enclos = baseenv()) [04:17:43.534] } [04:17:43.534] else { [04:17:43.534] isSymbol <- sapply(strategyT, FUN = is.symbol) [04:17:43.534] if (!all(isSymbol)) { [04:17:43.534] strategy <- eval(strategyT[[1L]], envir = parent.frame(), [04:17:43.534] enclos = baseenv()) [04:17:43.534] if (length(strategyT) > 1L) { [04:17:43.534] args <- c(list(strategy), strategyT[-1L], [04:17:43.534] penvir = parent.frame()) [04:17:43.534] strategy <- do.call(tweak, args = args) [04:17:43.534] } [04:17:43.534] } [04:17:43.534] else { [04:17:43.534] strategy <- eval(strategy, envir = parent.frame(), [04:17:43.534] enclos = baseenv()) [04:17:43.534] } [04:17:43.534] } [04:17:43.534] } [04:17:43.534] args <- c(list(strategy), targs, penvir = parent.frame()) [04:17:43.534] tstrategy <- do.call(tweak, args = args, quote = TRUE) [04:17:43.534] newStack <- list(tstrategy) [04:17:43.534] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [04:17:43.534] 1L) [04:17:43.534] } [04:17:43.534] if (!is.null(.call)) { [04:17:43.534] call <- if (isTRUE(.call)) [04:17:43.534] sys.call() [04:17:43.534] else .call [04:17:43.534] for (kk in seq_along(newStack)) { [04:17:43.534] strategy <- newStack[[kk]] [04:17:43.534] if (!is.null(attr(strategy, "call", exact = TRUE))) [04:17:43.534] next [04:17:43.534] attr(strategy, "call") <- call [04:17:43.534] newStack[[kk]] <- strategy [04:17:43.534] } [04:17:43.534] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [04:17:43.534] 1L) [04:17:43.534] } [04:17:43.534] oldStack <- plan_set(newStack, skip = .skip, cleanup = .cleanup, [04:17:43.534] init = .init, debug = debug) [04:17:43.534] invisible(oldStack) [04:17:43.534] } [04:17:43.534] [04:17:43.534] 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') ... [04:17:46.919] function (strategy = NULL, ..., substitute = TRUE, .skip = FALSE, [04:17:46.919] .call = TRUE, .cleanup = NA, .init = TRUE) [04:17:46.919] { [04:17:46.919] if (substitute) [04:17:46.919] strategy <- substitute(strategy) [04:17:46.919] if (is.logical(.skip)) [04:17:46.919] stop_if_not(length(.skip) == 1L, !is.na(.skip)) [04:17:46.919] if (is.logical(.call)) [04:17:46.919] stop_if_not(length(.call) == 1L, !is.na(.call)) [04:17:46.919] debug <- isTRUE(getOption("future.debug")) [04:17:46.919] if (debug) { [04:17:46.919] if (inherits(strategy, "character")) { [04:17:46.919] first <- sprintf("\"%s\"", strategy) [04:17:46.919] } [04:17:46.919] else { [04:17:46.919] first <- sprintf("<%s>", commaq(class(strategy)[1])) [04:17:46.919] } [04:17:46.919] mdebugf_push("plan(%s, .skip = %s, .cleanup = %s, .init = %s) ...", [04:17:46.919] first, .skip, .cleanup, .init) [04:17:46.919] on.exit(mdebug_pop()) [04:17:46.919] } [04:17:46.919] if (is.null(stack)) { [04:17:46.919] stack <<- plan_default_stack() [04:17:46.919] if (debug) [04:17:46.919] mdebug("Created default stack") [04:17:46.919] } [04:17:46.919] if (identical(strategy, "backend")) { [04:17:46.919] strategy <- stack[[1L]] [04:17:46.919] backend <- attr(strategy, "backend") [04:17:46.919] if (is.null(backend)) { [04:17:46.919] strategy <- plan_init(strategy, debug = debug) [04:17:46.919] stack[[1L]] <<- strategy [04:17:46.919] backend <- attr(strategy, "backend") [04:17:46.919] } [04:17:46.919] return(backend) [04:17:46.919] } [04:17:46.919] else if (is.null(strategy) || identical(strategy, "next")) { [04:17:46.919] strategy <- stack[[1L]] [04:17:46.919] if (!inherits(strategy, "FutureStrategy")) { [04:17:46.919] class(strategy) <- c("FutureStrategy", class(strategy)) [04:17:46.919] } [04:17:46.919] stop_if_not(is.function(strategy)) [04:17:46.919] if (debug) [04:17:46.919] mdebugf("Getting current (\"next\") strategy: %s", [04:17:46.919] commaq(class(strategy))) [04:17:46.919] return(strategy) [04:17:46.919] } [04:17:46.919] else if (identical(strategy, "default")) { [04:17:46.919] strategy <- getOption("future.plan") [04:17:46.919] if (is.null(strategy)) [04:17:46.919] strategy <- sequential [04:17:46.919] if (debug) [04:17:46.919] mdebugf("Getting default stack: %s", commaq(class(strategy))) [04:17:46.919] } [04:17:46.919] else if (identical(strategy, "list")) { [04:17:46.919] if (debug) [04:17:46.919] mdebugf("Getting full stack: [n=%d] %s", length(stack), [04:17:46.919] commaq(sapply(stack, FUN = class))) [04:17:46.919] if (all(c("codalm", "testthat") %in% loadedNamespaces())) { [04:17:46.919] ignore <- c("init", "backend") [04:17:46.919] class <- class(stack) [04:17:46.919] stack <- lapply(stack, FUN = function(s) { [04:17:46.919] for (name in ignore) attr(s, name) <- NULL [04:17:46.919] s [04:17:46.919] }) [04:17:46.919] class(stack) <- class [04:17:46.919] } [04:17:46.919] return(stack) [04:17:46.919] } [04:17:46.919] else if (identical(strategy, "tail")) { [04:17:46.919] stack <- stack[-1] [04:17:46.919] if (debug) [04:17:46.919] mdebugf("Getting stack without first backend: [n=%d] %s", [04:17:46.919] length(stack), commaq(sapply(stack, FUN = class))) [04:17:46.919] return(stack) [04:17:46.919] } [04:17:46.919] else if (identical(strategy, "reset")) { [04:17:46.919] if (debug) [04:17:46.919] mdebug_push("Resetting stack ...") [04:17:46.919] plan_cleanup(stack[[1]], cleanup = .cleanup, debug = debug) [04:17:46.919] stack <<- plan_default_stack() [04:17:46.919] if (debug) [04:17:46.919] mdebug_pop() [04:17:46.919] return(stack) [04:17:46.919] } [04:17:46.919] else if (identical(strategy, "pop")) { [04:17:46.919] if (debug) [04:17:46.919] mdebug_push("Popping stack ...") [04:17:46.919] oldStack <- stack [04:17:46.919] stack <<- stack[-1L] [04:17:46.919] if (length(stack) == 0L) [04:17:46.919] stack <<- plan_default_stack() [04:17:46.919] if (debug) [04:17:46.919] mdebug_pop() [04:17:46.919] return(oldStack) [04:17:46.919] } [04:17:46.919] oldStack <- stack [04:17:46.919] newStack <- NULL [04:17:46.919] targs <- list(...) [04:17:46.919] if (is.function(strategy)) { [04:17:46.919] if (length(targs) > 0) { [04:17:46.919] args <- c(list(strategy), targs, penvir = parent.frame()) [04:17:46.919] strategy <- do.call(tweak, args = args) [04:17:46.919] } [04:17:46.919] strategy <- list(strategy) [04:17:46.919] } [04:17:46.919] if (is.list(strategy)) { [04:17:46.919] oldStack <- plan_set(strategy, skip = .skip, cleanup = .cleanup, [04:17:46.919] init = .init, debug = debug) [04:17:46.919] return(invisible(oldStack)) [04:17:46.919] } [04:17:46.919] if (is.language(strategy)) { [04:17:46.919] first <- as.list(strategy)[[1]] [04:17:46.919] if (is.symbol(first)) { [04:17:46.919] if (is.call(strategy)) { [04:17:46.919] first <- get(as.character(first), mode = "function", [04:17:46.919] envir = parent.frame(), inherits = TRUE) [04:17:46.919] } [04:17:46.919] else { [04:17:46.919] first <- eval(first, envir = parent.frame(), [04:17:46.919] enclos = baseenv()) [04:17:46.919] } [04:17:46.919] if (is.list(first)) { [04:17:46.919] strategies <- first [04:17:46.919] res <- plan(strategies, substitute = FALSE, .cleanup = .cleanup, [04:17:46.919] .init = .init) [04:17:46.919] return(invisible(res)) [04:17:46.919] } [04:17:46.919] if (is.function(first) && !inherits(first, "future")) { [04:17:46.919] strategies <- eval(strategy, envir = parent.frame(), [04:17:46.919] enclos = baseenv()) [04:17:46.919] if (is.list(strategies)) { [04:17:46.919] for (kk in seq_along(strategies)) { [04:17:46.919] strategy_kk <- strategies[[kk]] [04:17:46.919] if (is.character(strategy_kk)) { [04:17:46.919] strategy_kk <- tweak(strategy_kk, penvir = parent.frame()) [04:17:46.919] strategies[[kk]] <- strategy_kk [04:17:46.919] } [04:17:46.919] } [04:17:46.919] newStack <- strategies [04:17:46.919] stop_if_not(!is.null(newStack), is.list(newStack), [04:17:46.919] length(newStack) >= 1L) [04:17:46.919] } [04:17:46.919] else if (is.function(strategies) && !inherits(strategies, [04:17:46.919] "future")) { [04:17:46.919] strategies <- list(strategies) [04:17:46.919] newStack <- strategies [04:17:46.919] stop_if_not(!is.null(newStack), is.list(newStack), [04:17:46.919] length(newStack) >= 1L) [04:17:46.919] } [04:17:46.919] } [04:17:46.919] } [04:17:46.919] } [04:17:46.919] if (is.null(newStack)) { [04:17:46.919] if (is.symbol(strategy)) { [04:17:46.919] strategy <- eval(strategy, envir = parent.frame(), [04:17:46.919] enclos = baseenv()) [04:17:46.919] } [04:17:46.919] else if (is.language(strategy)) { [04:17:46.919] strategyT <- as.list(strategy) [04:17:46.919] if (strategyT[[1]] == as.symbol("tweak")) { [04:17:46.919] strategy <- eval(strategy, envir = parent.frame(), [04:17:46.919] enclos = baseenv()) [04:17:46.919] } [04:17:46.919] else { [04:17:46.919] isSymbol <- sapply(strategyT, FUN = is.symbol) [04:17:46.919] if (!all(isSymbol)) { [04:17:46.919] strategy <- eval(strategyT[[1L]], envir = parent.frame(), [04:17:46.919] enclos = baseenv()) [04:17:46.919] if (length(strategyT) > 1L) { [04:17:46.919] args <- c(list(strategy), strategyT[-1L], [04:17:46.919] penvir = parent.frame()) [04:17:46.919] strategy <- do.call(tweak, args = args) [04:17:46.919] } [04:17:46.919] } [04:17:46.919] else { [04:17:46.919] strategy <- eval(strategy, envir = parent.frame(), [04:17:46.919] enclos = baseenv()) [04:17:46.919] } [04:17:46.919] } [04:17:46.919] } [04:17:46.919] args <- c(list(strategy), targs, penvir = parent.frame()) [04:17:46.919] tstrategy <- do.call(tweak, args = args, quote = TRUE) [04:17:46.919] newStack <- list(tstrategy) [04:17:46.919] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [04:17:46.919] 1L) [04:17:46.919] } [04:17:46.919] if (!is.null(.call)) { [04:17:46.919] call <- if (isTRUE(.call)) [04:17:46.919] sys.call() [04:17:46.919] else .call [04:17:46.919] for (kk in seq_along(newStack)) { [04:17:46.919] strategy <- newStack[[kk]] [04:17:46.919] if (!is.null(attr(strategy, "call", exact = TRUE))) [04:17:46.919] next [04:17:46.919] attr(strategy, "call") <- call [04:17:46.919] newStack[[kk]] <- strategy [04:17:46.919] } [04:17:46.919] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [04:17:46.919] 1L) [04:17:46.919] } [04:17:46.919] oldStack <- plan_set(newStack, skip = .skip, cleanup = .cleanup, [04:17:46.919] init = .init, debug = debug) [04:17:46.919] invisible(oldStack) [04:17:46.919] } [04:17:46.919] [04:17:46.919] 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') ... [04:17:50.134] function (strategy = NULL, ..., substitute = TRUE, .skip = FALSE, [04:17:50.134] .call = TRUE, .cleanup = NA, .init = TRUE) [04:17:50.134] { [04:17:50.134] if (substitute) [04:17:50.134] strategy <- substitute(strategy) [04:17:50.134] if (is.logical(.skip)) [04:17:50.134] stop_if_not(length(.skip) == 1L, !is.na(.skip)) [04:17:50.134] if (is.logical(.call)) [04:17:50.134] stop_if_not(length(.call) == 1L, !is.na(.call)) [04:17:50.134] debug <- isTRUE(getOption("future.debug")) [04:17:50.134] if (debug) { [04:17:50.134] if (inherits(strategy, "character")) { [04:17:50.134] first <- sprintf("\"%s\"", strategy) [04:17:50.134] } [04:17:50.134] else { [04:17:50.134] first <- sprintf("<%s>", commaq(class(strategy)[1])) [04:17:50.134] } [04:17:50.134] mdebugf_push("plan(%s, .skip = %s, .cleanup = %s, .init = %s) ...", [04:17:50.134] first, .skip, .cleanup, .init) [04:17:50.134] on.exit(mdebug_pop()) [04:17:50.134] } [04:17:50.134] if (is.null(stack)) { [04:17:50.134] stack <<- plan_default_stack() [04:17:50.134] if (debug) [04:17:50.134] mdebug("Created default stack") [04:17:50.134] } [04:17:50.134] if (identical(strategy, "backend")) { [04:17:50.134] strategy <- stack[[1L]] [04:17:50.134] backend <- attr(strategy, "backend") [04:17:50.134] if (is.null(backend)) { [04:17:50.134] strategy <- plan_init(strategy, debug = debug) [04:17:50.134] stack[[1L]] <<- strategy [04:17:50.134] backend <- attr(strategy, "backend") [04:17:50.134] } [04:17:50.134] return(backend) [04:17:50.134] } [04:17:50.134] else if (is.null(strategy) || identical(strategy, "next")) { [04:17:50.134] strategy <- stack[[1L]] [04:17:50.134] if (!inherits(strategy, "FutureStrategy")) { [04:17:50.134] class(strategy) <- c("FutureStrategy", class(strategy)) [04:17:50.134] } [04:17:50.134] stop_if_not(is.function(strategy)) [04:17:50.134] if (debug) [04:17:50.134] mdebugf("Getting current (\"next\") strategy: %s", [04:17:50.134] commaq(class(strategy))) [04:17:50.134] return(strategy) [04:17:50.134] } [04:17:50.134] else if (identical(strategy, "default")) { [04:17:50.134] strategy <- getOption("future.plan") [04:17:50.134] if (is.null(strategy)) [04:17:50.134] strategy <- sequential [04:17:50.134] if (debug) [04:17:50.134] mdebugf("Getting default stack: %s", commaq(class(strategy))) [04:17:50.134] } [04:17:50.134] else if (identical(strategy, "list")) { [04:17:50.134] if (debug) [04:17:50.134] mdebugf("Getting full stack: [n=%d] %s", length(stack), [04:17:50.134] commaq(sapply(stack, FUN = class))) [04:17:50.134] if (all(c("codalm", "testthat") %in% loadedNamespaces())) { [04:17:50.134] ignore <- c("init", "backend") [04:17:50.134] class <- class(stack) [04:17:50.134] stack <- lapply(stack, FUN = function(s) { [04:17:50.134] for (name in ignore) attr(s, name) <- NULL [04:17:50.134] s [04:17:50.134] }) [04:17:50.134] class(stack) <- class [04:17:50.134] } [04:17:50.134] return(stack) [04:17:50.134] } [04:17:50.134] else if (identical(strategy, "tail")) { [04:17:50.134] stack <- stack[-1] [04:17:50.134] if (debug) [04:17:50.134] mdebugf("Getting stack without first backend: [n=%d] %s", [04:17:50.134] length(stack), commaq(sapply(stack, FUN = class))) [04:17:50.134] return(stack) [04:17:50.134] } [04:17:50.134] else if (identical(strategy, "reset")) { [04:17:50.134] if (debug) [04:17:50.134] mdebug_push("Resetting stack ...") [04:17:50.134] plan_cleanup(stack[[1]], cleanup = .cleanup, debug = debug) [04:17:50.134] stack <<- plan_default_stack() [04:17:50.134] if (debug) [04:17:50.134] mdebug_pop() [04:17:50.134] return(stack) [04:17:50.134] } [04:17:50.134] else if (identical(strategy, "pop")) { [04:17:50.134] if (debug) [04:17:50.134] mdebug_push("Popping stack ...") [04:17:50.134] oldStack <- stack [04:17:50.134] stack <<- stack[-1L] [04:17:50.134] if (length(stack) == 0L) [04:17:50.134] stack <<- plan_default_stack() [04:17:50.134] if (debug) [04:17:50.134] mdebug_pop() [04:17:50.134] return(oldStack) [04:17:50.134] } [04:17:50.134] oldStack <- stack [04:17:50.134] newStack <- NULL [04:17:50.134] targs <- list(...) [04:17:50.134] if (is.function(strategy)) { [04:17:50.134] if (length(targs) > 0) { [04:17:50.134] args <- c(list(strategy), targs, penvir = parent.frame()) [04:17:50.134] strategy <- do.call(tweak, args = args) [04:17:50.134] } [04:17:50.134] strategy <- list(strategy) [04:17:50.134] } [04:17:50.134] if (is.list(strategy)) { [04:17:50.134] oldStack <- plan_set(strategy, skip = .skip, cleanup = .cleanup, [04:17:50.134] init = .init, debug = debug) [04:17:50.134] return(invisible(oldStack)) [04:17:50.134] } [04:17:50.134] if (is.language(strategy)) { [04:17:50.134] first <- as.list(strategy)[[1]] [04:17:50.134] if (is.symbol(first)) { [04:17:50.134] if (is.call(strategy)) { [04:17:50.134] first <- get(as.character(first), mode = "function", [04:17:50.134] envir = parent.frame(), inherits = TRUE) [04:17:50.134] } [04:17:50.134] else { [04:17:50.134] first <- eval(first, envir = parent.frame(), [04:17:50.134] enclos = baseenv()) [04:17:50.134] } [04:17:50.134] if (is.list(first)) { [04:17:50.134] strategies <- first [04:17:50.134] res <- plan(strategies, substitute = FALSE, .cleanup = .cleanup, [04:17:50.134] .init = .init) [04:17:50.134] return(invisible(res)) [04:17:50.134] } [04:17:50.134] if (is.function(first) && !inherits(first, "future")) { [04:17:50.134] strategies <- eval(strategy, envir = parent.frame(), [04:17:50.134] enclos = baseenv()) [04:17:50.134] if (is.list(strategies)) { [04:17:50.134] for (kk in seq_along(strategies)) { [04:17:50.134] strategy_kk <- strategies[[kk]] [04:17:50.134] if (is.character(strategy_kk)) { [04:17:50.134] strategy_kk <- tweak(strategy_kk, penvir = parent.frame()) [04:17:50.134] strategies[[kk]] <- strategy_kk [04:17:50.134] } [04:17:50.134] } [04:17:50.134] newStack <- strategies [04:17:50.134] stop_if_not(!is.null(newStack), is.list(newStack), [04:17:50.134] length(newStack) >= 1L) [04:17:50.134] } [04:17:50.134] else if (is.function(strategies) && !inherits(strategies, [04:17:50.134] "future")) { [04:17:50.134] strategies <- list(strategies) [04:17:50.134] newStack <- strategies [04:17:50.134] stop_if_not(!is.null(newStack), is.list(newStack), [04:17:50.134] length(newStack) >= 1L) [04:17:50.134] } [04:17:50.134] } [04:17:50.134] } [04:17:50.134] } [04:17:50.134] if (is.null(newStack)) { [04:17:50.134] if (is.symbol(strategy)) { [04:17:50.134] strategy <- eval(strategy, envir = parent.frame(), [04:17:50.134] enclos = baseenv()) [04:17:50.134] } [04:17:50.134] else if (is.language(strategy)) { [04:17:50.134] strategyT <- as.list(strategy) [04:17:50.134] if (strategyT[[1]] == as.symbol("tweak")) { [04:17:50.134] strategy <- eval(strategy, envir = parent.frame(), [04:17:50.134] enclos = baseenv()) [04:17:50.134] } [04:17:50.134] else { [04:17:50.134] isSymbol <- sapply(strategyT, FUN = is.symbol) [04:17:50.134] if (!all(isSymbol)) { [04:17:50.134] strategy <- eval(strategyT[[1L]], envir = parent.frame(), [04:17:50.134] enclos = baseenv()) [04:17:50.134] if (length(strategyT) > 1L) { [04:17:50.134] args <- c(list(strategy), strategyT[-1L], [04:17:50.134] penvir = parent.frame()) [04:17:50.134] strategy <- do.call(tweak, args = args) [04:17:50.134] } [04:17:50.134] } [04:17:50.134] else { [04:17:50.134] strategy <- eval(strategy, envir = parent.frame(), [04:17:50.134] enclos = baseenv()) [04:17:50.134] } [04:17:50.134] } [04:17:50.134] } [04:17:50.134] args <- c(list(strategy), targs, penvir = parent.frame()) [04:17:50.134] tstrategy <- do.call(tweak, args = args, quote = TRUE) [04:17:50.134] newStack <- list(tstrategy) [04:17:50.134] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [04:17:50.134] 1L) [04:17:50.134] } [04:17:50.134] if (!is.null(.call)) { [04:17:50.134] call <- if (isTRUE(.call)) [04:17:50.134] sys.call() [04:17:50.134] else .call [04:17:50.134] for (kk in seq_along(newStack)) { [04:17:50.134] strategy <- newStack[[kk]] [04:17:50.134] if (!is.null(attr(strategy, "call", exact = TRUE))) [04:17:50.134] next [04:17:50.134] attr(strategy, "call") <- call [04:17:50.134] newStack[[kk]] <- strategy [04:17:50.134] } [04:17:50.134] stop_if_not(!is.null(newStack), is.list(newStack), length(newStack) >= [04:17:50.134] 1L) [04:17:50.134] } [04:17:50.134] oldStack <- plan_set(newStack, skip = .skip, cleanup = .cleanup, [04:17:50.134] init = .init, debug = debug) [04:17:50.134] invisible(oldStack) [04:17:50.134] } [04:17:50.134] [04:17:50.134] 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 Sourcing 6 epilogue scripts ... 01/06 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_epilogue/001.undo-future.R' 02/06 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_epilogue/002.undo-state.R' Failed to undo environment variables: - Expected environment variables: [n=215] '!ExitCode', 'ALLUSERSPROFILE', 'APPDATA', ..., 'tempdirname' - Environment variables still there: [n=0] - Environment variables missing: [n=1] 'MAKEFLAGS' Differences environment variable by environment variable: 03/06 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_epilogue/090.gc.R' 04/06 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_epilogue/099.session_info.R' 05/06 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_epilogue/995.detritus-connections.R' 06/06 epilogue script 'D:/RCompile/CRANincoming/R-devel/lib/future.batchtools/testme/_epilogue/999.detritus-files.R' Skipping, because path appears not to be an 'R CMD check' folder: 'D:/temp/2025_09_21_04_15_17_31299' Sourcing 6 epilogue scripts ... done Test time: user.self=4s, sys.self=0.5s, elapsed=2e+01s, user.child=NAs, sys.child=NAs Test 'tempdirname' ... success > > proc.time() user system elapsed 4.25 0.60 15.64