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
|
message("Testing bpoptions")
.checkMessage <- function(x) {
message <- character()
result <- withCallingHandlers(x, message = function(condition) {
message <<- c(message, conditionMessage(condition))
invokeRestart("muffleMessage")
})
checkTrue(length(message) > 0)
}
## Normal reduce process
test_bpoptions_constructor <- function() {
opts <- bpoptions()
checkIdentical(opts, list())
opts <- bpoptions(tasks = 1)
checkIdentical(opts, list(tasks = 1))
.checkMessage(opts <- bpoptions(randomArg = 1))
checkIdentical(opts, list(randomArg = 1))
.checkMessage(opts <- bpoptions(tasks = 1, randomArg = 1))
checkIdentical(opts, list(tasks = 1, randomArg = 1))
}
test_bpoptions_bplapply <- function() {
p <- SerialParam()
## bpoptions only changes BPPARAM temporarily
oldValue <- bptasks(p)
opts <- bpoptions(tasks = 100)
result0 <- bplapply(1:2, function(x) x, BPPARAM = p, BPOPTIONS = opts)
checkIdentical(bptasks(p), oldValue)
## check if bpoptions really works
opts <- bpoptions(timeout = 1)
checkException(
bplapply(1:2, function(x) {
t <- Sys.time()
## spin...
while(difftime(Sys.time(), t) < 2) {}
}, BPPARAM = p, BPOPTIONS = opts)
)
## Random argument has no effect on bplapply
.checkMessage(opts <- bpoptions(randomArg = 100))
result1 <- bplapply(1:2, function(x) x, BPPARAM = p, BPOPTIONS = opts)
checkIdentical(result0, result1)
}
test_bpoptions_manually_export <- function(){
p <- SnowParam(2, exportglobals = FALSE)
bpstart(p)
on.exit(bpstop(p), add = TRUE)
## global variables that cannot be found by auto export
bar <- function() x
environment(bar) <- .GlobalEnv
foo <- function(x) bar()
environment(foo) <- .GlobalEnv
assign("x", 10, envir = .GlobalEnv)
assign("bar", bar, envir = .GlobalEnv)
on.exit(rm(x, bar, envir = .GlobalEnv), add = TRUE)
## auto export would not work here
bpexportvariables(p) <- FALSE
checkException(bplapply(1:2, foo, BPPARAM = p), silent = TRUE)
## still not work as no auto export
opts <- bpoptions(exports = "x")
checkException(bplapply(1:2, foo, BPPARAM = p, BPOPTIONS = opts),
silent = TRUE)
## manually export all variables
opts <- bpoptions(exports = c("x", "bar"))
res <- bplapply(1:2, foo, BPPARAM = p, BPOPTIONS = opts)
checkIdentical(res, rep(list(10), 2))
## enable auto export would not solve the problem
bpexportvariables(p) <- TRUE
checkException(bplapply(1:2, foo, BPPARAM = p), silent = TRUE)
## manually export the variables which is missing from auto export
opts <- bpoptions(exports = "x")
res <- bplapply(1:2, foo, BPPARAM = p, BPOPTIONS = opts)
checkIdentical(res, rep(list(10), 2))
## manually export packages
bar2 <- function(x) SerialParam()
environment(bar2) <- .GlobalEnv
foo2 <- function(x) bar2()
environment(foo2) <- .GlobalEnv
assign("x", 10, envir = .GlobalEnv)
assign("bar2", bar2, envir = .GlobalEnv)
on.exit(rm(bar2, envir = .GlobalEnv), add = TRUE)
bpexportvariables(p) <- TRUE
checkException(bplapply(1:2, foo2, BPPARAM = p), silent = TRUE)
opts <- bpoptions(packages = c("BiocParallel"))
res <- bplapply(1:2, foo2, BPPARAM = p, BPOPTIONS = opts)
checkTrue(is(res[[1]], "SerialParam"))
## https://github.com/Bioconductor/BiocParallel/issues/234
opts <- bpoptions(exports = "x")
res <- bplapply(1:2, foo, BPPARAM = SerialParam(), BPOPTIONS = opts)
checkIdentical(res, rep(list(10), 2))
checkIdentical(.GlobalEnv[["x"]], 10)
}
|
