Enforce the requirement that -check chunks need an exercise.checker

.Rbuildignore

@@ -28,3 +28,5 @@ rsconnect/
 ^\.github$
 ^vignettes/articles$
 ^reference$
+^pkgdown$
+^_dev$

NEWS.md

@@ -90,6 +90,8 @@
 
 -   When `allow_skip` is set to `FALSE`, users are now required to run an exercise once with non-empty code in order to move forward. If the exercise has grading code, users are required to submit one (non-empty) answer (thanks @gaelso #616, #633).
 
+-   If an exercise includes a `-check` chunk but no `exercise.checker` function has been defined, learnr will now throw an error at render reminding the author to use `tutorial_options()` to define an exercise checker (#640).
+
 ### Questions
 
 -   `question_text()` gains `rows` and `cols` parameters. If either is provided, a multi-line `textAreaInput()` is used for the text input (thanks @dtkaplan #455, #460).

R/knitr-hooks.R

@@ -31,46 +31,52 @@ tutorial_knitr_options <- function() {
   }
 
   # helper to check for an exercise support chunk
-  is_exercise_support_chunk <- function(options, type = c("setup",
-                                                          "hint",
-                                                          "hint-\\d+",
-                                                          "solution",
-                                                          "error-check",
-                                                          "code-check",
-                                                          "check")) {
+  is_exercise_support_chunk <- function(
+    options,
+    type = c(
+      "setup",
+      "hint",
+      "hint-\\d+",
+      "solution",
+      "error-check",
+      "code-check",
+      "check"
+    )
+  ) {
+    # is this a support chunk using chunk labels to match with an exercise?
     support_regex <- paste0("-(", paste(type, collapse = "|"), ")$")
     if (grepl(support_regex, options$label)) {
       exercise_label <- sub(support_regex, "", options$label)
       label_query <- "knitr::all_labels(exercise == TRUE)"
       all_exercise_labels <- eval(parse(text = label_query))
-      exercise_label %in% all_exercise_labels
-    }
-    else if (identical(options$label, "setup-global-exercise")) {
-      TRUE
+      return(exercise_label %in% all_exercise_labels)
     }
-    else if ("setup" %in% type) {
-      # look for another chunk which names this as it's setup chunk or if it has `exercise.setup`
+
+    if ("setup" %in% type) {
+      if (identical(options$label, "setup-global-exercise")) {
+        return(TRUE)
+      }
+
+      # look for another chunk which names this as its setup chunk or if it has `exercise.setup`
       # this second condition is for support chunks that isn't referenced by an exercise yet
       # but is part of a chain and should be stored as a setup chunk
       is_referenced <- length(exercise_chunks_for_setup_chunk(options$label)) > 0
       if (is_referenced) {
         find_parent_setup_chunks(options) # only used to check for cycles; the return value is not useful here
-        TRUE
-      } else {
-        # if this looks like a setup chunk, but no one references it, error
-        if (is.null(options[["exercise"]]) && !is.null(options$exercise.setup)) {
-          stop(
-            "Chunk '", options$label, "' is not being used by any exercise or exercise setup chunk.\n",
-            "Please remove chunk '", options$label, "' or reference '", options$label, "' with `exercise.setup = '", options$label, "'`",
-               call. = FALSE)
-        }
-        # just a random chunk
-        FALSE
+        return(TRUE)
+      }
+
+      # if this looks like a setup chunk, but no one references it, error
+      if (is.null(options[["exercise"]]) && !is.null(options$exercise.setup)) {
+        stop(
+          "Chunk '", options$label, "' is not being used by any exercise or exercise setup chunk.\n",
+          "Please remove chunk '", options$label, "' or reference '", options$label, "' with `exercise.setup = '", options$label, "'`",
+          call. = FALSE
+        )
       }
     }
-    else {
-      FALSE
-    }
+
+    FALSE
   }
 
   is_exercise_setup_chunk <- function(label) {
@@ -234,6 +240,16 @@ tutorial_knitr_options <- function() {
       options$include <- FALSE
     }
 
+    if (is_exercise_support_chunk(options, type = "check")) {
+      if (is.null(knitr::opts_chunk$get("exercise.checker"))) {
+        stop(
+          "An exercise check chunk exists ('", options$label, "') but an ",
+          "exercise checker function is not configured for this tutorial. ",
+          "Please use `tutorial_options()` to define an `exercise.checker`."
+        )
+      }
+    }
+
     if (is_exercise_support_chunk(options, type = "solution")) {
       # only print solution if exercise.reveal_solution is TRUE
       options$echo <- get_reveal_solution_option(options)

tests/testthat/setup-chunks/error-check-chunk_bad.Rmd

@@ -9,6 +9,7 @@ description: >
 
 ```{r setup, include = FALSE}
 library(learnr)
+tutorial_options(exercise.checker = identity)
 ```
 
 ```{r ex, exercise = TRUE}

tests/testthat/setup-chunks/error-check-chunk_good.Rmd

@@ -8,6 +8,7 @@ description: This example should render
 
 ```{r setup, include = FALSE}
 library(learnr)
+tutorial_options(exercise.checker = identity)
 ```
 
 ```{r ex, exercise = TRUE}
@@ -20,4 +21,4 @@ library(learnr)
 
 ```{r ex-check}
 3
-```
+```

tests/testthat/test-evaluators.R

@@ -391,6 +391,7 @@ test_that("bad statuses or invalid json are handled sanely", {
 test_that("forked_evaluator works as expected", {
   skip_on_cran()
   skip_if(is_windows(), message = "Skipping forked evaluator testing on Windows")
+  skip_if(is_macos(), message = "Skipping forked evaluator testing on macOS")
 
   ex <- mock_exercise("Sys.sleep(1)\n1:100", check = I("last_value"))
   forked_eval_ex <- forked_evaluator_factory(evaluate_exercise(ex, new.env()), 2)

tests/testthat/test-setup-chunks.R → tests/testthat/test-knitr-hooks.R

@@ -1,3 +1,31 @@
+test_that("Error thrown: has -check chunk but missing exercise.checker", {
+  rmd <- test_path("tutorials", "missing-exercise-checker.Rmd")
+
+  withr::with_tempfile("outfile", fileext = ".html", {
+    expect_error(
+      rmarkdown::render(rmd, output_file = outfile, quiet = TRUE),
+      regexp = "exercise checker function is not configured"
+    )
+  })
+})
+
+test_that("*-error-check chunks require *-check chunks", {
+  skip_if_not(rmarkdown::pandoc_available())
+
+  tmpfile <- tempfile(fileext = ".html")
+  on.exit(unlink(tmpfile))
+
+  expect_error(
+    rmarkdown::render(test_path("setup-chunks", "error-check-chunk_bad.Rmd"), output_file = tmpfile, quiet = TRUE),
+    "ex-check",
+    fixed = TRUE
+  )
+
+  expect_silent(
+    rmarkdown::render(test_path("setup-chunks", "error-check-chunk_good.Rmd"), output_file = tmpfile, quiet = TRUE)
+  )
+})
+
 test_that("Detection of chained setup cycle works", {
   skip_if_not(rmarkdown::pandoc_available())
 

tests/testthat/tutorials/missing-exercise-checker.Rmd

@@ -0,0 +1,22 @@
+---
+title: "Missing Exercise Checker"
+output: learnr::tutorial
+runtime: shiny_prerendered
+---
+
+```{r setup, include=FALSE}
+library(learnr)
+```
+
+## Topic 1
+
+<!-- https://github.com/rstudio/learnr/issues/448 -->
+
+```{r two-plus-two, exercise=TRUE}
+
+```
+
+```{r two-plus-two-check}
+# presence of a check chunk implies exercise.checker is required
+```
+