From a61a584a30dd832cf5a16282d15a61284a85643e Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Tue, 15 Feb 2022 17:49:54 -0500
Subject: [PATCH 01/14] Initial support for test cases

---
 R/knitr-hooks.R                     | 50 ++++++++++++++++++++++++-
 R/mock_exercise.R                   |  2 +
 learnr.Rproj                        |  1 -
 tests/manual/test-cases.Rmd         | 47 ++++++++++++++++++++++++
 tests/testthat/test-exercise.R      | 30 ---------------
 tests/testthat/test-mock_exercise.R | 57 +++++++++++++++++++++++++++++
 6 files changed, 154 insertions(+), 33 deletions(-)
 create mode 100644 tests/manual/test-cases.Rmd
 create mode 100644 tests/testthat/test-mock_exercise.R

diff --git a/R/knitr-hooks.R b/R/knitr-hooks.R
index 47d24bfff..fc25d8414 100644
--- a/R/knitr-hooks.R
+++ b/R/knitr-hooks.R
@@ -40,7 +40,8 @@ tutorial_knitr_options <- function() {
       "solution",
       "error-check",
       "code-check",
-      "check"
+      "check",
+      "test-cases"
     )
   ) {
     # is this a support chunk using chunk labels to match with an exercise?
@@ -236,7 +237,8 @@ tutorial_knitr_options <- function() {
       options$highlight <- FALSE
     }
 
-    if (is_exercise_support_chunk(options, type = c("code-check", "error-check", "check"))) {
+    if (is_exercise_support_chunk(options, type = c("code-check", "error-check", "check", "test-cases"))) {
+      # completely suppress behind-the-scenes support chunks
       options$include <- FALSE
     }
 
@@ -361,6 +363,7 @@ tutorial_knitr_options <- function() {
         error_check_chunk <- get_knitr_chunk(paste0(options$label, "-error-check"))
         check_chunk <- get_knitr_chunk(paste0(options$label, "-check"))
         solution <- get_knitr_chunk(paste0(options$label, "-solution"))
+        test_cases <- get_knitr_chunk(paste0(options$label, "-test-cases"))
 
         # remove class of "knitr_strict_list" so (de)serializing works properly for external evaluators
         class(options) <- NULL
@@ -384,6 +387,7 @@ tutorial_knitr_options <- function() {
             error_check = error_check_chunk,
             check = check_chunk,
             solution  = solution,
+            test_cases = split_code_headers(test_cases, "test_case_"),
             options = options[setdiff(names(options), "tutorial")],
             engine = options$engine
           ),
@@ -543,3 +547,45 @@ verify_tutorial_chunk_label <- function() {
     )
   }
 }
+
+split_code_headers <- function(code, prefix = "test_case_") {
+  if (is.null(code)) {
+    return(NULL)
+  }
+
+  code <- paste(code, collapse = "\n")
+  code <- trimws(code)
+  code <- strsplit(code, "\n")[[1]]
+
+  rgx_header <- "^\\s*#+[ -]*(.+?)\\s*----+$"
+  headers <- regmatches(code, regexec(rgx_header, code))
+  lines_headers <- which(vapply(headers, length, integer(1)) > 0)
+
+  if (length(lines_headers) > 0 && max(lines_headers) == length(code)) {
+    # nothing after last heading
+    lines_headers <- lines_headers[-length(lines_headers)]
+  }
+
+  if (!length(lines_headers)) {
+    return(list(paste(code, collapse = "\n")))
+  }
+
+  header_names <- vapply(headers[lines_headers], `[[`, character(1), 2)
+  header_names <- trimws(header_names)
+  if (any(!nzchar(header_names))) {
+    header_names[!nzchar(header_names)] <- sprintf(
+      paste0(prefix, "%02d"),
+      which(!nzchar(header_names))
+    )
+  }
+
+  rgx_header_line <- gsub("[$^]", "(^|\n|$)", rgx_header)
+  sections <- strsplit(paste(code, collapse = "\n"), rgx_header_line, perl = TRUE)[[1]]
+  if (length(sections) > length(header_names)) {
+    header_names <- c(paste0(prefix, "00"), header_names)
+  }
+
+  names(sections) <- header_names
+  sections <- trimws(sections)
+  as.list(sections[nzchar(sections)])
+}
diff --git a/R/mock_exercise.R b/R/mock_exercise.R
index 5bae74bec..c607b14fe 100644
--- a/R/mock_exercise.R
+++ b/R/mock_exercise.R
@@ -9,6 +9,7 @@ mock_exercise <- function(
   code_check = NULL,  # code_check_chunk
   error_check = NULL, # error_check_chunk
   check = NULL,       # check_chunk
+  test_cases = NULL,  # test-cases
   exercise.checker = dput_to_string(debug_exercise_checker),
   exercise.error.check.code = dput_to_string(debug_exercise_checker),
   exercise.df_print = "default",
@@ -74,6 +75,7 @@ mock_exercise <- function(
     code_check = code_check,
     error_check = error_check,
     check = check,
+    test_cases = split_code_headers(test_cases, "test_case_"),
     options = utils::modifyList(default_options, list(...)),
     engine = engine,
     version = version
diff --git a/learnr.Rproj b/learnr.Rproj
index a63710897..db03a878a 100644
--- a/learnr.Rproj
+++ b/learnr.Rproj
@@ -17,6 +17,5 @@ StripTrailingWhitespace: Yes
 
 BuildType: Package
 PackageUseDevtools: Yes
-PackageCleanBeforeInstall: Yes
 PackageInstallArgs: --no-multiarch --with-keep.source --no-byte-compile
 PackageRoxygenize: rd,collate,namespace
diff --git a/tests/manual/test-cases.Rmd b/tests/manual/test-cases.Rmd
new file mode 100644
index 000000000..9153bf61e
--- /dev/null
+++ b/tests/manual/test-cases.Rmd
@@ -0,0 +1,47 @@
+---
+title: "Test Cases"
+output: learnr::tutorial
+runtime: shiny_prerendered
+---
+
+```{r setup, include=FALSE}
+library(learnr)
+tutorial_options(exercise.checker = function(user_code, ...) return(user_code))
+knitr::opts_chunk$set(echo = FALSE)
+```
+
+## Test Cases
+
+### Exercise
+
+```{r addition-setup}
+x <- 1 + 1
+```
+
+```{r addition, exercise = TRUE}
+
+```
+
+```{r addition-solution}
+1 + 1
+```
+
+```{r addition-check}
+check_this_exercise(user_code, solution_code)
+```
+
+```{r addition-test-cases}
+1 + 1
+
+# one plus two ----
+1 + 2
+
+# one plus three ----
+1 + 3
+
+# one equals three ----
+1 = 3
+
+# 2 minus one ----
+2 - 1
+```
diff --git a/tests/testthat/test-exercise.R b/tests/testthat/test-exercise.R
index 43d9cbd55..fdfcf0ae2 100644
--- a/tests/testthat/test-exercise.R
+++ b/tests/testthat/test-exercise.R
@@ -1,34 +1,4 @@
 
-# Test Exercise Mocking ---------------------------------------------------
-
-test_that("exercise mocks: mock_prep_setup()", {
-  chunks <- list(
-    mock_chunk("setup-1", "x <- 1"),
-    mock_chunk("setup-2", "y <- 2", exercise.setup = "setup-1"),
-    mock_chunk("setup-3", "z <- 3", exercise.setup = "setup-2")
-  )
-  expect_equal(mock_prep_setup(chunks, "setup-3"), "x <- 1\ny <- 2\nz <- 3")
-  expect_equal(mock_prep_setup(chunks, "setup-2"), "x <- 1\ny <- 2")
-  expect_equal(mock_prep_setup(chunks, "setup-1"), "x <- 1")
-
-  # random order
-  expect_equal(mock_prep_setup(chunks[3:1], "setup-3"), "x <- 1\ny <- 2\nz <- 3")
-  expect_equal(mock_prep_setup(chunks[c(1, 3, 2)], "setup-3"), "x <- 1\ny <- 2\nz <- 3")
-  expect_equal(mock_prep_setup(chunks[c(2, 3, 1)], "setup-3"), "x <- 1\ny <- 2\nz <- 3")
-  expect_equal(mock_prep_setup(chunks[c(2, 1, 3)], "setup-3"), "x <- 1\ny <- 2\nz <- 3")
-
-  # checks that setup chunk is in chunks
-  expect_error(mock_prep_setup(chunks, "setup-Z"), "setup-Z")
-
-  # cycles
-  chunks[[1]]$opts$exercise.setup = "setup-3"
-  expect_error(mock_prep_setup(chunks, "setup-3"), "-> setup-3$")
-
-  # duplicate labels
-  expect_error(mock_prep_setup(chunks[c(1, 1)], "setup-1"), "Duplicated")
-})
-
-
 # exercise_code_chunks() --------------------------------------------------
 
 test_that("exercise_code_chunks_prep() returns setup/user chunks", {
diff --git a/tests/testthat/test-mock_exercise.R b/tests/testthat/test-mock_exercise.R
new file mode 100644
index 000000000..820cc22cf
--- /dev/null
+++ b/tests/testthat/test-mock_exercise.R
@@ -0,0 +1,57 @@
+test_that("exercise mocks: mock_prep_setup()", {
+  chunks <- list(
+    mock_chunk("setup-1", "x <- 1"),
+    mock_chunk("setup-2", "y <- 2", exercise.setup = "setup-1"),
+    mock_chunk("setup-3", "z <- 3", exercise.setup = "setup-2")
+  )
+  expect_equal(mock_prep_setup(chunks, "setup-3"), "x <- 1\ny <- 2\nz <- 3")
+  expect_equal(mock_prep_setup(chunks, "setup-2"), "x <- 1\ny <- 2")
+  expect_equal(mock_prep_setup(chunks, "setup-1"), "x <- 1")
+
+  # random order
+  expect_equal(mock_prep_setup(chunks[3:1], "setup-3"), "x <- 1\ny <- 2\nz <- 3")
+  expect_equal(mock_prep_setup(chunks[c(1, 3, 2)], "setup-3"), "x <- 1\ny <- 2\nz <- 3")
+  expect_equal(mock_prep_setup(chunks[c(2, 3, 1)], "setup-3"), "x <- 1\ny <- 2\nz <- 3")
+  expect_equal(mock_prep_setup(chunks[c(2, 1, 3)], "setup-3"), "x <- 1\ny <- 2\nz <- 3")
+
+  # checks that setup chunk is in chunks
+  expect_error(mock_prep_setup(chunks, "setup-Z"), "setup-Z")
+
+  # cycles
+  chunks[[1]]$opts$exercise.setup = "setup-3"
+  expect_error(mock_prep_setup(chunks, "setup-3"), "-> setup-3$")
+
+  # duplicate labels
+  expect_error(mock_prep_setup(chunks[c(1, 1)], "setup-1"), "Duplicated")
+})
+
+test_that("mock exercise test cases", {
+  code <- '1 + 1
+
+# one plus two ----
+1 + 2
+
+# one plus three ----
+1 + 3
+
+# one equals three ----
+1 = 3
+
+# 2 minus one ----
+2 - 1'
+
+  ex <- mock_exercise("1 + 1", test_cases = code)
+  expect_equal(
+    ex$test_cases,
+    list(
+      test_case_00 = "1 + 1",
+      "one plus two" = "1 + 2",
+      "one plus three" = "1 + 3",
+      "one equals three" = "1 = 3",
+      "2 minus one" = "2 - 1"
+    )
+  )
+
+  expect_null(mock_exercise("1 + 1")$test_cases)
+  expect_equal(mock_exercise("1 + 1", test_cases = "1 + 1")$test_cases, list("1 + 1"))
+})

From d359be45593ba650ca87349b1766f7faa5be57e5 Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 10:23:29 -0500
Subject: [PATCH 02/14] Code section headers must be at the start of the line

---
 R/knitr-hooks.R | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/R/knitr-hooks.R b/R/knitr-hooks.R
index fc25d8414..e386b0839 100644
--- a/R/knitr-hooks.R
+++ b/R/knitr-hooks.R
@@ -557,7 +557,7 @@ split_code_headers <- function(code, prefix = "test_case_") {
   code <- trimws(code)
   code <- strsplit(code, "\n")[[1]]
 
-  rgx_header <- "^\\s*#+[ -]*(.+?)\\s*----+$"
+  rgx_header <- "^#+[ -]*(.+?)\\s*----+$"
   headers <- regmatches(code, regexec(rgx_header, code))
   lines_headers <- which(vapply(headers, length, integer(1)) > 0)
 

From 5a11d6959fd4503b47666b2fcdf18aed70d4d50d Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 10:25:12 -0500
Subject: [PATCH 03/14] Only trim newlines, not space/tabs

---
 R/knitr-hooks.R                     |  4 ++--
 tests/testthat/test-mock_exercise.R | 13 ++++++++++---
 2 files changed, 12 insertions(+), 5 deletions(-)

diff --git a/R/knitr-hooks.R b/R/knitr-hooks.R
index e386b0839..89e95f042 100644
--- a/R/knitr-hooks.R
+++ b/R/knitr-hooks.R
@@ -554,7 +554,7 @@ split_code_headers <- function(code, prefix = "test_case_") {
   }
 
   code <- paste(code, collapse = "\n")
-  code <- trimws(code)
+  code <- trimws(code, whitespace = "[\r\n]")
   code <- strsplit(code, "\n")[[1]]
 
   rgx_header <- "^#+[ -]*(.+?)\\s*----+$"
@@ -586,6 +586,6 @@ split_code_headers <- function(code, prefix = "test_case_") {
   }
 
   names(sections) <- header_names
-  sections <- trimws(sections)
+  sections <- trimws(sections, whitespace = "[\r\n]")
   as.list(sections[nzchar(sections)])
 }
diff --git a/tests/testthat/test-mock_exercise.R b/tests/testthat/test-mock_exercise.R
index 820cc22cf..0519b1482 100644
--- a/tests/testthat/test-mock_exercise.R
+++ b/tests/testthat/test-mock_exercise.R
@@ -25,16 +25,16 @@ test_that("exercise mocks: mock_prep_setup()", {
   expect_error(mock_prep_setup(chunks[c(1, 1)], "setup-1"), "Duplicated")
 })
 
-test_that("mock exercise test cases", {
+test_that("mock_exercise() test cases with splits", {
   code <- '1 + 1
 
 # one plus two ----
 1 + 2
 
-# one plus three ----
+## one plus three ----
 1 + 3
 
-# one equals three ----
+#### one equals three ----
 1 = 3
 
 # 2 minus one ----
@@ -51,7 +51,14 @@ test_that("mock exercise test cases", {
       "2 minus one" = "2 - 1"
     )
   )
+})
 
+test_that("mock_exercise() test cases, no splits", {
   expect_null(mock_exercise("1 + 1")$test_cases)
   expect_equal(mock_exercise("1 + 1", test_cases = "1 + 1")$test_cases, list("1 + 1"))
 })
+
+test_that("mock_exercise() test cases, bad split", {
+  code <- '   ## one\npi'
+  expect_equal(mock_exercise("1 + 1", test_cases = code)$test_cases, list(code))
+})

From c1f61782dcab3481d60521db36181b156d6338ab Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 10:41:57 -0500
Subject: [PATCH 04/14] Update str_trim() to backport trimws()

trimws() didn't have the whitespace arg until 3.6
---
 R/knitr-hooks.R | 14 +++++++++-----
 R/utils.R       | 18 ++++++++++--------
 2 files changed, 19 insertions(+), 13 deletions(-)

diff --git a/R/knitr-hooks.R b/R/knitr-hooks.R
index 89e95f042..35a317be1 100644
--- a/R/knitr-hooks.R
+++ b/R/knitr-hooks.R
@@ -554,7 +554,7 @@ split_code_headers <- function(code, prefix = "test_case_") {
   }
 
   code <- paste(code, collapse = "\n")
-  code <- trimws(code, whitespace = "[\r\n]")
+  code <- str_trim(code, character = "[\r\n]")
   code <- strsplit(code, "\n")[[1]]
 
   rgx_header <- "^#+[ -]*(.+?)\\s*----+$"
@@ -571,7 +571,7 @@ split_code_headers <- function(code, prefix = "test_case_") {
   }
 
   header_names <- vapply(headers[lines_headers], `[[`, character(1), 2)
-  header_names <- trimws(header_names)
+  header_names <- str_trim(header_names)
   if (any(!nzchar(header_names))) {
     header_names[!nzchar(header_names)] <- sprintf(
       paste0(prefix, "%02d"),
@@ -584,8 +584,12 @@ split_code_headers <- function(code, prefix = "test_case_") {
   if (length(sections) > length(header_names)) {
     header_names <- c(paste0(prefix, "00"), header_names)
   }
-
   names(sections) <- header_names
-  sections <- trimws(sections, whitespace = "[\r\n]")
-  as.list(sections[nzchar(sections)])
+
+  # trim leading/trailing new lines from code section
+  sections <- str_trim(sections, character = "[\r\n]")
+  # drop any sections that don't have anything in them
+  sections <- sections[nzchar(str_trim(sections))]
+
+  as.list(sections)
 }
diff --git a/R/utils.R b/R/utils.R
index 19b2599e1..3df84a451 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -60,14 +60,16 @@ if (getRversion() < package_version("3.6.0")) {
   }
 }
 
-str_trim <- function(x) {
-  sub(
-    "\\s+$", "",
-    sub(
-      "^\\s+", "",
-      as.character(x)
-    )
-  )
+str_trim <- function(x, side = "both", character = "\\s") {
+  if (side %in% c("both", "left", "start")) {
+    rgx <- sprintf("^%s+", character)
+    x <- sub(rgx, "", x)
+  }
+  if (side %in% c("both", "right", "end")) {
+    rgx <- sprintf("%s+$", character)
+    x <- sub(rgx, "", x)
+  }
+  x
 }
 
 if_no_match_return_null <- function(x) {

From 2402c10cd16708808e800276898f1eb288f05590 Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 10:52:23 -0500
Subject: [PATCH 05/14] Setup staticimports and export code splitting functions

---
 R/knitr-hooks.R                         | 46 ------------------
 R/staticimports.R                       | 62 +++++++++++++++++++++++++
 R/utils.R                               | 16 ++-----
 inst/staticexports/split_code_headers.R | 45 ++++++++++++++++++
 inst/staticexports/strings.R            | 12 +++++
 5 files changed, 123 insertions(+), 58 deletions(-)
 create mode 100644 R/staticimports.R
 create mode 100644 inst/staticexports/split_code_headers.R
 create mode 100644 inst/staticexports/strings.R

diff --git a/R/knitr-hooks.R b/R/knitr-hooks.R
index 35a317be1..69a6bbaeb 100644
--- a/R/knitr-hooks.R
+++ b/R/knitr-hooks.R
@@ -547,49 +547,3 @@ verify_tutorial_chunk_label <- function() {
     )
   }
 }
-
-split_code_headers <- function(code, prefix = "test_case_") {
-  if (is.null(code)) {
-    return(NULL)
-  }
-
-  code <- paste(code, collapse = "\n")
-  code <- str_trim(code, character = "[\r\n]")
-  code <- strsplit(code, "\n")[[1]]
-
-  rgx_header <- "^#+[ -]*(.+?)\\s*----+$"
-  headers <- regmatches(code, regexec(rgx_header, code))
-  lines_headers <- which(vapply(headers, length, integer(1)) > 0)
-
-  if (length(lines_headers) > 0 && max(lines_headers) == length(code)) {
-    # nothing after last heading
-    lines_headers <- lines_headers[-length(lines_headers)]
-  }
-
-  if (!length(lines_headers)) {
-    return(list(paste(code, collapse = "\n")))
-  }
-
-  header_names <- vapply(headers[lines_headers], `[[`, character(1), 2)
-  header_names <- str_trim(header_names)
-  if (any(!nzchar(header_names))) {
-    header_names[!nzchar(header_names)] <- sprintf(
-      paste0(prefix, "%02d"),
-      which(!nzchar(header_names))
-    )
-  }
-
-  rgx_header_line <- gsub("[$^]", "(^|\n|$)", rgx_header)
-  sections <- strsplit(paste(code, collapse = "\n"), rgx_header_line, perl = TRUE)[[1]]
-  if (length(sections) > length(header_names)) {
-    header_names <- c(paste0(prefix, "00"), header_names)
-  }
-  names(sections) <- header_names
-
-  # trim leading/trailing new lines from code section
-  sections <- str_trim(sections, character = "[\r\n]")
-  # drop any sections that don't have anything in them
-  sections <- sections[nzchar(str_trim(sections))]
-
-  as.list(sections)
-}
diff --git a/R/staticimports.R b/R/staticimports.R
new file mode 100644
index 000000000..0d01756c7
--- /dev/null
+++ b/R/staticimports.R
@@ -0,0 +1,62 @@
+# Generated by staticimports; do not edit by hand.
+# ======================================================================
+# Imported from inst/staticexports/
+# ======================================================================
+
+split_code_headers <- function(code, prefix = "section") {
+  if (is.null(code)) {
+    return(NULL)
+  }
+
+  code <- paste(code, collapse = "\n")
+  code <- str_trim(code, character = "[\r\n]")
+  code <- strsplit(code, "\n")[[1]]
+
+  rgx_header <- "^#+[ -]*(.+?)\\s*----+$"
+  headers <- regmatches(code, regexec(rgx_header, code))
+  lines_headers <- which(vapply(headers, length, integer(1)) > 0)
+
+  if (length(lines_headers) > 0 && max(lines_headers) == length(code)) {
+    # nothing after last heading
+    lines_headers <- lines_headers[-length(lines_headers)]
+  }
+
+  if (!length(lines_headers)) {
+    return(list(paste(code, collapse = "\n")))
+  }
+
+  header_names <- vapply(headers[lines_headers], `[[`, character(1), 2)
+  header_names <- str_trim(header_names)
+  if (any(!nzchar(header_names))) {
+    header_names[!nzchar(header_names)] <- sprintf(
+      paste0(prefix, "%02d"),
+      which(!nzchar(header_names))
+    )
+  }
+
+  rgx_header_line <- gsub("[$^]", "(^|\n|$)", rgx_header)
+  sections <- strsplit(paste(code, collapse = "\n"), rgx_header_line, perl = TRUE)[[1]]
+  if (length(sections) > length(header_names)) {
+    header_names <- c(paste0(prefix, "00"), header_names)
+  }
+  names(sections) <- header_names
+
+  # trim leading/trailing new lines from code section
+  sections <- str_trim(sections, character = "[\r\n]")
+  # drop any sections that don't have anything in them
+  sections <- sections[nzchar(str_trim(sections))]
+
+  as.list(sections)
+}
+
+str_trim <- function(x, side = "both", character = "\\s") {
+  if (side %in% c("both", "left", "start")) {
+    rgx <- sprintf("^%s+", character)
+    x <- sub(rgx, "", x)
+  }
+  if (side %in% c("both", "right", "end")) {
+    rgx <- sprintf("%s+$", character)
+    x <- sub(rgx, "", x)
+  }
+  x
+}
diff --git a/R/utils.R b/R/utils.R
index 3df84a451..46cc6fe46 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -1,3 +1,7 @@
+# @staticimports inst/staticexports/
+#   split_code_headers
+#   str_trim
+
 "%||%" <- function(x, y) if (is.null(x)) y else x
 
 is_windows <- function() {
@@ -60,18 +64,6 @@ if (getRversion() < package_version("3.6.0")) {
   }
 }
 
-str_trim <- function(x, side = "both", character = "\\s") {
-  if (side %in% c("both", "left", "start")) {
-    rgx <- sprintf("^%s+", character)
-    x <- sub(rgx, "", x)
-  }
-  if (side %in% c("both", "right", "end")) {
-    rgx <- sprintf("%s+$", character)
-    x <- sub(rgx, "", x)
-  }
-  x
-}
-
 if_no_match_return_null <- function(x) {
   if (length(x) == 0) {
     NULL
diff --git a/inst/staticexports/split_code_headers.R b/inst/staticexports/split_code_headers.R
new file mode 100644
index 000000000..710980615
--- /dev/null
+++ b/inst/staticexports/split_code_headers.R
@@ -0,0 +1,45 @@
+split_code_headers <- function(code, prefix = "section") {
+  if (is.null(code)) {
+    return(NULL)
+  }
+
+  code <- paste(code, collapse = "\n")
+  code <- str_trim(code, character = "[\r\n]")
+  code <- strsplit(code, "\n")[[1]]
+
+  rgx_header <- "^#+[ -]*(.+?)\\s*----+$"
+  headers <- regmatches(code, regexec(rgx_header, code))
+  lines_headers <- which(vapply(headers, length, integer(1)) > 0)
+
+  if (length(lines_headers) > 0 && max(lines_headers) == length(code)) {
+    # nothing after last heading
+    lines_headers <- lines_headers[-length(lines_headers)]
+  }
+
+  if (!length(lines_headers)) {
+    return(list(paste(code, collapse = "\n")))
+  }
+
+  header_names <- vapply(headers[lines_headers], `[[`, character(1), 2)
+  header_names <- str_trim(header_names)
+  if (any(!nzchar(header_names))) {
+    header_names[!nzchar(header_names)] <- sprintf(
+      paste0(prefix, "%02d"),
+      which(!nzchar(header_names))
+    )
+  }
+
+  rgx_header_line <- gsub("[$^]", "(^|\n|$)", rgx_header)
+  sections <- strsplit(paste(code, collapse = "\n"), rgx_header_line, perl = TRUE)[[1]]
+  if (length(sections) > length(header_names)) {
+    header_names <- c(paste0(prefix, "00"), header_names)
+  }
+  names(sections) <- header_names
+
+  # trim leading/trailing new lines from code section
+  sections <- str_trim(sections, character = "[\r\n]")
+  # drop any sections that don't have anything in them
+  sections <- sections[nzchar(str_trim(sections))]
+
+  as.list(sections)
+}
diff --git a/inst/staticexports/strings.R b/inst/staticexports/strings.R
new file mode 100644
index 000000000..8c35af8bf
--- /dev/null
+++ b/inst/staticexports/strings.R
@@ -0,0 +1,12 @@
+
+str_trim <- function(x, side = "both", character = "\\s") {
+  if (side %in% c("both", "left", "start")) {
+    rgx <- sprintf("^%s+", character)
+    x <- sub(rgx, "", x)
+  }
+  if (side %in% c("both", "right", "end")) {
+    rgx <- sprintf("%s+$", character)
+    x <- sub(rgx, "", x)
+  }
+  x
+}

From 6a91b036a15159227cba07f137b93b6457b488c0 Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 11:02:36 -0500
Subject: [PATCH 06/14] Use static imports from {staticimports}

---
 R/evaluators.R                   |  2 +-
 R/exercise.R                     |  2 +-
 R/staticimports.R                | 72 ++++++++++++++++++++++++++++++++
 R/utils.R                        | 24 ++---------
 tests/testthat/test-evaluators.R |  2 +-
 5 files changed, 79 insertions(+), 23 deletions(-)

diff --git a/R/evaluators.R b/R/evaluators.R
index 1a976e096..2705c2262 100644
--- a/R/evaluators.R
+++ b/R/evaluators.R
@@ -38,7 +38,7 @@ setup_forked_evaluator_factory <- function(max_forked_procs){
   running_exercises <- 0
 
   function(expr, timelimit, ...) {
-    if (is_macos()) {
+    if (is_mac()) {
       rlang::warn("Forked evaluators may not work as expected on MacOS")
     } else if (is_windows()) {
       rlang::warn("Forked evaluators may not work as expected on Windows")
diff --git a/R/exercise.R b/R/exercise.R
index b48f2a8c5..18230abac 100644
--- a/R/exercise.R
+++ b/R/exercise.R
@@ -69,7 +69,7 @@ setup_exercise_handler <- function(exercise_rx, session) {
       remote_host <- getOption("tutorial.external.host", Sys.getenv("TUTORIAL_EXTERNAL_EVALUATOR_HOST", NA))
       if (!is.na(remote_host)){
         evaluator_factory <- external_evaluator(remote_host)
-      } else if (!is_windows() && !is_macos())
+      } else if (!is_windows() && !is_mac())
         evaluator_factory <- forked_evaluator_factory
       else
         evaluator_factory <- inline_evaluator
diff --git a/R/staticimports.R b/R/staticimports.R
index 0d01756c7..a5a5861ad 100644
--- a/R/staticimports.R
+++ b/R/staticimports.R
@@ -60,3 +60,75 @@ str_trim <- function(x, side = "both", character = "\\s") {
   }
   x
 }
+# Generated by staticimports; do not edit by hand.
+# ======================================================================
+# Imported from pkg:staticimports
+# ======================================================================
+
+`%||%` <- function(a, b) {
+  if (is.null(a)) b else a
+}
+
+get_package_version <- function(pkg) {
+  # `utils::packageVersion()` can be slow, so first try the fast path of
+  # checking if the package is already loaded.
+  ns <- .getNamespace(pkg)
+  if (is.null(ns)) {
+    utils::packageVersion(pkg)
+  } else {
+    as.package_version(ns$.__NAMESPACE__.$spec[["version"]])
+  }
+}
+
+is_installed <- function(pkg, version = NULL) {
+  installed <- isNamespaceLoaded(pkg) || nzchar(system_file_cached(package = pkg))
+  if (is.null(version)) {
+    return(installed)
+  }
+  installed && isTRUE(get_package_version(pkg) >= version)
+}
+
+is_linux   <- function() Sys.info()[['sysname']] == 'Linux'
+
+is_mac     <- function() Sys.info()[['sysname']] == 'Darwin'
+
+is_windows <- function() .Platform$OS.type == "windows"
+
+os_name <- function() {
+  if (is_windows()) {
+    "win"
+  } else if (is_mac()) {
+    "mac"
+  } else if (is_linux()) {
+    "linux"
+  } else if (.Platform$OS.type == "unix") {
+    "unix"
+  } else {
+    "unknown"
+  }
+}
+
+# A wrapper for `system.file()`, which caches the results, because
+# `system.file()` can be slow. Note that because of caching, if
+# `system_file_cached()` is called on a package that isn't installed, then the
+# package is installed, and then `system_file_cached()` is called again, it will
+# still return "".
+system_file_cached <- local({
+  pkg_dir_cache <- character()
+
+  function(..., package = "base") {
+    if (!is.null(names(list(...)))) {
+      stop("All arguments other than `package` must be unnamed.")
+    }
+
+    not_cached <- is.na(match(package, names(pkg_dir_cache)))
+    if (not_cached) {
+      pkg_dir <- system.file(package = package)
+      pkg_dir_cache[[package]] <<- pkg_dir
+    } else {
+      pkg_dir <- pkg_dir_cache[[package]]
+    }
+
+    file.path(pkg_dir, ...)
+  }
+})
diff --git a/R/utils.R b/R/utils.R
index 46cc6fe46..c7ab36339 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -2,16 +2,10 @@
 #   split_code_headers
 #   str_trim
 
-"%||%" <- function(x, y) if (is.null(x)) y else x
-
-is_windows <- function() {
-  .Platform$OS.type == 'windows'
-}
-
-is_macos <- function() {
-  Sys.info()[["sysname"]] == "Darwin"
-}
-
+# @staticimports pkg:staticimports
+#   os_name
+#   %||%
+#   is_installed
 
 is_localhost <- function(location) {
   if (is.null(location))
@@ -116,16 +110,6 @@ knitr_engine <- function(engine) {
   tolower(engine %||% "r")
 }
 
-is_installed <- function(package, version = NULL) {
-  if (system.file(package = package) == "") {
-    return(FALSE)
-  }
-  if (!is.null(version) && utils::packageVersion(package) < version) {
-    return(FALSE)
-  }
-  TRUE
-}
-
 timestamp_utc <- function() {
   strftime(Sys.time(), "%F %H:%M:%OS3 %Z", tz = "UTC")
 }
diff --git a/tests/testthat/test-evaluators.R b/tests/testthat/test-evaluators.R
index 941b35567..a0077d8ff 100644
--- a/tests/testthat/test-evaluators.R
+++ b/tests/testthat/test-evaluators.R
@@ -391,7 +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")
+  skip_if(is_mac(), 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)

From 8b88fab09119f84f1602358028ec8e82f4d2d2a6 Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 12:00:41 -0500
Subject: [PATCH 07/14] small adjustment to code header regexp

---
 R/staticimports.R                       | 7 ++++---
 inst/staticexports/split_code_headers.R | 7 ++++---
 2 files changed, 8 insertions(+), 6 deletions(-)

diff --git a/R/staticimports.R b/R/staticimports.R
index a5a5861ad..0e8fe252b 100644
--- a/R/staticimports.R
+++ b/R/staticimports.R
@@ -12,8 +12,8 @@ split_code_headers <- function(code, prefix = "section") {
   code <- str_trim(code, character = "[\r\n]")
   code <- strsplit(code, "\n")[[1]]
 
-  rgx_header <- "^#+[ -]*(.+?)\\s*----+$"
-  headers <- regmatches(code, regexec(rgx_header, code))
+  rgx_header <- "^(#+)([ -]*)(.+?)?\\s*----+$"
+  headers <- regmatches(code, regexec(rgx_header, code, perl = TRUE))
   lines_headers <- which(vapply(headers, length, integer(1)) > 0)
 
   if (length(lines_headers) > 0 && max(lines_headers) == length(code)) {
@@ -25,7 +25,8 @@ split_code_headers <- function(code, prefix = "section") {
     return(list(paste(code, collapse = "\n")))
   }
 
-  header_names <- vapply(headers[lines_headers], `[[`, character(1), 2)
+  # header names are 3rd group, so 4th place in match since 1st is the whole match
+  header_names <- vapply(headers[lines_headers], `[[`, character(1), 4)
   header_names <- str_trim(header_names)
   if (any(!nzchar(header_names))) {
     header_names[!nzchar(header_names)] <- sprintf(
diff --git a/inst/staticexports/split_code_headers.R b/inst/staticexports/split_code_headers.R
index 710980615..fd26aba6f 100644
--- a/inst/staticexports/split_code_headers.R
+++ b/inst/staticexports/split_code_headers.R
@@ -7,8 +7,8 @@ split_code_headers <- function(code, prefix = "section") {
   code <- str_trim(code, character = "[\r\n]")
   code <- strsplit(code, "\n")[[1]]
 
-  rgx_header <- "^#+[ -]*(.+?)\\s*----+$"
-  headers <- regmatches(code, regexec(rgx_header, code))
+  rgx_header <- "^(#+)([ -]*)(.+?)?\\s*----+$"
+  headers <- regmatches(code, regexec(rgx_header, code, perl = TRUE))
   lines_headers <- which(vapply(headers, length, integer(1)) > 0)
 
   if (length(lines_headers) > 0 && max(lines_headers) == length(code)) {
@@ -20,7 +20,8 @@ split_code_headers <- function(code, prefix = "section") {
     return(list(paste(code, collapse = "\n")))
   }
 
-  header_names <- vapply(headers[lines_headers], `[[`, character(1), 2)
+  # header names are 3rd group, so 4th place in match since 1st is the whole match
+  header_names <- vapply(headers[lines_headers], `[[`, character(1), 4)
   header_names <- str_trim(header_names)
   if (any(!nzchar(header_names))) {
     header_names[!nzchar(header_names)] <- sprintf(

From 10e20ec192775d1015813d193cadd75ff19d33fc Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 13:44:01 -0500
Subject: [PATCH 08/14] Rename: test_cases --> tests

---
 R/knitr-hooks.R                                |  8 ++++----
 R/mock_exercise.R                              | 10 +++++-----
 .../manual/{test-cases.Rmd => tests-chunk.Rmd} |  2 +-
 tests/testthat/test-mock_exercise.R            | 18 +++++++++---------
 4 files changed, 19 insertions(+), 19 deletions(-)
 rename tests/manual/{test-cases.Rmd => tests-chunk.Rmd} (95%)

diff --git a/R/knitr-hooks.R b/R/knitr-hooks.R
index 69a6bbaeb..fe2e9fe63 100644
--- a/R/knitr-hooks.R
+++ b/R/knitr-hooks.R
@@ -41,7 +41,7 @@ tutorial_knitr_options <- function() {
       "error-check",
       "code-check",
       "check",
-      "test-cases"
+      "tests"
     )
   ) {
     # is this a support chunk using chunk labels to match with an exercise?
@@ -237,7 +237,7 @@ tutorial_knitr_options <- function() {
       options$highlight <- FALSE
     }
 
-    if (is_exercise_support_chunk(options, type = c("code-check", "error-check", "check", "test-cases"))) {
+    if (is_exercise_support_chunk(options, type = c("code-check", "error-check", "check", "tests"))) {
       # completely suppress behind-the-scenes support chunks
       options$include <- FALSE
     }
@@ -363,7 +363,7 @@ tutorial_knitr_options <- function() {
         error_check_chunk <- get_knitr_chunk(paste0(options$label, "-error-check"))
         check_chunk <- get_knitr_chunk(paste0(options$label, "-check"))
         solution <- get_knitr_chunk(paste0(options$label, "-solution"))
-        test_cases <- get_knitr_chunk(paste0(options$label, "-test-cases"))
+        test_cases <- get_knitr_chunk(paste0(options$label, "-tests"))
 
         # remove class of "knitr_strict_list" so (de)serializing works properly for external evaluators
         class(options) <- NULL
@@ -387,7 +387,7 @@ tutorial_knitr_options <- function() {
             error_check = error_check_chunk,
             check = check_chunk,
             solution  = solution,
-            test_cases = split_code_headers(test_cases, "test_case_"),
+            test_cases = split_code_headers(test_cases, "test"),
             options = options[setdiff(names(options), "tutorial")],
             engine = options$engine
           ),
diff --git a/R/mock_exercise.R b/R/mock_exercise.R
index c607b14fe..778f13db0 100644
--- a/R/mock_exercise.R
+++ b/R/mock_exercise.R
@@ -6,10 +6,10 @@ mock_exercise <- function(
   global_setup = NULL,
   setup_label = NULL,
   solution_code = NULL,
-  code_check = NULL,  # code_check_chunk
-  error_check = NULL, # error_check_chunk
-  check = NULL,       # check_chunk
-  test_cases = NULL,  # test-cases
+  code_check = NULL,  # code_check chunk
+  error_check = NULL, # error_check chunk
+  check = NULL,       # check chunk
+  tests = NULL,       # tests chunk
   exercise.checker = dput_to_string(debug_exercise_checker),
   exercise.error.check.code = dput_to_string(debug_exercise_checker),
   exercise.df_print = "default",
@@ -75,7 +75,7 @@ mock_exercise <- function(
     code_check = code_check,
     error_check = error_check,
     check = check,
-    test_cases = split_code_headers(test_cases, "test_case_"),
+    tests = split_code_headers(tests, "test"),
     options = utils::modifyList(default_options, list(...)),
     engine = engine,
     version = version
diff --git a/tests/manual/test-cases.Rmd b/tests/manual/tests-chunk.Rmd
similarity index 95%
rename from tests/manual/test-cases.Rmd
rename to tests/manual/tests-chunk.Rmd
index 9153bf61e..40ef17332 100644
--- a/tests/manual/test-cases.Rmd
+++ b/tests/manual/tests-chunk.Rmd
@@ -30,7 +30,7 @@ x <- 1 + 1
 check_this_exercise(user_code, solution_code)
 ```
 
-```{r addition-test-cases}
+```{r addition-tests}
 1 + 1
 
 # one plus two ----
diff --git a/tests/testthat/test-mock_exercise.R b/tests/testthat/test-mock_exercise.R
index 0519b1482..0a490a0b6 100644
--- a/tests/testthat/test-mock_exercise.R
+++ b/tests/testthat/test-mock_exercise.R
@@ -25,7 +25,7 @@ test_that("exercise mocks: mock_prep_setup()", {
   expect_error(mock_prep_setup(chunks[c(1, 1)], "setup-1"), "Duplicated")
 })
 
-test_that("mock_exercise() test cases with splits", {
+test_that("mock_exercise() creates tests with splits", {
   code <- '1 + 1
 
 # one plus two ----
@@ -40,11 +40,11 @@ test_that("mock_exercise() test cases with splits", {
 # 2 minus one ----
 2 - 1'
 
-  ex <- mock_exercise("1 + 1", test_cases = code)
+  ex <- mock_exercise("1 + 1", tests = code)
   expect_equal(
-    ex$test_cases,
+    ex$tests,
     list(
-      test_case_00 = "1 + 1",
+      test00 = "1 + 1",
       "one plus two" = "1 + 2",
       "one plus three" = "1 + 3",
       "one equals three" = "1 = 3",
@@ -53,12 +53,12 @@ test_that("mock_exercise() test cases with splits", {
   )
 })
 
-test_that("mock_exercise() test cases, no splits", {
-  expect_null(mock_exercise("1 + 1")$test_cases)
-  expect_equal(mock_exercise("1 + 1", test_cases = "1 + 1")$test_cases, list("1 + 1"))
+test_that("mock_exercise() tests, no splits", {
+  expect_null(mock_exercise("1 + 1")$tests)
+  expect_equal(mock_exercise("1 + 1", tests = "1 + 1")$tests, list("1 + 1"))
 })
 
-test_that("mock_exercise() test cases, bad split", {
+test_that("mock_exercise() tests, bad split", {
   code <- '   ## one\npi'
-  expect_equal(mock_exercise("1 + 1", test_cases = code)$test_cases, list(code))
+  expect_equal(mock_exercise("1 + 1", tests = code)$tests, list(code))
 })

From b5602ecf28229b33926b38d2ec248683c290911d Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 15:18:10 -0500
Subject: [PATCH 09/14] Update docs to include -tests chunks

---
 vignettes/articles/exercises.Rmd | 32 +++++++++++++++++++++++++++++---
 1 file changed, 29 insertions(+), 3 deletions(-)

diff --git a/vignettes/articles/exercises.Rmd b/vignettes/articles/exercises.Rmd
index 28dfc103b..a4d129427 100644
--- a/vignettes/articles/exercises.Rmd
+++ b/vignettes/articles/exercises.Rmd
@@ -8,6 +8,9 @@ description: >
 ## Overview
 
 Exercises are interactive R code chunks that allow readers to directly execute R code and see its results.
+
+### Exercise Options
+
 There are many options associated with tutorial exercises (all of which are described in more detail below):
 
 +-----------------------------+-------------------------------------------------------------------------------------------------------------------------------------+
@@ -46,11 +49,20 @@ source("snippets.R")
 insert_snippet("exerciseoptions")
 ```
 
-There are also some other specialized chunks that can be used with an exercise chunk, including:
+### Exercise Support Chunks
+
+There are also some other specialized chunks that can be used with an exercise chunk.
+These chunks a linked together
+
+1.  Exercise [`-setup` chunks](#exercise-setup) enable you to execute code to setup the environment immediately prior to executing submitted code.
+
+1.  Exercise [`-solution` chunks](#exercise-solutions) enable you to provide a solution to the exercise that can be optionally viewed by users of the tutorial.
+
+1.  Exercise [`-hint` chunks](#r-code-hints) are used to provide a series of hints to help the user progress through the exercise.
 
-1.  Exercise [setup chunks](#exercise-setup), which enable you to execute code to setup the environment immediately prior to executing submitted code.
+1.  Exercise [`-check`, `-code-check`, and `-error-check` chunks](#exercise-checking) are used to provide logic for checking the user's attempt to solve the exercise.
 
-2.  Exercise [solution chunks](#exercise-solutions) which enable you to provide a solution to the exercise that can be optionally viewed by users of the tutorial.
+1. Finally, exercise [`-tests` chunks](#test-code-or-cases) can store test cases or testing code related to the exercise.
 
 The use of these special chunks is also described in detail below.
 
@@ -381,6 +393,20 @@ See the table below for a full description of all the arguments supplied to `exe
 | `...`             | Unused (include for compatibility with parameters to be added in the future)                                                 |
 +-------------------+------------------------------------------------------------------------------------------------------------------------------+
 
+### Test Code or Cases
+
+In some cases, you may want to record test cases —
+examples of alternative solutions, common mistakes made by students, edge cases that are missed by your checking code, etc.
+
+You can place this test code in a `*-tests` chunk.
+It will be preserved in the tutorial's R Markdown source and stored in learnr's internal data for the exercise, but it won't appear in the tutorial text.
+learnr doesn't currently provide a mechanism for testing exercises,
+but support for exercise testing is on the roadmap for future development.
+
+```{r snippet-exercise-tests, echo = FALSE}
+insert_snippet("exercise-tests")
+```
+
 ## Exercise Caption
 
 By default exercises are displayed with caption of "Code".

From b5b154f9e99df3ff195ab7069588004a0e29acc4 Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 15:20:49 -0500
Subject: [PATCH 10/14] Add NEWS item for #664

---
 NEWS.md | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/NEWS.md b/NEWS.md
index 15387919f..49dd7886c 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -54,6 +54,8 @@
 
 -   Authors can choose to reveal (default) or hide the solution to an exercise. Set `exercise.reveal_solution` in the chunk options of a `*-solution` chunk to choose whether or not the solution is revealed to the user. The option can also be set globally with `tutorial_options()`. In a future version of learnr, the default will likely be changed to hide solutions (#402).
 
+-   Exercises may now include `-tests` chunks. These chunks don't appear in the tutorial text but the code in them is stored in the internal exercise data. In the future, these chunks will be used to provide automated exercise testing (#664).
+
 -   Keyboard navigation and keyboard shortcuts for the interactive exercise code editor have been improved:
 
     -   To avoid trapping keyboard focus and to allow users to navigate through a tutorial with the keyboard, pressing <kbd>Esc</kbd> in an interactive exercise code editor now temporarily disables the use of <kbd>Tab</kbd> for indenting, making it possible for users to move to the next or previous element in the tutorial (#652).

From 1165ed6d9b2a2101922413f94b02d579083c34bb Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 15:30:55 -0500
Subject: [PATCH 11/14] fixup add snippet

---
 pkgdown/assets/snippets/exercise-tests.md | 27 +++++++++++++++++++++++
 1 file changed, 27 insertions(+)
 create mode 100644 pkgdown/assets/snippets/exercise-tests.md

diff --git a/pkgdown/assets/snippets/exercise-tests.md b/pkgdown/assets/snippets/exercise-tests.md
new file mode 100644
index 000000000..488c96e47
--- /dev/null
+++ b/pkgdown/assets/snippets/exercise-tests.md
@@ -0,0 +1,27 @@
+```{r addition, exercise = TRUE}
+
+```
+
+```{r addition-solution}
+1 + 1
+```
+
+```{r addition-check}
+check_this_exercise(user_code, solution_code)
+```
+
+```{r addition-tests}
+1 + 1
+
+# one plus two ----
+1 + 2
+
+# one plus three ----
+1 + 3
+
+# one equals three ----
+1 = 3
+
+# 2 minus one ----
+2 - 1
+```

From 64730ee5fd18ebc6d2dd14ec8dd74b1642d7fd18 Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 15:31:50 -0500
Subject: [PATCH 12/14] Static export/import assertions

- is_AsIs()
- is_html_tag()
- is_html_chr()
- is_html_any()
---
 R/exercise.R                    |  6 +++---
 R/question_answers.R            |  2 +-
 R/quiz.R                        |  5 +----
 R/staticimports.R               | 16 ++++++++++++++++
 R/utils.R                       |  7 ++-----
 inst/staticexports/assertions.R | 15 +++++++++++++++
 6 files changed, 38 insertions(+), 13 deletions(-)
 create mode 100644 inst/staticexports/assertions.R

diff --git a/R/exercise.R b/R/exercise.R
index 18230abac..ec46a8917 100644
--- a/R/exercise.R
+++ b/R/exercise.R
@@ -290,7 +290,7 @@ validate_exercise <- function(exercise, require_items = NULL) {
 }
 
 standardize_code <- function(code) {
-  if (inherits(code, "AsIs")) {
+  if (is_AsIs(code)) {
     return(code)
   }
   if (is.null(code) || !length(code)) {
@@ -1089,7 +1089,7 @@ exercise_result <- function(
 
   if (is.character(feedback$html) && any(nzchar(feedback$html))) {
     feedback$html <- htmltools::HTML(feedback$html)
-  } else if (!inherits(feedback$html, c("shiny.tag", "shiny.tag.list", "html"))) {
+  } else if (!is_html_any(feedback$html)) {
     feedback$html <- feedback_as_html(feedback)
   }
 
@@ -1261,7 +1261,7 @@ debug_exercise_checker <- function(
   ...
 ) {
   # Use I() around check_code to indicate that we want to evaluate the check code
-  checker_result <- if (inherits(check_code, "AsIs")) {
+  checker_result <- if (is_AsIs(check_code)) {
     local(eval(parse(text = check_code)))
   }
 
diff --git a/R/question_answers.R b/R/question_answers.R
index d37ca6aa3..cddce2fbf 100644
--- a/R/question_answers.R
+++ b/R/question_answers.R
@@ -36,7 +36,7 @@
 #' @describeIn answer Create an answer option
 #' @export
 answer <- function(text, correct = FALSE, message = NULL, label = text) {
-  if (!is_tags(message)) {
+  if (!is_html_tag(message)) {
     checkmate::assert_character(message, len = 1, null.ok = TRUE, any.missing = FALSE)
   }
 
diff --git a/R/quiz.R b/R/quiz.R
index 8dcc0f374..edf4fc77a 100644
--- a/R/quiz.R
+++ b/R/quiz.R
@@ -223,10 +223,7 @@ question <- function(
 
 # render markdown (including equations) for quiz_text
 quiz_text <- function(text) {
-  if (inherits(text, "html")) {
-    return(text)
-  }
-  if (is_tags(text)) {
+  if (is_html_chr(text) || is_html_tag(text)) {
     return(text)
   }
   if (!is.null(text)) {
diff --git a/R/staticimports.R b/R/staticimports.R
index 0e8fe252b..04bd7339d 100644
--- a/R/staticimports.R
+++ b/R/staticimports.R
@@ -3,6 +3,22 @@
 # Imported from inst/staticexports/
 # ======================================================================
 
+is_AsIs <- function(x) {
+  inherits(x, "AsIs")
+}
+
+is_html_any <- function(x) {
+  is_html_tag(x) || is_html_chr(x)
+}
+
+is_html_chr <- function(x) {
+  is.character(x) && inherits(x, "html")
+}
+
+is_html_tag <- function(x) {
+  inherits(x, c("shiny.tag", "shiny.tag.list"))
+}
+
 split_code_headers <- function(code, prefix = "section") {
   if (is.null(code)) {
     return(NULL)
diff --git a/R/utils.R b/R/utils.R
index c7ab36339..a8384ad22 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -1,6 +1,8 @@
 # @staticimports inst/staticexports/
 #   split_code_headers
 #   str_trim
+#   is_AsIs
+#   is_html_tag is_html_chr is_html_any
 
 # @staticimports pkg:staticimports
 #   os_name
@@ -101,11 +103,6 @@ str_extract <- function(x, pattern, ...) {
   unlist(regmatches(x, regexpr(pattern, x, ...)))
 }
 
-is_tags <- function(x) {
-  inherits(x, "shiny.tag") ||
-    inherits(x, "shiny.tag.list")
-}
-
 knitr_engine <- function(engine) {
   tolower(engine %||% "r")
 }
diff --git a/inst/staticexports/assertions.R b/inst/staticexports/assertions.R
new file mode 100644
index 000000000..4097320dd
--- /dev/null
+++ b/inst/staticexports/assertions.R
@@ -0,0 +1,15 @@
+is_AsIs <- function(x) {
+  inherits(x, "AsIs")
+}
+
+is_html_tag <- function(x) {
+  inherits(x, c("shiny.tag", "shiny.tag.list"))
+}
+
+is_html_chr <- function(x) {
+  is.character(x) && inherits(x, "html")
+}
+
+is_html_any <- function(x) {
+  is_html_tag(x) || is_html_chr(x)
+}

From 38bd03645102a772713781319e8464733d1b1233 Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 16:18:16 -0500
Subject: [PATCH 13/14] Remove -check chunk from exercise-tests snippet

---
 pkgdown/assets/snippets/exercise-tests.md | 4 ----
 1 file changed, 4 deletions(-)

diff --git a/pkgdown/assets/snippets/exercise-tests.md b/pkgdown/assets/snippets/exercise-tests.md
index 488c96e47..863f317d8 100644
--- a/pkgdown/assets/snippets/exercise-tests.md
+++ b/pkgdown/assets/snippets/exercise-tests.md
@@ -6,10 +6,6 @@
 1 + 1
 ```
 
-```{r addition-check}
-check_this_exercise(user_code, solution_code)
-```
-
 ```{r addition-tests}
 1 + 1
 

From 8ce220ea25cedc035716c8be61b5e70eedc028f9 Mon Sep 17 00:00:00 2001
From: Garrick Aden-Buie <garrick@adenbuie.com>
Date: Wed, 16 Feb 2022 16:30:59 -0500
Subject: [PATCH 14/14] Fix -solution chunks link

---
 vignettes/articles/exercises.Rmd | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/vignettes/articles/exercises.Rmd b/vignettes/articles/exercises.Rmd
index a4d129427..eba38d27a 100644
--- a/vignettes/articles/exercises.Rmd
+++ b/vignettes/articles/exercises.Rmd
@@ -56,7 +56,7 @@ These chunks a linked together
 
 1.  Exercise [`-setup` chunks](#exercise-setup) enable you to execute code to setup the environment immediately prior to executing submitted code.
 
-1.  Exercise [`-solution` chunks](#exercise-solutions) enable you to provide a solution to the exercise that can be optionally viewed by users of the tutorial.
+1.  Exercise [`-solution` chunks](#hints-and-solutions) enable you to provide a solution to the exercise that can be optionally viewed by users of the tutorial.
 
 1.  Exercise [`-hint` chunks](#r-code-hints) are used to provide a series of hints to help the user progress through the exercise.