From 46061136794f7947ab1e58a72ebf7255e1a5d151 Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Wed, 25 May 2022 16:26:53 -0400 Subject: [PATCH 1/5] No longer split `-tests` chunk into individual cases * Remove `split_code_headers()` (moved to gradethis) --- R/mock_exercise.R | 2 +- R/staticimports.R | 47 ------------------------- R/utils.R | 1 - inst/staticexports/split_code_headers.R | 46 ------------------------ tests/testthat/test-mock_exercise.R | 38 -------------------- tests/testthat/test-staticimports.R | 37 ------------------- 6 files changed, 1 insertion(+), 170 deletions(-) delete mode 100644 inst/staticexports/split_code_headers.R delete mode 100644 tests/testthat/test-staticimports.R diff --git a/R/mock_exercise.R b/R/mock_exercise.R index f5369d462..4ba108922 100644 --- a/R/mock_exercise.R +++ b/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 diff --git a/R/staticimports.R b/R/staticimports.R index e4bbf602e..fe27b47b1 100644 --- a/R/staticimports.R +++ b/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) diff --git a/R/utils.R b/R/utils.R index a8384ad22..5333cee31 100644 --- a/R/utils.R +++ b/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 diff --git a/inst/staticexports/split_code_headers.R b/inst/staticexports/split_code_headers.R deleted file mode 100644 index 06fe73ab4..000000000 --- a/inst/staticexports/split_code_headers.R +++ /dev/null @@ -1,46 +0,0 @@ -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*$" - 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) -} diff --git a/tests/testthat/test-mock_exercise.R b/tests/testthat/test-mock_exercise.R index 3564fb5bc..1293a3cf4 100644 --- a/tests/testthat/test-mock_exercise.R +++ b/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( diff --git a/tests/testthat/test-staticimports.R b/tests/testthat/test-staticimports.R deleted file mode 100644 index 38aa707d8..000000000 --- a/tests/testthat/test-staticimports.R +++ /dev/null @@ -1,37 +0,0 @@ -test_that("split_code_headers()", { - target <- list(one = "1", two = "2") - - # No whitespace after dashes - expect_equal( - split_code_headers( -"# one ---- -1 -# two ---- -2" - ), - target - ) - - - # Whitespace after first header - expect_equal( - split_code_headers( -"# one ---- -1 -# two ---- -2" - ), - target - ) - - # Whitespace after subsequent headers - expect_equal( - split_code_headers( -"# one ---- -1 -# two ---- -2" - ), - target -) -}) From 35f811610a9c6ea93688a1081c96fd2d170c308e Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Fri, 4 Mar 2022 17:51:22 -0500 Subject: [PATCH 2/5] exercise$test_cases -> $tests --- R/knitr-hooks.R | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/R/knitr-hooks.R b/R/knitr-hooks.R index 1432565e3..162ea6b25 100644 --- a/R/knitr-hooks.R +++ b/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 = split_code_headers(tests, "test"), 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) ) ) From 871cd6a4f9356d864af387c07375c34c61e3794e Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Tue, 14 Jun 2022 15:22:14 -0400 Subject: [PATCH 3/5] fix: just pass `tests` to `$tests` --- 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 162ea6b25..7162bffb1 100644 --- a/R/knitr-hooks.R +++ b/R/knitr-hooks.R @@ -391,7 +391,7 @@ tutorial_knitr_options <- function() { error_check = error_check_chunk, check = check_chunk, solution = solution, - tests = split_code_headers(tests, "test"), + tests = tests, options = options[setdiff(names(options), "tutorial")], engine = options$engine, label = options$label, From a3a0ca839c795e0056500a3b45d47755fcf77d4e Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Tue, 14 Jun 2022 15:30:28 -0400 Subject: [PATCH 4/5] tests: fix comparison of exercise item --- tests/testthat/test-tutorial-state.R | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/testthat/test-tutorial-state.R b/tests/testthat/test-tutorial-state.R index 043d75445..58b1e7965 100644 --- a/tests/testthat/test-tutorial-state.R +++ b/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]]) } From 64071de3f7658d12f22d0e5959e5c9d3c5bc28ba Mon Sep 17 00:00:00 2001 From: Garrick Aden-Buie Date: Tue, 14 Jun 2022 16:10:39 -0400 Subject: [PATCH 5/5] docs: Update news to include #700 --- NEWS.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/NEWS.md b/NEWS.md index fc1254f05..86439b9bd 100644 --- a/NEWS.md +++ b/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: