diff --git a/R/eval.R b/R/eval.R index 734b2ad..e557a14 100644 --- a/R/eval.R +++ b/R/eval.R @@ -208,10 +208,12 @@ evaluate_top_level_expression <- function(exprs, } } - ev <- list(value = NULL, visible = FALSE) - if (use_try) { - handle <- function(f) try(f, silent = TRUE) + handle <- function(code) { + tryCatch(code, error = function(err) { + list(value = NULL, visible = FALSE) + }) + } } else { handle <- force } @@ -222,26 +224,37 @@ evaluate_top_level_expression <- function(exprs, } user_handlers <- output_handler$calling_handlers + evaluate_handlers <- list(error = eHandler, warning = wHandler, message = mHandler) + # The user's condition handlers have priority over ours + handlers <- c(user_handlers, evaluate_handlers) for (expr in exprs) { srcindex <- length(output) - time <- timing_fn(handle( - ev <- withCallingHandlers( - withVisible(eval_with_user_handlers(expr, envir, user_handlers)), - warning = wHandler, - error = eHandler, - message = mHandler + time <- timing_fn( + ev <- handle( + with_handlers( + withVisible(eval(expr, envir)), + handlers + ) ) - )) + ) handle_output(TRUE) if (!is.null(time)) attr(output[[srcindex]]$src, 'timing') <- time if (show_value(output_handler, ev$visible)) { - pv <- list(value = NULL, visible = FALSE) - handle(pv <- withCallingHandlers(withVisible( - handle_value(output_handler, ev$value, ev$visible) - ), warning = wHandler, error = eHandler, message = mHandler)) + # Ideally we'd evaluate the print() generic in envir in order to find + # any methods registered in that environment. That, however, is + # challenging and only makes a few tests a little simpler so we don't + # bother. + pv <- handle( + with_handlers( + withVisible( + handle_value(output_handler, ev$value, ev$visible) + ), + handlers + ) + ) handle_output(TRUE) # If the return value is visible, save the value to the output if (pv$visible) output <- c(output, list(pv$value)) @@ -255,21 +268,12 @@ evaluate_top_level_expression <- function(exprs, output } -eval_with_user_handlers <- function(expr, envir, calling_handlers) { - if (!length(calling_handlers)) { - return(eval(expr, envir)) +with_handlers <- function(code, handlers) { + if (!is.list(handlers)) { + stop("`handlers` must be a list", call. = FALSE) } - if (!is.list(calling_handlers)) { - stop("`calling_handlers` must be a list", call. = FALSE) - } - - call <- as.call(c( - quote(withCallingHandlers), - quote(eval(expr, envir)), - calling_handlers - )) - + call <- as.call(c(quote(withCallingHandlers), quote(code), handlers)) eval(call) }