From a298d1e10177874446e9f23a16a0ac9367aa6b56 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 21 Jan 2022 14:32:34 -0500 Subject: [PATCH] Enforce the requirement that `-check` chunks need an `exercise.checker` (#640) --- .Rbuildignore | 2 + NEWS.md | 2 + R/knitr-hooks.R | 70 ++++++++++++------- .../setup-chunks/error-check-chunk_bad.Rmd | 1 + .../setup-chunks/error-check-chunk_good.Rmd | 3 +- tests/testthat/test-chunks-error-check.R | 16 ----- tests/testthat/test-evaluators.R | 1 + ...test-setup-chunks.R => test-knitr-hooks.R} | 28 ++++++++ .../tutorials/missing-exercise-checker.Rmd | 22 ++++++ 9 files changed, 101 insertions(+), 44 deletions(-) delete mode 100644 tests/testthat/test-chunks-error-check.R rename tests/testthat/{test-setup-chunks.R => test-knitr-hooks.R} (63%) create mode 100644 tests/testthat/tutorials/missing-exercise-checker.Rmd diff --git a/.Rbuildignore b/.Rbuildignore index 61d782120..058b3edaf 100644 --- a/.Rbuildignore +++ b/.Rbuildignore @@ -28,3 +28,5 @@ rsconnect/ ^\.github$ ^vignettes/articles$ ^reference$ +^pkgdown$ +^_dev$ diff --git a/NEWS.md b/NEWS.md index 08a30055d..a6601d4ec 100644 --- a/NEWS.md +++ b/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). diff --git a/R/knitr-hooks.R b/R/knitr-hooks.R index d8b59c072..9e6d6f03d 100644 --- a/R/knitr-hooks.R +++ b/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) diff --git a/tests/testthat/setup-chunks/error-check-chunk_bad.Rmd b/tests/testthat/setup-chunks/error-check-chunk_bad.Rmd index 6938b4ed7..fa90d8978 100644 --- a/tests/testthat/setup-chunks/error-check-chunk_bad.Rmd +++ b/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} diff --git a/tests/testthat/setup-chunks/error-check-chunk_good.Rmd b/tests/testthat/setup-chunks/error-check-chunk_good.Rmd index 690993b7c..dfefc0dae 100644 --- a/tests/testthat/setup-chunks/error-check-chunk_good.Rmd +++ b/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 -``` \ No newline at end of file +``` diff --git a/tests/testthat/test-chunks-error-check.R b/tests/testthat/test-chunks-error-check.R deleted file mode 100644 index 22089f34e..000000000 --- a/tests/testthat/test-chunks-error-check.R +++ /dev/null @@ -1,16 +0,0 @@ -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) - ) -}) \ No newline at end of file diff --git a/tests/testthat/test-evaluators.R b/tests/testthat/test-evaluators.R index 657109aeb..941b35567 100644 --- a/tests/testthat/test-evaluators.R +++ b/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) diff --git a/tests/testthat/test-setup-chunks.R b/tests/testthat/test-knitr-hooks.R similarity index 63% rename from tests/testthat/test-setup-chunks.R rename to tests/testthat/test-knitr-hooks.R index 6d3263dce..85ec559a3 100644 --- a/tests/testthat/test-setup-chunks.R +++ b/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()) diff --git a/tests/testthat/tutorials/missing-exercise-checker.Rmd b/tests/testthat/tutorials/missing-exercise-checker.Rmd new file mode 100644 index 000000000..bc90d6fde --- /dev/null +++ b/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 + + + +```{r two-plus-two, exercise=TRUE} + +``` + +```{r two-plus-two-check} +# presence of a check chunk implies exercise.checker is required +``` +