Hand off parse error to error checker if one is available (#596)

* Hand off parse error to error checker if one is available * `evaluate_exercise()` finds global exercise error checking * Add tests * exercise$error_check might be null in testing scenarios * Errors in global setup code evaluation are now thrown as internal errors also duplicated in log messages * Better comments * Add internal exercise result error helper and don't grade setup errors - Internal error helper emits log messages via `message()` and an error exercise result with specificl language - `render_exercise()` catches setup and user code errors but returns an internal error if the error comes from the setup chunk(s) - The error condition of internal errors is returned under `$feedback$error` - Pass the original user code error to the error checker, rather than the wrapped error we use to signal the issue * A couple more code headings * Internal errors throw warnings instead of messages * Add news for #596 * Tweak NEWS.md * v0.10.1.9016
rstudio · Oct 7, 2021 · b000739 · b000739
1 parent 3257461
commit b000739
Show file tree

Hide file tree

Showing 6 changed files with 243 additions and 56 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,7 +1,7 @@
 Type: Package
 Package: learnr
 Title: Interactive Tutorials for R
-Version: 0.10.1.9015
+Version: 0.10.1.9016
 Authors@R:
     c(person(given = "Garrick",
              family = "Aden-Buie",

diff --git a/NEWS.md b/NEWS.md
@@ -53,6 +53,7 @@ learnr (development version)
 * `options()` and environment variables are now reset after rendering exercises so changes made by user input or checking code cannot affect other exercises. ([#542](https://github.com/rstudio/learnr/pull/542))
 * Exercise checking is now conducted in the same temporary directory where exercises are evaluated. ([#544](https://github.com/rstudio/learnr/pull/544/))
 * User submissions for R code exercises are now checked for parsing errors prior to any other checks. If the submitted code is unparsable, a friendly error feedback message is returned and no further evaluation or checking is performed. ([#547](https://github.com/rstudio/learnr/pull/547))
+* Parse errors from user code that fails to parse can now be inspected by the error checker, but errors in exercise setup chunks cannot. Instead, global setup and setup chunk errors are raised as internal errors with a user-facing warning. In general, internal errors are now handled more consistently. ([#596](https://github.com/rstudio/learnr/pull/596))
 
 ## Bug fixes
 

diff --git a/R/evaluators.R b/R/evaluators.R
@@ -313,12 +313,11 @@ internal_external_evaluator <- function(
           )
           do.call(exercise_result, result)
         }, error = function(e) {
-          warning(
-            "Unable to convert exercise result from external evaluator ",
-            "into a learnr exercise result.",
-            e$message
+          exercise_result_error_internal(
+            exercise = exercise,
+            error = e,
+            task_internal = "converting result from external evaluator into a learnr exercise result"
           )
-          exercise_result_error("An internal error occurred, please try again or contact the tutorial author.")
         })
       }
     )

diff --git a/R/exercise.R b/R/exercise.R
@@ -90,9 +90,6 @@ setup_exercise_handler <- function(exercise_rx, session) {
       exercise$check <- NULL
       exercise$code_check <- NULL
       exercise$error_check <- NULL
-    } else {
-      # If there is no locally defined error check code, look for globally defined error check option
-      exercise$error_check <- exercise$error_check %||% exercise$options$exercise.error.check.code
     }
 
     # get timelimit option (either from chunk option or from global option)
@@ -321,6 +318,8 @@ standardize_exercise_code <- function(exercise) {
 evaluate_exercise <- function(
   exercise, envir, evaluate_global_setup = FALSE, data_dir = NULL
 ) {
+
+  # Exercise Prep and Standardization ---------------------------------------
   # Protect global options and environment vars from permanent modification
   local_restore_options_and_envvars()
 
@@ -332,6 +331,7 @@ evaluate_exercise <- function(
 
   # standardize exercise code to single string (code, *check, global_setup)
   exercise <- standardize_exercise_code(exercise)
+  exercise$envir <- envir
 
   i18n_set_language_option(exercise$tutorial$language)
 
@@ -341,8 +341,24 @@ evaluate_exercise <- function(
     return(exercise_result(html_output = " "))
   }
 
+  # Evaluate Global Setup ---------------------------------------------------
   if (evaluate_global_setup) {
-    eval(parse(text = exercise$global_setup), envir = envir)
+    res_global <-
+      tryCatch({
+        eval(parse(text = exercise$global_setup), envir = envir)
+        NULL
+      }, error = function(err) {
+        exercise_result_error_internal(
+          exercise,
+          err,
+          task_internal = "evaluating the global setup",
+          task_external = "setting up the tutorial"
+        )
+      })
+
+    if (is_exercise_result(res_global)) {
+      return(res_global)
+    }
   }
 
   # Check if user code has unfilled blanks ----------------------------------
@@ -403,17 +419,22 @@ evaluate_exercise <- function(
     render_exercise(exercise, envir),
     error = function(err_render) {
       error_feedback <- NULL
-      if (nzchar(exercise$error_check)) {
+      error_check_code <- exercise$error_check
+      if (!nzchar(error_check_code)) {
+        # If there is no locally defined error check code, look for globally defined error check option
+        error_check_code <- standardize_code(exercise$options$exercise.error.check.code)
+      }
+      if (nzchar(error_check_code)) {
         # Error check -------------------------------------------------------
         # Check the error thrown by the submitted code when there's error
         # checking: the exercise could be to throw an error!
         error_feedback <- try_checker(
           exercise,
-          check_code = exercise$error_check,
+          check_code = error_check_code,
           envir_result = err_render$envir_result,
           evaluate_result = err_render$evaluate_result,
           envir_prep = err_render$envir_prep,
-          last_value = err_render
+          last_value = err_render$last_value
         )
       }
       exercise_result_error(err_render$error_message, error_feedback$feedback)
@@ -604,6 +625,7 @@ render_exercise <- function(exercise, envir) {
 
   # First, Rmd to markdown (and exit early if any error)
   output_file <- tryCatch({
+    render_stage <- "setup"
     local({
       if (length(rmd_src_prep) > 0) {
         rmd_file_prep <- "exercise_prep.Rmd"
@@ -640,6 +662,7 @@ render_exercise <- function(exercise, envir) {
     # are much more difficult
     envir_result <- duplicate_env(envir_prep)
 
+    render_stage <- "user"
     with_masked_env_vars(
       # Now render user code for final result
       rmarkdown::render(
@@ -658,6 +681,19 @@ render_exercise <- function(exercise, envir) {
     if (grepl(pattern, msg, fixed = TRUE)) {
       return(exercise_result_timeout())
     }
+
+    if (render_stage == "setup") {
+      # errors in setup code should be returned as internal error results
+      return(
+        exercise_result_error_internal(
+          exercise = exercise,
+          error = e,
+          task_external = "setting up the exercise",
+          task_internal = "rendering exercise setup"
+        )
+      )
+    }
+
     rlang::abort(
       class = "learnr_render_exercise_error",
       envir_result = envir_result,
@@ -669,7 +705,7 @@ render_exercise <- function(exercise, envir) {
   })
 
   if (is_exercise_result(output_file)) {
-    # this only happens when the render result is a timeout error
+    # this only happens when the render result is a timeout error or setup error
     return(output_file)
   }
 
@@ -845,6 +881,29 @@ exercise_check_code_is_parsable <- function(exercise) {
     return(NULL)
   }
 
+  # apply the error checker (if explicitly provided) to the parse error
+  if (nzchar(exercise$error_check %||% "")) {
+    error_feedback <- try_checker(
+      exercise,
+      check_code = exercise[["error_check"]],
+      envir_result = exercise[["envir"]],
+      evaluate_result = error,
+      envir_prep = exercise[["envir"]],
+      last_value = error
+    )
+
+    if (is_exercise_result(error_feedback)) {
+      # we have feedback from the error checker so we return the original parse
+      # error with the feedback from the error checker
+      return(
+        exercise_result_error(
+          conditionMessage(error),
+          error_feedback[["feedback"]]
+        )
+      )
+    }
+  }
+
   exercise_result(
     list(
       message = HTML(
@@ -881,6 +940,36 @@ exercise_result_error <- function(error_message, feedback = NULL, timeout_exceed
   )
 }
 
+exercise_result_error_internal <- function(
+  exercise,
+  error,
+  task_external = "",
+  task_internal = task_external
+) {
+  task_external <- paste0(if (nzchar(task_external %||% "")) " while ", task_external)
+  task_internal <- paste0(if (nzchar(task_internal %||% "")) " while ", task_internal)
+
+  msg_internal <- sprintf(
+    "An error occurred%s for exercise '%s'",
+    task_internal,
+    exercise$label
+  )
+  rlang::warn(c(msg_internal, "x" = conditionMessage(error)))
+
+  exercise_result(
+    list(
+      correct = logical(),
+      type = "warning",
+      location = "replace",
+      message = sprintf(
+        "An internal error occurred%s. Please try again or contact the tutorial author.",
+        task_external
+      ),
+      error = error
+    )
+  )
+}
+
 exercise_result <- function(
   feedback = NULL,
   html_output = NULL,

diff --git a/R/mock_exercise.R b/R/mock_exercise.R
@@ -42,7 +42,8 @@ mock_exercise <- function(
     fig.num = 0,
     exercise.df_print = exercise.df_print,
     exercise.warn_invisible = exercise.warn_invisible,
-    exercise.timelimit = exercise.timelimit
+    exercise.timelimit = exercise.timelimit,
+    exercise.error.check.code = exercise.error.check.code
   )
 
   has_exercise_chunk <- any(