Сохранить трассировку при ошибке с помощью tryCatch

Question

При вызове функции R внутри моего webapp я хотел бы поймать трассировку стека при возникновении ошибки и представить ее пользователю для целей отладки. Что-то вроде вывода traceback() в интерактивном сеансе. Однако, кажется, не работает, когда она вызывается внутри обработчика ошибок traceback, он возвращает No traceback available:

f <- function() { 
    g <- function() stop("test traceback") 
    g() 
} 

errhandler <- function(e){ 
    stacktrace <- traceback() 
    unlist(stacktrace); 
} 

out <- tryCatch(f(), error=errhandler) 

Есть ли способ, что я могу программно поймать трассировку стека ошибки? То есть получить вывод, который я хотел бы получить при вызове traceback() вручную после ошибки:

f() 
traceback() 

Answer 1

Оказалось, что последняя версия пакета evaluate имеет функцию try_capture_stack, которая является довольно good implementation.

Answer 2

Функция tools:::.try_quietly делает что-то подобное:

f <- function() { 
    g <- function() stop("test traceback") 
    g() 
} 

tools:::.try_quietly(f()) 

Error: test traceback 
Call sequence: 
3: stop("test traceback") 
2: g() 
1: f() 

Однако, ошибки и предупреждения, выводимой outConn с помощью sink() - это означает, что вы не можете напрямую назначать результаты объекту. Чтобы обойти это, вам, возможно, придется изменить код для использования print() вместо sink (untested).

Answer 3

Я не получил стек, как с traceback с try_capture_stack, поэтому я написал решение, которое работает как try, за исключением того, что он также возвращает стек вызовов. tools:::.try_quietly аккуратно, но не сохраняет стеку для последующей проверки ...

tryStack <- function(
expr, 
silent=FALSE 
) 
{ 
tryenv <- new.env() 
out <- try(withCallingHandlers(expr, error=function(e) 
    { 
    stack <- sys.calls() 
    stack <- stack[-(2:7)] 
    stack <- head(stack, -2) 
    stack <- sapply(stack, deparse) 
    if(!silent && isTRUE(getOption("show.error.messages"))) 
    cat("This is the error stack: ", stack, sep="\n") 
    assign("stackmsg", value=paste(stack,collapse="\n"), envir=tryenv) 
    }), silent=silent) 
if(inherits(out, "try-error")) out[2] <- tryenv$stackmsg 
out 
} 

lower <- function(a) a+10 
upper <- function(b) {plot(b, main=b) ; lower(b) } 

d <- tryStack(upper(4)) 
d <- tryStack(upper("4")) 
cat(d[2]) 

Больше информации в моем ответе здесь: https://stackoverflow.com/a/40899766/1587132