From |uke-t|erney @end|ng |rom u|ow@@edu  Wed May 22 16:28:55 2019
From: |uke-t|erney @end|ng |rom u|ow@@edu (Tierney, Luke)
Date: Wed, 22 May 2019 14:28:55 +0000
Subject: [Rd] [External]  make running on.exit expr uninterruptible
In-Reply-To: <E1hTNOY-00039f-Br@rmmprod07.runbox>
References: <E1hTNOY-00039f-Br@rmmprod07.runbox>
Message-ID: <alpine.LFD.2.21.1905220916430.3300@itasca.stat.uiowa.edu>

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



[Rd] [External] make running on.exit expr uninterruptible
Tierney, Luke