/usr/lib/R/site-library/BiocParallel/unitTests/test_errorhandling.R is in r-bioc-biocparallel 1.4.0-1.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
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 | ## NOTE: On Windows, MulticoreParam() throws a warning and instantiates
## a single FORK worker using scripts from parallel. No logging or
## error catching is implemented.
library(doParallel)
checkExceptionText <- function(expr, txt, negate=FALSE, msg="")
{
x <- try(eval(expr), silent=TRUE)
checkTrue(inherits(x, "condition"), msg=msg)
checkTrue(xor(negate, grepl(txt, as.character(x), fixed=TRUE)), msg=msg)
}
test_catching_errors <- function()
{
if (.Platform$OS.type != "windows") {
x <- 1:10
y <- rev(x)
f <- function(x, y) if (x > y) stop("whooops") else x + y
registerDoParallel(2)
params <- list(
serial=SerialParam(catch.errors=TRUE),
snow=SnowParam(2),
dopar=DoparParam(),
batchjobs=BatchJobsParam(progressbar=FALSE),
mc <- MulticoreParam(2))
for (param in params) {
res <- bplapply(list(1, "2", 3), sqrt, BPPARAM=param)
checkTrue(length(res) == 3L)
msg <- "non-numeric argument to mathematical function"
checkIdentical(conditionMessage(res[[2]]), msg)
closeAllConnections()
}
## clean up
env <- foreach:::.foreachGlobals
rm(list=ls(name=env), pos=env)
closeAllConnections()
TRUE
} else TRUE
}
test_BPREDO <- function()
{
if (.Platform$OS.type != "windows") {
f = sqrt
x = list(1, "2", 3)
x.fix = list(1, 2, 3)
registerDoParallel(2)
params <- list(
serial=SerialParam(catch.errors=TRUE),
snow=SnowParam(2),
dopar=DoparParam(),
batchjobs=BatchJobsParam(progressbar=FALSE),
mc <- MulticoreParam(2))
for (param in params) {
res <- bpmapply(f, x, BPPARAM=param, SIMPLIFY=TRUE)
checkTrue(inherits(res[[2]], "condition"))
closeAllConnections()
Sys.sleep(0.25)
## data not fixed
res2 <- bpmapply(f, x, BPPARAM=param, BPREDO=res, SIMPLIFY=TRUE)
checkTrue(inherits(res2[[2]], "condition"))
closeAllConnections()
Sys.sleep(0.25)
## data fixed
res3 <- bpmapply(f, x.fix, BPPARAM=param, BPREDO=res, SIMPLIFY=TRUE)
checkIdentical(res3, sqrt(1:3))
closeAllConnections()
Sys.sleep(0.25)
}
## clean up
env <- foreach:::.foreachGlobals
rm(list=ls(name=env), pos=env)
closeAllConnections()
TRUE
} else TRUE
}
test_bpiterate_errors <- function()
{
quiet <- suppressMessages
.lazyCount <- function(count) {
count <- count
i <- 0L
function() {
if (i >= count)
return(NULL)
else
i <<- i + 1L
if (i == 2)
"2"
else
i
}
}
FUN <- function(count, ...) {
if (count == 2)
stop("hit error")
else count
}
params <- list(snow=SnowParam(2, stop.on.error=TRUE))
if (.Platform$OS.type != "windows")
params$mc <- MulticoreParam(2, stop.on.error=TRUE)
for (p in params) {
ITER <- .lazyCount(3)
quiet(res <- bpiterate(ITER, FUN, BPPARAM=p))
checkTrue(is(res[[2]], "condition"))
closeAllConnections()
}
## clean up
closeAllConnections()
TRUE
}
|