1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
|
## Record original state
ovars <- ls()
oenvs <- oenvs0 <- Sys.getenv()
oopts0 <- options()
covr_testing <- ("covr" %in% loadedNamespaces())
on_solaris <- grepl("^solaris", R.version$os)
on_macos <- grepl("^darwin", R.version$os)
on_githubactions <- as.logical(Sys.getenv("GITHUB_ACTIONS", "FALSE"))
## Default options
oopts <- options(
warn = 1L,
mc.cores = 2L,
future.debug = FALSE,
future.wait.interval = 0.1, ## Speed up await() and delete()
## Reset the following during testing in case
## they are set on the test system
future.availableCores.system = NULL,
future.availableCores.fallback = NULL
)
oopts$future.delete <- getOption("future.delete")
oplan <- future::plan()
## In case it set outside, reset:
options(future.batchtools.workers = NULL)
Sys.unsetenv("R_FUTURE_BATCHTOOLS_WORKERS")
path <- Sys.getenv("R_BATCHTOOLS_SEARCH_PATH")
if (!nzchar(path)) {
path <- system.file(package = "future.batchtools",
"templates-for-R_CMD_check", mustWork = TRUE)
Sys.setenv(R_BATCHTOOLS_SEARCH_PATH = path)
} else {
warning("Using a non-standard R_BATCHTOOLS_SEARCH_PATH while testing: ",
sQuote(path))
if (!file_test("-d", path)) {
stop("R_BATCHTOOLS_SEARCH_PATH specifies a non-existing folder: ",
sQuote(path))
}
}
## Use local batchtools futures by default
future::plan(future.batchtools::batchtools_local)
fullTest <- (Sys.getenv("_R_CHECK_FULL_") != "")
isWin32 <- (.Platform$OS.type == "windows" && .Platform$r_arch == "i386")
all_strategies <- local({
.cache <- NULL
function(envir = parent.frame()) {
if (!is.null(.cache)) return(.cache)
strategies <- Sys.getenv("R_FUTURE_TESTS_STRATEGIES")
strategies <- unlist(strsplit(strategies, split = ","))
strategies <- gsub(" ", "", strategies)
strategies <- strategies[nzchar(strategies)]
## When testing for instance 'batchtools_sge', look for a customize
## template file, e.g. R_BATCHTOOLS_SEARCH_PATH/batchtools.sge.tmpl
if (length(strategies) > 0L) {
## If there is a custom R_BATCHTOOLS_SEARCH_PATH/setup.R' file, run it
pathname <- file.path(path, "setup.R")
if (file_test("-f", pathname)) source(pathname, local = envir)
}
strategies <- c(future:::supportedStrategies(), strategies)
strategies <- unique(strategies)
.cache <<- strategies
strategies
}
})
test_strategy <- function(strategy) {
strategy %in% all_strategies()
}
attached_packages <- future.batchtools:::attached_packages
await <- future.batchtools:::await
delete <- future.batchtools:::delete
import_future <- future.batchtools:::import_future
is_false <- future.batchtools:::is_false
is_na <- future.batchtools:::is_na
is_os <- future.batchtools:::is_os
hpaste <- future.batchtools:::hpaste
mcat <- function(...) message(..., appendLF = FALSE)
mprintf <- function(...) message(sprintf(...), appendLF = FALSE)
mprint <- future.batchtools:::mprint
mstr <- future.batchtools:::mstr
printf <- future.batchtools:::printf
temp_registry <- future.batchtools:::temp_registry
trim <- future.batchtools:::trim
attach_locally <- function(x, envir = parent.frame()) {
for (name in names(x)) {
assign(name, value = x[[name]], envir = envir)
}
}
|
