Skip to content

Capture the first graded() signal or error thrown when evaluating the expr.

Usage

eval_gradethis(expr, on_error = NULL, on_graded = NULL)

Arguments

expr

The expression or code block to evaluate

on_error

A withCallingHandlers() handler for class error with signature function(error, this_env) that receives the error object and calling environment of the error handler. on_error should use rlang::return_from() using this_env to immediately return the value and not continue evaluation.

on_graded

A withCallingHandlers() handler for class graded with signature function(grade, this_env) that receives the error object and calling environment of the error handler. on_graded should use rlang::return_from() using this_env to 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.
#> >