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
|
message("Testing DoparParam")
test_DoparParam_orchestration_error <- function() {
test <-
requireNamespace("foreach", quietly = TRUE) &&
requireNamespace("doParallel", quietly = TRUE)
if (!test)
DEACTIVATED("'foreach' or 'doParallel' not available")
if (identical(.Platform$OS.type, "windows"))
DEACTIVATED("'DoparParam' orchestration error test not run on Windows")
y <- tryCatch({
cl <- parallel::makeCluster(1L)
doParallel::registerDoParallel(cl)
bplapply(1L, function(x) quit("no"), BPPARAM = DoparParam())
}, error = function(e) {
conditionMessage(e)
}, finally = {
parallel::stopCluster(cl)
})
checkTrue(startsWith(y, "'DoparParam()' foreach() error occurred: "))
}
test_DoparParam_bplapply <- function() {
test <-
requireNamespace("foreach", quietly = TRUE) &&
requireNamespace("doParallel", quietly = TRUE)
if (!test)
DEACTIVATED("'foreach' or 'doParallel' not available")
cl <- parallel::makeCluster(2L)
on.exit(parallel::stopCluster(cl))
doParallel::registerDoParallel(cl)
res0 <- bplapply(1:9, function(x) x + 1L, BPPARAM = SerialParam())
res <- bplapply(1:9, function(x) x + 1L, BPPARAM = DoparParam())
checkIdentical(res, res0)
}
test_DoparParam_bplapply_rng <- function() {
test <-
requireNamespace("foreach", quietly = TRUE) &&
requireNamespace("doParallel", quietly = TRUE)
if (!test)
DEACTIVATED("'foreach' or 'doParallel' not available")
cl <- parallel::makeCluster(2L)
on.exit(parallel::stopCluster(cl))
doParallel::registerDoParallel(cl)
res0 <- bplapply(1:9, function(x) runif(1),
BPPARAM = SerialParam(RNGseed = 123))
res <- bplapply(1:9, function(x) runif(1),
BPPARAM = DoparParam(RNGseed = 123))
checkIdentical(res, res0)
}
test_DoparParam_stop_on_error <- function() {
test <-
requireNamespace("foreach", quietly = TRUE) &&
requireNamespace("doParallel", quietly = TRUE)
if (!test)
DEACTIVATED("'foreach' or 'doParallel' not available")
cl <- parallel::makeCluster(2L)
on.exit(parallel::stopCluster(cl))
doParallel::registerDoParallel(cl)
fun <- function(x) {
if (x == 2) stop()
x
}
res1 <- bptry(bplapply(1:4, fun, BPPARAM = DoparParam(stop.on.error = F)))
checkEquals(res1[c(1,3,4)], as.list(c(1,3,4)))
checkTrue(is(res1[[2]], "error"))
res2 <- bptry(bplapply(1:6, fun, BPPARAM = DoparParam(stop.on.error = T)))
checkEquals(res2[c(1,4:6)], as.list(c(1,4:6)))
checkTrue(is(res2[[2]], "error"))
checkTrue(is(res2[[3]], "error"))
}
|
