Last active
May 6, 2016 01:17
-
-
Save HenrikBengtsson/9110f753ebd3b765d2c0759944c7b609 to your computer and use it in GitHub Desktop.
Recording last stop() condition in .Last.error
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## 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 file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
## 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