No longer split -tests chunk into individual cases

NEWS.md

@@ -60,7 +60,7 @@
 
 -   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).
+-   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, #700).
 
 -   Keyboard navigation and keyboard shortcuts for the interactive exercise code editor have been improved:
 

R/knitr-hooks.R

@@ -366,7 +366,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, "-tests"))
+        tests <- get_knitr_chunk(paste0(options$label, "-tests"))
 
         # remove class of "knitr_strict_list" so (de)serializing works properly for external evaluators
         class(options) <- NULL
@@ -381,7 +381,7 @@ tutorial_knitr_options <- function() {
           )
         }
 
-        exercise_cache <- structure(
+        this_exercise <- structure(
           list(
             label = options[["label"]],
             global_setup = get_setup_global_exercise(),
@@ -391,9 +391,11 @@ tutorial_knitr_options <- function() {
             error_check = error_check_chunk,
             check = check_chunk,
             solution  = solution,
-            test_cases = split_code_headers(test_cases, "test"),
+            tests = tests,
             options = options[setdiff(names(options), "tutorial")],
-            engine = options$engine
+            engine = options$engine,
+            label = options$label,
+            version = current_exercise_version
           ),
           class = "tutorial_exercise"
         )
@@ -403,7 +405,7 @@ tutorial_knitr_options <- function() {
           'server',
           sprintf(
             'learnr:::store_exercise_cache(%s)',
-            dput_to_string(exercise_cache)
+            dput_to_string(this_exercise)
           )
         )
 

R/mock_exercise.R

@@ -110,7 +110,7 @@ mock_exercise <- function(
     code_check = code_check,
     error_check = error_check,
     check = check,
-    tests = split_code_headers(tests, "test"),
+    tests = tests,
     options = utils::modifyList(default_options, list(...)),
     engine = engine,
     version = version

R/staticimports.R

@@ -55,53 +55,6 @@ knitr_engine_caption <- function(engine = NULL) {
   )
 }
 
-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*(#+)([ -]*)(.+?)?\\s*----+\\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)) {
-    # nothing after last heading
-    lines_headers <- lines_headers[-length(lines_headers)]
-  }
-
-  if (!length(lines_headers)) {
-    return(list(paste(code, collapse = "\n")))
-  }
-
-  # 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(
-      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)

R/utils.R

@@ -1,5 +1,4 @@
 # @staticimports inst/staticexports/
-#   split_code_headers
 #   str_trim
 #   is_AsIs
 #   is_html_tag is_html_chr is_html_any

tests/testthat/test-mock_exercise.R

@@ -25,44 +25,6 @@ test_that("exercise mocks: mock_prep_setup()", {
   expect_error(mock_prep_setup(chunks[c(1, 1)], "setup-1"), "Duplicated")
 })
 
-test_that("mock_exercise() creates tests with splits", {
-  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", tests = code)
-  expect_equal(
-    ex$tests,
-    list(
-      test00 = "1 + 1",
-      "one plus two" = "1 + 2",
-      "one plus three" = "1 + 3",
-      "one equals three" = "1 = 3",
-      "2 minus one" = "2 - 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() tests, bad split", {
-  code <- '   ## one\npi'
-  expect_equal(mock_exercise("1 + 1", tests = code)$tests, list(code))
-})
-
 test_that("mock_exercise() moves exercise chunk options to default options", {
   ex <- mock_exercise(
     chunks = list(

tests/testthat/test-tutorial-state.R

@@ -37,8 +37,7 @@ test_that("tutorial_cache_works", {
 
     if (inherits(item, "tutorial_exercise")) {
       # these items are added by app or by `get_tutorial_info()`
-      item <- item[setdiff(names(item), c("code", "version"))]
-      class(item) <- "tutorial_exercise"
+      item[["code"]] <- NULL
     }
     expect_equal(item, all[[label]])
   }