1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
|
#' Back trace the expressions evaluated when an error was caught
#'
#' @param future A future with a caught error.
#'
#' @param envir the environment where to locate the future.
#'
#' @param \dots Not used.
#'
#' @return A @list with the future's call stack that led up to the error.
#'
#' @example incl/backtrace.R
#'
#' @export
backtrace <- function(future, envir = parent.frame(), ...) {
## Argument 'expr':
expr <- substitute(future)
if (!is.null(expr)) {
future <- tryCatch({
target <- parse_env_subset(expr, envir = envir, substitute = FALSE)
get_future(target, mustExist = TRUE)
}, simpleError = function(ex) {
eval(expr, envir = envir, enclos = baseenv())
})
stop_if_not(inherits(future, "Future"))
}
if (!resolved(future)) {
stop("No error has been caught because the future is unresolved: ", sQuote(expr))
}
result <- result(future)
conditions <- result$conditions
## BACKWARD COMPATIBILITY: future (< 1.11.0)
if (!is.list(conditions)) conditions <- list(list(condition = result$condition))
## Find 'error' condition
error <- NULL
for (kk in seq_along(conditions)) {
c <- conditions[[kk]]
if (inherits(c$condition, "error")) {
error <- c
break
}
}
if (is.null(error)) {
stop("No error was caught for this future: ", sQuote(expr))
}
calls <- error$calls
## BACKWARD COMPATIBILITY: future (< 1.11.0)
if (is.null(calls)) calls <- result$calls
if (is.null(calls)) {
stop("The error call stack was not recorded for this future: ", sQuote(expr))
}
## Recreate the full call stack
calls <- c(future$calls, calls)
calls
} ## backtrace()
|
