R devel - May 2019 - make running on.exit expr uninterruptible

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

suspendInterrupts has dynamic extent, so you need to make sure it
covers the entire computation. Defining your f like this is one option:

f <- function() {
     ff <- function() {
         on.exit(cntr_on.exit <<- cntr_on.exit + 1L)
         cntr_f <<- cntr_f + 1L
         ## allowInterrupts(... interruptable stuff ...)
         TRUE
     }
     suspendInterrupts(ff())
}

You can move the suspendInterrupts higher up in the computation, but
then it becomes more important to use allowInterrupts at appropriate
points.

It would be possible to have R suspend interrupts around function
calling infrastructure to provide stronger guarantees about
non-interruptable on.exit/finally actions, but there are both upsides
and downsides to doing that.

Best,

luke


On Wed, 22 May 2019, Andreas Kersting wrote:
> 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
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>
-- 
Luke Tierney
Ralph E. Wareham Professor of Mathematical Sciences
University of Iowa                  Phone:             319-335-3386
Department of Statistics and        Fax:               319-335-3017
    Actuarial Science
241 Schaeffer Hall                  email:   luke-tierney at uiowa.edu
Iowa City, IA 52242                 WWW:  http://www.stat.uiowa.edu