Capture the first graded() signal or error thrown when evaluating the
expr.
Arguments
- expr
The expression or code block to evaluate
- on_error
A
withCallingHandlers()handler for classerrorwith signaturefunction(error, this_env)that receives the error object and calling environment of the error handler.on_errorshould userlang::return_from()usingthis_envto immediately return the value and not continue evaluation.- on_graded
A
withCallingHandlers()handler for classgradedwith signaturefunction(grade, this_env)that receives the error object and calling environment of the error handler.on_gradedshould userlang::return_from()usingthis_envto immediately return the value and not continue evaluation.
Examples
# Passes with "message 1", short-circuiting evaluation
eval_gradethis({
pass("message 1")
pass("message 2")
pass("message 3")
})
#> <gradethis_graded: [Correct] message 1>
# Fails with message from fail()
eval_gradethis({
fail("incorrect")
pass("correct")
})
#> <gradethis_graded: [Incorrect] incorrect>
# Fails with message from expect_true()
eval_gradethis({
testthat::expect_true(FALSE)
pass("message 2")
pass("message 3")
})
#> Error in (function (e) { on_error(e, this_env)})(structure(list(message = "FALSE is not TRUE\n\n`actual`: \033[32mFALSE\033[39m\n`expected`: \033[32mTRUE\033[39m ", srcref = NULL, trace = structure(list(call = list(pkgdown::build_site(new_process = FALSE), build_site_local(pkg = pkg, examples = examples, run_dont_run = run_dont_run, seed = seed, lazy = lazy, override = override, preview = preview, devel = devel), build_reference(pkg, lazy = lazy, examples = examples, run_dont_run = run_dont_run, seed = seed, override = override, preview = FALSE, devel = devel), purrr::map(topics, build_reference_topic, pkg = pkg, lazy = lazy, examples_env = examples_env, run_dont_run = run_dont_run), .f(.x[[i]], ...), withCallingHandlers(data_reference_topic(topic, pkg, examples_env = examples_env, run_dont_run = run_dont_run), error = function(err) { msg <- c(paste0("Failed to parse Rd in ", topic$file_in), i = err$message) abort(msg, parent = err) }), data_reference_topic(topic, pkg, examples_env = examples_env, run_dont_run = run_dont_run), run_examples(tags$tag_examples[[1]], env = if (is.null(examples_env)) NULL else new.env(parent = examples_env), topic = tools::file_path_sans_ext(topic$file_in), run_dont_run = run_dont_run), highlight_examples(code, topic, env = env), downlit::evaluate_and_highlight(code, fig_save = fig_save_topic, env = child_env(env), output_handler = evaluate::new_output_handler(value = pkgdown_print)), evaluate::evaluate(code, child_env(env), new_device = TRUE, output_handler = output_handler), evaluate_call(expr, parsed$src[[i]], envir = envir, enclos = enclos, debug = debug, last = i == length(out), use_try = stop_on_error != 2L, keep_warning = keep_warning, keep_message = keep_message, output_handler = output_handler, include_timing = include_timing), timing_fn(handle(ev <- withCallingHandlers(withVisible(eval_with_user_handlers(expr, envir, enclos, user_handlers)), warning = wHandler, error = eHandler, message = mHandler))), handle(ev <- withCallingHandlers(withVisible(eval_with_user_handlers(expr, envir, enclos, user_handlers)), warning = wHandler, error = eHandler, message = mHandler)), try(f, silent = TRUE), tryCatch(expr, error = function(e) { call <- conditionCall(e) if (!is.null(call)) { if (identical(call[[1L]], quote(doTryCatch))) call <- sys.call(-4L) dcall <- deparse(call, nlines = 1L) prefix <- paste("Error in", dcall, ": ") LONG <- 75L sm <- strsplit(conditionMessage(e), "\n")[[1L]] w <- 14L + nchar(dcall, type = "w") + nchar(sm[1L], type = "w") if (is.na(w)) w <- 14L + nchar(dcall, type = "b") + nchar(sm[1L], type = "b") if (w > LONG) prefix <- paste0(prefix, "\n ") } else prefix <- "Error : " msg <- paste0(prefix, conditionMessage(e), "\n") .Internal(seterrmessage(msg[1L])) if (!silent && isTRUE(getOption("show.error.messages"))) { cat(msg, file = outFile) .Internal(printDeferredWarnings()) } invisible(structure(msg, class = "try-error", condition = e)) }), tryCatchList(expr, classes, parentenv, handlers), tryCatchOne(expr, names, parentenv, handlers[[1L]]), doTryCatch(return(expr), name, parentenv, handler), withCallingHandlers(withVisible(eval_with_user_handlers(expr, envir, enclos, user_handlers)), warning = wHandler, error = eHandler, message = mHandler), withVisible(eval_with_user_handlers(expr, envir, enclos, user_handlers)), eval_with_user_handlers(expr, envir, enclos, user_handlers), eval(expr, envir, enclos), eval(expr, envir, enclos), eval_gradethis({ testthat::expect_true(FALSE) pass("message 2") pass("message 3") }), capture_graded(on_graded = on_graded, capture_errors(on_error = on_error, expr)), withCallingHandlers(gradethis_graded = function(grade) { on_graded(grade, this_env) }, expr), capture_errors(on_error = on_error, expr), withCallingHandlers(error = function(e) { on_error(e, this_env) }, expr), testthat::expect_true(FALSE)), parent = c(0L, 1L, 2L, 3L, 4L, 5L, 5L, 7L, 8L, 9L, 10L, 11L, 12L, 12L, 14L, 15L, 16L, 17L, 18L, 12L, 12L, 12L, 22L, 23L, 24L, 25L, 26L, 25L, 28L, 24L), visible = c(TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE, TRUE), namespace = c("pkgdown", "pkgdown", "pkgdown", "purrr", "pkgdown", "base", "pkgdown", "pkgdown", "pkgdown", "downlit", "evaluate", "evaluate", "evaluate", "evaluate", "base", "base", "base", "base", "base", "base", "base", "evaluate", "base", "base", "gradethis", "gradethis", "base", "gradethis", "base", "testthat"), scope = c("::", ":::", "::", "::", "local", "::", ":::", ":::", ":::", "::", "::", ":::", "local", "local", "::", "::", "local", "local", "local", "::", "::", ":::", "::", "::", "::", ":::", "::", ":::", "::", "::")), row.names = c(NA, -30L), version = 2L, class = c("rlang_trace", "rlib_trace", "tbl", "data.frame"))), class = c("expectation_failure", "expectation", "error", "condition"))): FALSE is not TRUE
#>
#> `actual`: FALSE
#> `expected`: TRUE
#> <gradethis_graded: [Neutral]
#> A problem occurred with the grading code for this exercise.
#> >
# Fails immediately with message "boom"
eval_gradethis({
stop("boom")
pass("message 2")
pass("message 3")
})
#> Error in stop("boom"): boom
#> <gradethis_graded: [Neutral]
#> A problem occurred with the grading code for this exercise.
#> >