r - 函数可以通过tryCatch和好友粉碎吗？

Question

我知道如何引发错误:

check_negative <- function(x) {
  if (x > 0) {
    stop("No way can x be positive.")
  }
  x
}

check_negative(5)
#> Error in check_negative(5) : No way can x be positive.

由于tryCatch的目的是处理此类错误，但是tryCatch并非严格保留，因此我想知道是否存在一种方法，即使将check_negative(5)包裹在tryCatch中，也始终会引发错误。

我的第一种方法工作得相当好，但是需要至少运行一次，并且在退出时不修复tryCatch。我尝试将tryCatch'repair'放置在on.exit中的错误之前，但这导致未引发错误。

(自然，以下函数会对您的R session 造成一些损害，因此请谨慎运行，不要在要保留的 session 中运行。)

check_negative <- function(x) {
  unlockBinding("tryCatch", baseenv())
  assign("tryCatch", 
         local({
           function(expr, ..., finally) {
             expr
           }
         }), 
         pos = baseenv())

  if (x > 0) {
    stop("No way can x be positive.")
  }
  # Attempt to repair tryCatch
  unlockBinding("tryCatch", baseenv())
  assign("tryCatch", 
         function (expr, ..., finally) 
         {
           tryCatchList <- function(expr, names, parentenv, handlers) {
             nh <- length(names)
             if (nh > 1L) 
               tryCatchOne(tryCatchList(expr, names[-nh], parentenv, 
                                        handlers[-nh]), names[nh], parentenv, handlers[[nh]])
             else if (nh == 1L) 
               tryCatchOne(expr, names, parentenv, handlers[[1L]])
             else expr
           }
           tryCatchOne <- function(expr, name, parentenv, handler) {
             doTryCatch <- function(expr, name, parentenv, handler) {
               .Internal(.addCondHands(name, list(handler), parentenv, 
                                       environment(), FALSE))
               expr
             }
             value <- doTryCatch(return(expr), name, parentenv, handler)
             if (is.null(value[[1L]])) {
               msg <- .Internal(geterrmessage())
               call <- value[[2L]]
               cond <- simpleError(msg, call)
             }
             else cond <- value[[1L]]
             value[[3L]](cond)
           }
           if (!missing(finally)) 
             on.exit(finally)
           handlers <- list(...)
           classes <- names(handlers)
           parentenv <- parent.frame()
           if (length(classes) != length(handlers)) 
             stop("bad handler specification")
           tryCatchList(expr, classes, parentenv, handlers)
         }, 
         pos = baseenv())
}

tryCatch(check_negative(5), error = function(e) NULL)
#> NULL
tryCatch(check_negative(5), error = function(e) NULL)
#> Error in check_negative(5) : No way can x be positive.

这个问题的主要动机是好奇心。我不打算这样做。但是我确实想知道这样的事情是否可能，或者是否有可能编写一个功能，使一个不怀疑但确定的用户无法避免错误。

Answer 1

您可以异步调用stop。这需要later包。

check_negative <- function(x) {
  if (x > 0) {
    later::later(function(...) stop('No way can x be positive.'))
    stop("No way can x be positive.")
  }
  x
}
tryCatch(check_negative(5), error = function(e) NULL)
#> NULL
#> Error in tryCatch(evalq(sys.calls(), <environment>), error = function (x)  : 
#>   Evaluation error: No way can x be positive..