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
126
127
128
129
130
131
132
133
134
135
|
## .workerEnvironmentVariable
## .defaultWorkers()
## .enforceWorkers(workers, type)
message("Testing worker-number")
.resetEnv <- function(name, value) {
if (is.na(value)) {
Sys.unsetenv(name)
} else {
value <- list(value)
names(value) <- name
do.call("Sys.setenv", value)
}
}
test_defaultWorkers <- function()
{
o_check_limits <- Sys.getenv("_R_CHECK_LIMIT_CORES_", NA)
Sys.unsetenv("_R_CHECK_LIMIT_CORES_")
o_bbs_home <- Sys.getenv("IS_BIOC_BUILD_MACHINE", NA)
Sys.unsetenv("IS_BIOC_BUILD_MACHINE")
o_worker_n <- Sys.getenv("BIOCPARALLEL_WORKER_NUMBER", NA)
Sys.unsetenv("BIOCPARALLEL_WORKER_NUMBER")
on.exit({
.resetEnv("_R_CHECK_LIMIT_CORES_", o_check_limits)
.resetEnv("IS_BIOC_BUILD_MACHINE", o_bbs_home)
.resetEnv("BIOCPARALLEL_WORKER_NUMBER", o_worker_n)
})
checkIdentical(parallel::detectCores() - 2L, bpnworkers(SnowParam()))
Sys.setenv(BIOCPARALLEL_WORKER_NUMBER = 5)
checkIdentical(5L, bpnworkers(SnowParam()))
Sys.setenv(IS_BIOC_BUILD_MACHINE="true")
checkIdentical(4L, bpnworkers(SnowParam()))
Sys.setenv(`_R_CHECK_LIMIT_CORES_` = TRUE)
checkIdentical(2L, bpnworkers(SnowParam()))
}
test_enforceWorkers <- function()
{
o_check_limits <- Sys.getenv("_R_CHECK_LIMIT_CORES_", NA)
Sys.unsetenv("_R_CHECK_LIMIT_CORES_")
o_bbs_home <- Sys.getenv("IS_BIOC_BUILD_MACHINE", NA)
Sys.unsetenv("IS_BIOC_BUILD_MACHINE")
o_worker_max <- Sys.getenv("BIOCPARALLEL_WORKER_MAX", NA)
Sys.unsetenv("BIOCPARALLEL_WORKER_MAX")
on.exit({
.resetEnv("_R_CHECK_LIMIT_CORES_", o_check_limits)
.resetEnv("IS_BIOC_BUILD_MACHINE", o_bbs_home)
.resetEnv("BIOCPARALLEL_WORKER_MAX", o_worker_max)
})
checkIdentical(6L, bpnworkers(SnowParam(6L)))
Sys.setenv(BIOCPARALLEL_WORKER_MAX = 5L)
warn <- FALSE
withCallingHandlers({
obs <- bpnworkers(SnowParam(6))
}, warning = function(x) {
warn <<- startsWith(
trimws(conditionMessage(x)),
"'BIOCPARALLEL_WORKER_MAX' environment variable detected"
)
invokeRestart("muffleWarning")
})
checkIdentical(5L, obs)
checkTrue(warn)
.resetEnv("BIOCPARALLEL_WORKER_MAX", o_worker_max)
Sys.setenv(IS_BIOC_BUILD_MACHINE = "true")
warn <- FALSE
withCallingHandlers({
obs <- bpnworkers(SnowParam(6))
}, warning = function(x) {
warn <<- startsWith(
trimws(conditionMessage(x)),
"'IS_BIOC_BUILD_MACHINE' environment variable detected"
)
invokeRestart("muffleWarning")
})
checkIdentical(4L, obs)
checkTrue(warn)
## .resetEnv("IS_BIOC_BUILD_MACHINE", o_bbs_home)
Sys.setenv(`_R_CHECK_LIMIT_CORES_` = "warn")
warn <- FALSE
withCallingHandlers({
obs <- bpnworkers(SnowParam(6))
}, warning = function(x) {
warn <<- startsWith(
trimws(conditionMessage(x)),
"'_R_CHECK_LIMIT_CORES_' environment variable detected"
)
invokeRestart("muffleWarning")
})
checkIdentical(2L, obs)
checkTrue(warn)
Sys.setenv(`_R_CHECK_LIMIT_CORES_` = "false")
warn <- FALSE
withCallingHandlers({
obs <- bpnworkers(SnowParam(4))
}, warning = function(x) {
warn <<- TRUE
invokeRestart("muffleWarning")
})
checkIdentical(4L, obs)
checkTrue(!warn)
Sys.setenv(`_R_CHECK_LIMIT_CORES_` = "true")
checkException(SnowParam(4), silent = TRUE)
}
test_bpnworkers_integer_valued <- function()
{
## https://github.com/Bioconductor/BiocParallel/issues/232
checkTrue(inherits(snowWorkers(), "integer")) # default
checkIdentical(2L, bpnworkers(SnowParam(c("foo", "bar"))))
checkIdentical(2L, bpnworkers(SnowParam(2)))
checkIdentical(2L, bpnworkers(SnowParam(2.1)))
checkIdentical(2L, bpnworkers(SnowParam(2.9)))
p <- SnowParam(2); bpworkers(p) <- 2
checkIdentical(2L, bpnworkers(p))
bpworkers(p) <- c("foo", "bar")
checkIdentical(2L, bpnworkers(p))
if (!identical(.Platform$OS.type, "windows")) {
checkIdentical(2L, bpnworkers(MulticoreParam(2.1)))
checkIdentical(2L, bpnworkers(MulticoreParam(2.9)))
checkIdentical(2L, bpnworkers(MulticoreParam(2)))
p <- MulticoreParam(2); bpworkers(p) <- 2
checkIdentical(2L, bpnworkers(p))
}
}
|
