[Rd] make running on.exit expr uninterruptible
Andreas Kersting
r-deve| @end|ng |rom @ker@t|ng@de
Wed May 22 11:18:46 CEST 2019
Hi,
Is there currently any way to guarantee that on.exit does not fail to execute the recorded expression because of a user interrupt arriving during function exit? Consider:
f <- function() {
suspendInterrupts({
on.exit(suspendInterrupts(cntr_on.exit <<- cntr_on.exit + 1L))
cntr_f <<- cntr_f + 1L
})
TRUE
}
It is possible to interrupt this function such that cntr_f is incremented while cntr_on.exit is not (you might need to adjust timeout_upper to trigger the error on your machine):
timeout_upper <- 0.00001
repeat {
cntr_f <- 0L
cntr_on.exit <- 0L
# timeout code borrowed from R.utils::withTimeout but with setTimeLimit()
# (correctly) place inside tryCatch (otherwise timeout can occur before it can
# be caught) and with time limit reset before going into the error handler
res_list <- lapply(seq(0, timeout_upper, length.out = 1000), function(timeout) {
on.exit({
setTimeLimit(cpu = Inf, elapsed = Inf, transient = FALSE)
})
tryCatch({
setTimeLimit(cpu = timeout, elapsed = timeout, transient = TRUE)
res <- f()
# avoid timeout while running error handler
setTimeLimit(cpu = Inf, elapsed = Inf, transient = FALSE)
res
}, error = function(ex) {
msg <- ex$message
pattern <- gettext("reached elapsed time limit", "reached CPU time limit",
domain = "R")
pattern <- paste(pattern, collapse = "|")
if (regexpr(pattern, msg) != -1L) {
FALSE
}
else {
stop(ex)
}
})
})
print(sum(unlist(res_list))) # number of times f completed
stopifnot(cntr_on.exit == cntr_f)
}
Example output:
1] 1000
[1] 1000
[1] 1000
[1] 1000
[1] 999
[1] 1000
[1] 1000
[1] 999
[1] 998
[1] 1000
[1] 998
[1] 1000
[1] 1000
[1] 1000
[1] 1000
[1] 999
Error: cntr_on.exit == cntr_f is not TRUE
I was bitten by this because an on.exit expression, which releases a file lock, was interrupted (before it actually executed) such that subsequent calls block indefinitely.
Regards,
Andreas
More information about the R-devel
mailing list