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 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199
|
#' Evaluate input and return all details of evaluation
#'
#' Compare to [eval()], `evaluate` captures all of the
#' information necessary to recreate the output as if you had copied and pasted
#' the code into a R terminal. It captures messages, warnings, errors and
#' output, all correctly interleaved in the order in which they occured. It
#' stores the final result, whether or not it should be visible, and the
#' contents of the current graphics device.
#'
#' @export
#' @param input input object to be parsed and evaluated. May be a string, file
#' connection or function. Passed on to [parse_all()].
#' @param envir environment in which to evaluate expressions.
#' @param enclos when `envir` is a list or data frame, this is treated as
#' the parent environment to `envir`.
#' @param debug if `TRUE`, displays information useful for debugging,
#' including all output that evaluate captures.
#' @param stop_on_error A number between 0 and 2 that controls what happens
#' when the code errors:
#'
#' * If `0`, the default, will continue running all code, just as if you'd
#' pasted the code into the command line.
#' * If `1`, evaluation will stop on first error without signaling the error,
#' and you will get back all results up to that point.
#' * If `2`, evaluation will halt on first error and you will get back no
#' results.
#' @param keep_warning,keep_message A single logical value that controls what
#' happens to warnings and messages.
#'
#' * If `TRUE`, the default, warnings and messages will be captured in the
#' output.
#' * If `NA`, warnings and messages will not be captured and bubble up to
#' the calling environment of `evaluate()`.
#' * If `FALSE`, warnings and messages will be completed supressed and
#' not shown anywhere.
#'
#' Note that setting the envvar `R_EVALUATE_BYPASS_MESSAGES` to `true` will
#' force these arguments to be set to `NA`.
#' @param log_echo,log_warning If `TRUE`, will immediately log code and
#' warnings (respectively) to `stderr`.
#'
#' This will be force to `TRUE` if env var `ACTIONS_STEP_DEBUG` is
#' `true`, as when debugging a failing GitHub Actions workflow.
#' @param new_device if `TRUE`, will open a new graphics device and
#' automatically close it after completion. This prevents evaluation from
#' interfering with your existing graphics environment.
#' @param output_handler an instance of [output_handler()] that
#' processes the output from the evaluation. The default simply prints the
#' visible return values.
#' @param filename string overrriding the [base::srcfile()] filename.
#' @param include_timing Deprecated.
#' @import graphics grDevices utils
#' @examples
#' evaluate(c(
#' "1 + 1",
#' "2 + 2"
#' ))
#'
#' # Not that's there's a difference in output between putting multiple
#' # expressions on one line vs spreading them across multiple lines
#' evaluate("1;2;3")
#' evaluate(c("1", "2", "3"))
#'
#' # This also affects how errors propagate, matching the behaviour
#' # of the R console
#' evaluate("1;stop(2);3")
#' evaluate(c("1", "stop(2)", "3"))
evaluate <- function(
input,
envir = parent.frame(),
enclos = NULL,
debug = FALSE,
stop_on_error = 0L,
keep_warning = TRUE,
keep_message = TRUE,
log_echo = FALSE,
log_warning = FALSE,
new_device = TRUE,
output_handler = NULL,
filename = NULL,
include_timing = FALSE
) {
on_error <- check_stop_on_error(stop_on_error)
# if this env var is set to true, always bypass messages
if (env_var_is_true("R_EVALUATE_BYPASS_MESSAGES")) {
keep_message <- NA
keep_warning <- NA
}
if (env_var_is_true("ACTIONS_STEP_DEBUG")) {
log_warning <- TRUE
log_echo <- TRUE
}
on_message <- check_keep(keep_message, "keep_message")
on_warning <- check_keep(keep_warning, "keep_warning", log_warning)
output_handler <- output_handler %||% evaluate_default_output_handler
if (isTRUE(include_timing)) {
warning("`evaluate(include_timing)` is deprecated")
}
# Capture output
watcher <- watchout(output_handler, new_device = new_device, debug = debug)
if (on_error != "error" && !can_parse(input)) {
err <- tryCatch(parse(text = input), error = function(cnd) cnd)
watcher$push_source(input, expression())
watcher$push(err)
return(watcher$get())
}
parsed <- parse_all(input, filename = filename)
# "Transpose" parsed so we get a list that's easier to iterate over
tles <- Map(
function(src, exprs) list(src = src, exprs = exprs),
parsed$src,
parsed$expr
)
if (is.list(envir)) {
envir <- list2env(envir, parent = enclos %||% parent.frame())
}
local_inject_funs(envir)
if (is.null(getOption("rlang_trace_top_env"))) {
# If not already set, indicate the top environment to trim traceback
options(rlang_trace_top_env = envir)
}
# Handlers for warnings, errors and messages
user_handlers <- output_handler$calling_handlers
evaluate_handlers <- condition_handlers(
watcher,
on_error = on_error,
on_warning = on_warning,
on_message = on_message
)
# The user's condition handlers have priority over ours
handlers <- c(user_handlers, evaluate_handlers)
for (tle in tles) {
watcher$push_source(tle$src, tle$exprs)
if (debug || log_echo) {
cat_line(tle$src, file = stderr())
}
continue <- withRestarts(
with_handlers(
{
for (expr in tle$exprs) {
ev <- withVisible(eval(expr, envir))
watcher$capture_plot_and_output()
watcher$print_value(ev$value, ev$visible, envir)
}
TRUE
},
handlers
),
eval_continue = function() TRUE,
eval_stop = function() FALSE
)
watcher$check_devices()
if (!continue) {
break
}
}
# Always capture last plot, even if incomplete
watcher$capture_plot(TRUE)
watcher$get()
}
check_stop_on_error <- function(x) {
if (is.numeric(x) && length(x) == 1 && !is.na(x)) {
if (x == 0L) {
return("continue")
} else if (x == 1L) {
return("stop")
} else if (x == 2L) {
return("error")
}
}
stop("`stop_on_error` must be 0, 1, or 2.", call. = FALSE)
}
check_keep <- function(x, arg, log = FALSE) {
if (!is.logical(x) || length(x) != 1) {
stop("`", arg, "` must be TRUE, FALSE, or NA.", call. = FALSE)
}
list(
capture = isTRUE(x),
silence = !is.na(x) && !log
)
}
|