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
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
|
source("incl/start.R")
library("listenv")
message("*** batchtools_multicore() ...")
for (cores in 1:min(2L, availableCores("multicore"))) {
## FIXME:
if (!fullTest && cores > 1) next
## CRAN processing times:
## On Windows 32-bit, don't run these tests
if (!fullTest && isWin32) next
mprintf("Testing with %d cores ...\n", cores)
options(mc.cores = cores - 1L)
if (!supportsMulticore()) {
mprintf("batchtools multicore futures are not supporting on '%s'. Falling back to use synchroneous batchtools local futures\n", .Platform$OS.type) #nolint
}
for (globals in c(FALSE, TRUE)) {
mprintf("*** batchtools_multicore(..., globals = %s) without globals\n",
globals)
f <- batchtools_multicore({
42L
}, globals = globals)
stopifnot(
inherits(f, "BatchtoolsFuture") ||
((cores == 1 || !supportsMulticore()) && inherits(f, "SequentialFuture"))
)
print(resolved(f))
y <- value(f)
print(y)
stopifnot(y == 42L)
mprintf("*** batchtools_multicore(..., globals = %s) with globals\n",
globals)
## A global variable
a <- 0
f <- batchtools_multicore({
b <- 3
c <- 2
a * b * c
}, globals = globals)
## A multicore future is evaluated in a separated
## forked process. Changing the value of a global
## variable should not affect the result of the
## future.
a <- 7 ## Make sure globals are frozen
if (globals || f$config$reg$cluster.functions$name == "Multicore") {
v <- value(f)
print(v)
stopifnot(v == 0)
} else {
res <- tryCatch({ value(f) }, error = identity)
print(res)
stopifnot(inherits(res, "simpleError"))
}
mprintf("*** batchtools_multicore(..., globals = %s) with globals and blocking\n", globals) #nolint
x <- listenv()
for (ii in 1:2) {
mprintf(" - Creating batchtools_multicore future #%d ...\n", ii)
x[[ii]] <- batchtools_multicore({ ii }, globals = globals)
}
mprintf(" - Resolving %d batchtools_multicore futures\n", length(x))
if (globals || f$config$reg$cluster.functions$name == "Multicore") {
v <- unlist(value(x))
stopifnot(all(v == 1:2))
} else {
v <- lapply(x, FUN = function(f) tryCatch(value(f), error = identity))
stopifnot(all(sapply(v, FUN = inherits, "simpleError")))
}
} # for (globals ...)
if (cores > 1) {
message("*** batchtools_multicore(..., workers = 1L) ...")
a <- 2
b <- 3
y_truth <- a * b
f <- batchtools_multicore({ a * b }, workers = 1L)
rm(list = c("a", "b"))
v <- value(f)
print(v)
stopifnot(v == y_truth)
message("*** batchtools_multicore(..., workers = 1L) ... DONE")
}
mprintf("Testing with %d cores ... DONE\n", cores)
} ## for (cores ...)
## CRAN processing times:
## On Windows 32-bit, don't run these tests
if (fullTest || !isWin32) {
mprintf("*** batchtools_multicore() and errors\n")
f <- batchtools_multicore({
stop("Whoops!")
1
})
v <- value(f, signal = FALSE)
print(v)
stopifnot(inherits(v, "simpleError"))
res <- try(value(f), silent = TRUE)
print(res)
stopifnot(inherits(res, "try-error"))
## Error is repeated
res <- try(value(f), silent = TRUE)
print(res)
stopifnot(inherits(res, "try-error"))
}
message("*** batchtools_multicore() ... DONE")
source("incl/end.R")
|
