Skip to content

Instantly share code, notes, and snippets.

@HenrikBengtsson
Last active May 6, 2016 01:17
Show Gist options
  • Save HenrikBengtsson/9110f753ebd3b765d2c0759944c7b609 to your computer and use it in GitHub Desktop.
Save HenrikBengtsson/9110f753ebd3b765d2c0759944c7b609 to your computer and use it in GitHub Desktop.
Recording last stop() condition in .Last.error
## Requires options(error=recordStop)
## stop() at the prompt
stop("Hello")
## Error: Hello
print(.Last.error)
## <simpleError in stop("Hello"): Hello>
str(.Last.error)
# List of 3
# $ message: chr "woops"
# $ call : NULL
# $ value : num 2
# - attr(*, "class")= chr [1:4] "MyError" "simpleError" "error" "condition"
## stop() in a function
foo <- function() stop("woops")
ex <- tryCatch(foo(), error = function(ex) ex)
print(ex)
## <simpleError in foo(): woops>
foo()
## Error in foo() : woops
print(.Last.error)
## <simpleError in foo(): woops>
## Assert identical results
stopifnot(all.equal(.Last.error, ex))
## stop() in a nested call
bar <- function() foo()
ex <- tryCatch(bar(), error = function(ex) ex)
# <simpleError in foo(): woops>
bar()
# Error in foo() : woops
print(.Last.error)
# <simpleError in bar(): woops>
## Assert identical results
stopifnot(all.equal(.Last.error, ex))
## A custom error class
MyError <- function(..., value=0) {
ex <- simpleError(...)
ex$value <- value
class(ex) <- c("MyError", class(ex))
ex
}
## stop() from prompt
err <- MyError("woops", value=1L)
ex <- tryCatch(stop(err), error = function(ex) ex)
print(ex)
# <MyError: woops>
stop(err)
## Error: woops
print(.Last.error)
# <MyError: woops>
## Assert identical results
stopifnot(all.equal(.Last.error, ex))
## stop() in a function
yo <- function(value=1) stop(MyError("woops", value=value))
ex <- tryCatch(yo(), error = function(ex) ex)
print(ex)
# <MyError: woops>
yo()
# Error: woops
print(.Last.error)
# <MyError: woops>
## Assert identical results
stopifnot(all.equal(.Last.error, ex))
## stop() in a nested call
yeah <- function(value=2) yo(value=value)
ex <- tryCatch(yeah(), error = function(ex) ex)
print(ex)
# <MyError: woops>
yeah()
# Error: woops
print(.Last.error)
# <MyError: woops>
stopifnot(all.equal(.Last.error, ex))
str(.Last.error)
# List of 3
# $ message: chr "woops"
# $ call : NULL
# $ value : num 2
# - attr(*, "class")= chr [1:4] "MyError" "simpleError" "error" "condition"
## This can be placed in .Rprofile
local({
recordStop <- function(...) {
## Find the stop() frame
frames <- sys.frames()
args <- names(formals(base::stop))
isStop <- lapply(frames, FUN=function(f) all(args %in% names(f)))
idx <- which(unlist(isStop))[1]
frame <- frames[[idx]]
## Was stop() called with a condition or a message?
vars <- names(frame)
if ("cond" %in% vars) {
.Last.error <- frame$cond
} else {
msg <- eval(quote(.makeMessage(..., domain=domain)), envir=frame)
assign("calls", sys.calls(), envir=.GlobalEnv)
call <- if (frame$call.) rev(sys.calls())[[3]] else NULL
.Last.error <- simpleError(msg, call=call)
}
assign(".Last.error", .Last.error, envir=.GlobalEnv)
} ## recordStop()
options(error=recordStop)
})
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment