From a54a3ccb01be3e452621a2bd56a3ad4cfc2f53f0 Mon Sep 17 00:00:00 2001 From: gubogaer Date: Mon, 20 Sep 2021 16:35:42 +0200 Subject: [PATCH 1/6] new contextWithParsing function added This function takes a list of named codeblocks containing the testing function(s) per exercise section. To obtain these sections, the student code is being parsed (split on section titles following the pattern "### sectionname ###"). The section name has to match the named codeblock in the testcases list in order to run the testing functions. --- context.R | 82 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ run | 1 + 2 files changed, 83 insertions(+) diff --git a/context.R b/context.R index 3d57f65..66d11f9 100644 --- a/context.R +++ b/context.R @@ -67,6 +67,88 @@ context <- function(testcases={}, preExec={}) { ) } + +contextWithParsing <- function(testcases={}, preExec={}) { + testcases <- substitute(testcases) + + get_reporter()$start_context() + do_exit <- TRUE + on.exit({ + if(do_exit) { + get_reporter()$end_context() + } + }) + + # remove unnamed list items and throw a warning + filtered_testcases <- testcases[!duplicated(names(testcases)) & names(testcases)!=""] + if(length(filtered_testcases) > length(testcases)){ + get_reporter()$add_message("warning: There are duplicate names and/or unamed testcases found. Note that these won't be used for evaluation.") + } + + # parse the student code into a named list linking the parsed codeblock names to codeblocks. + codeblocks <- list() + codeblock_name <- NULL + codeblock <- c() + for(line in read_lines(student_code)){ + match <- str_match(line, "^###\\h*(.+[^\\h])\\h*###")[,2] + if(match %in% names(codeblocks)){ + # duplicate template name + # not sure if i want to add a warning here + } + if(!is.na(match) && match %in% names(filtered_testcases)){ + if(!is.null(codeblock_name)){ + print("codeblock not NULL") + codeblocks[[codeblock_name]] <- codeblock + codeblock <- c() + } + print(paste("codeblock_name changed to ", match)) + codeblock_name <- match + } else { + print("line added") + codeblock <- c(codeblock, line) + } + } + if(!is.null(codeblock_name)){ + print(paste("codeblocks[[", codeblock_name, "]] <- ", codeblock)) + codeblocks[[codeblock_name]] <- codeblock + } + + test_env$clean_env <- new.env(parent = globalenv()) + tryCatch( + withCallingHandlers({ + old_parent <- parent.env(.GlobalEnv) + eval(substitute(preExec), envir = test_env$clean_env) + + # run the codeblock in order and evaluate after each codeblock + for (code_index in 1:length(codeblocks)){ + parent.env(.GlobalEnv) <- starting_parent_env + tryCatch({ + # We don't use source, because otherwise syntax errors leak the location of the student code + test_env$parsed_code <- parse(text = codeblocks[[code_index]]) + capture.output(assign("evaluationResult", eval(test_env$parsed_code, envir = test_env$clean_env), envir = test_env$clean_env)) + + }, finally = { + parent.env(.GlobalEnv) <- old_parent + }) + eval(filtered_testcases[[names(codeblocks[code_index])]]) + } + }, + warning = function(w) { + get_reporter()$add_message(paste("Warning while evaluating context: ", conditionMessage(w), sep = '')) + }, + message = function(m) { + get_reporter()$add_message(paste("Message while evaluating context: ", conditionMessage(m), sep = '')) + }), + error = function(e) { + get_reporter()$add_message(paste("Error while evaluating context: ", conditionMessage(e), sep = '')) + get_reporter()$escalate("compilation error") + get_reporter()$end_context(accepted = FALSE) + do_exit <<- FALSE + } + ) +} + + contextWithRmd <- function(testcases={}, preExec={}) { get_reporter()$start_context() do_exit <- TRUE diff --git a/run b/run index e4eb08f..c1062fb 100755 --- a/run +++ b/run @@ -10,6 +10,7 @@ invisible(evalq({ library('R6') library('rlang') library('purrr') + library('stringr') input <- fromJSON(file('stdin')) source(paste(input$judge, 'judge.R', sep='/'), chdir=TRUE, local=TRUE) From e035ccdd9fc3e4cad5a55649cfde44b2f22d7244 Mon Sep 17 00:00:00 2001 From: gubogaer Date: Mon, 20 Sep 2021 17:07:27 +0200 Subject: [PATCH 2/6] readme updated --- README.md | 31 +++++++++++++++++++++++++++++-- 1 file changed, 29 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 5805218..5be8304 100644 --- a/README.md +++ b/README.md @@ -7,7 +7,7 @@ The test file for a basic exercise can look like this: ```r -context({ +context(testcases = { testcase('The correct method was used', { testEqual("test$alternative", function(studentEnv) { studentEnv$test$alternative }, 'two.sided') testEqual("test$method", function(studentEnv) { studentEnv$test$method }, ' Two Sample t-test') @@ -34,7 +34,10 @@ First of all, something you can't see in the example code above. Dodona groups c ### Contexts -A context represents one execution of the student code. It is generally desirable to have as many contexts as possible, since students can filter by incorrect contexts. The `context` function does a few things: +A context represents one execution of the student code. It is generally desirable to have as many contexts as possible, since students can filter by incorrect contexts. + +#### `context` + The `context` function does a few things: 1. It creates a clean environment based on the global environment. Students have access to the global environment, but don't have access to the testing code or variables used in the testing code (the testing code is executed in a similar environment that is never bound). 2. It executes the code passed through the `preExec` argument in this clean environment. This can be used for setting the seed (as in this example), but also to set variables or define functions that students can then use. *NOTE: the `preExec` argument is not executed in the environment where the tests are run. If you need this, you will need to do this yourself.* @@ -43,8 +46,32 @@ A context represents one execution of the student code. It is generally desirabl Note that the student code is executed once for each call to `context`. Technically, this allows the student to store intermediate results in the global environment. The use of this is limited, so we don't see this as a problem. +#### `contextWithParsing` +The `contextWithParsing` function does the same as context but it allows you to test on intermediate (retuned/printed) results that are not stored in objects. In order to use this function you have to split the student code using "section titles". these are comments with the following pattern: `###[whitespace(s)][section title][whitespace(s)]###`. To define testfunctions per section you can know pass a named list to the `testcases` argument, which links each `section title` with a codeblock containing the testfunctions. + +Here you can find an example: +```r +contextWithParsing(testcases = list( + "section 1" = { + testcase('Question1:', { + testEqual("columnnames", function(studentEnv) {studentEnv$evaluationResult}, c("name1", "name2")) + }) + }, "section 2" = { + testcase('Question2:', { + testEqual("p-value", function(studentEnv) { studentEnv$evaluationResult }, 0.175) + }) + } +), preExec = { + set.seed(20190322) +}) +``` + +> :warning: **This method is new and hasn't been extensively tested yet** . + +#### `contextWithRmd` The `contextWithRmd` function does the same as the `context` function but it expects the student code to be in the R Markdown format. The R chunks are evaluated as before and the markdown text is ignored during evalutaion. +#### `contextWithImage` An extra `contextWithImage` function also exists. This function takes the same arguments, but adds an image to the output if it was generated by the student while their code is executed. By default, this function will make the output wrong if the expected image wasn't generated. This behaviour can be changed by setting the optional `failIfAbsent` parameter to `FALSE`. For introductory exercises students often use R as a calculator and do not store the result of an expression as a variable in their script. For such scripts the eval function that executes the parsed script of the student does not store this result as a variable in the test environment. However, it simply returns the value to the caller. The result of the evaluation is injected into the test environment under the name `evaluationResult`. A simple test using this could look like this: From 5151f34d4ddc683e49c1a756be32ac35b4ea5169 Mon Sep 17 00:00:00 2001 From: gubogaer Date: Mon, 20 Sep 2021 17:34:47 +0200 Subject: [PATCH 3/6] prints removed --- context.R | 4 ---- 1 file changed, 4 deletions(-) diff --git a/context.R b/context.R index 66d11f9..1b2cbfe 100644 --- a/context.R +++ b/context.R @@ -97,19 +97,15 @@ contextWithParsing <- function(testcases={}, preExec={}) { } if(!is.na(match) && match %in% names(filtered_testcases)){ if(!is.null(codeblock_name)){ - print("codeblock not NULL") codeblocks[[codeblock_name]] <- codeblock codeblock <- c() } - print(paste("codeblock_name changed to ", match)) codeblock_name <- match } else { - print("line added") codeblock <- c(codeblock, line) } } if(!is.null(codeblock_name)){ - print(paste("codeblocks[[", codeblock_name, "]] <- ", codeblock)) codeblocks[[codeblock_name]] <- codeblock } From 26fd0405fdb216d13d21019e1037acf64265e4f3 Mon Sep 17 00:00:00 2001 From: Gust Bogaert Date: Fri, 24 Sep 2021 11:57:50 +0200 Subject: [PATCH 4/6] typo's in README.md fixed Co-authored-by: Charlotte Van Petegem --- README.md | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/README.md b/README.md index 5be8304..1d47bcd 100644 --- a/README.md +++ b/README.md @@ -47,7 +47,7 @@ A context represents one execution of the student code. It is generally desirabl Note that the student code is executed once for each call to `context`. Technically, this allows the student to store intermediate results in the global environment. The use of this is limited, so we don't see this as a problem. #### `contextWithParsing` -The `contextWithParsing` function does the same as context but it allows you to test on intermediate (retuned/printed) results that are not stored in objects. In order to use this function you have to split the student code using "section titles". these are comments with the following pattern: `###[whitespace(s)][section title][whitespace(s)]###`. To define testfunctions per section you can know pass a named list to the `testcases` argument, which links each `section title` with a codeblock containing the testfunctions. +The `contextWithParsing` function does the same as `context` but it allows you to test on intermediate (returned/printed) results that are not stored in objects. In order to use this function you have to split the student code using "section titles". these are comments with the following pattern: `###[whitespace(s)][section title][whitespace(s)]###`. To define testfunctions per section you can know pass a named list to the `testcases` argument, which links each `section title` with a codeblock containing the test functions. Here you can find an example: ```r From c18f1d2c732e167736a5cd14a5ea8f6b32e8b745 Mon Sep 17 00:00:00 2001 From: gubogaer Date: Fri, 24 Sep 2021 16:24:00 +0200 Subject: [PATCH 5/6] bugfix avoid tests By removing the section titles in the boilertemplate a student could avoid the test associated with this code section --- context.R | 41 +++++++++++++++++++++++++++++------------ reporter-dodona.R | 4 ++-- 2 files changed, 31 insertions(+), 14 deletions(-) diff --git a/context.R b/context.R index 1b2cbfe..62092f2 100644 --- a/context.R +++ b/context.R @@ -68,8 +68,10 @@ context <- function(testcases={}, preExec={}) { } -contextWithParsing <- function(testcases={}, preExec={}) { - testcases <- substitute(testcases) +contextWithParsing <- function(testcases=list(), preExec={}) { + + # hacky way to make sure the list items are not evaluating yet + testcases <- as.list(substitute(testcases))[-1] get_reporter()$start_context() do_exit <- TRUE @@ -79,10 +81,12 @@ contextWithParsing <- function(testcases={}, preExec={}) { } }) - # remove unnamed list items and throw a warning - filtered_testcases <- testcases[!duplicated(names(testcases)) & names(testcases)!=""] - if(length(filtered_testcases) > length(testcases)){ - get_reporter()$add_message("warning: There are duplicate names and/or unamed testcases found. Note that these won't be used for evaluation.") + if(sum(duplicated(names(testcases)) | names(testcases) == "") > 0) { + get_reporter()$add_message("Error: There are duplicate named testcases and/or unnamed testcases found.", permission = "staff") + get_reporter()$escalate("internal error") + get_reporter()$end_context(accepted = FALSE) + do_exit <<- FALSE + return() } # parse the student code into a named list linking the parsed codeblock names to codeblocks. @@ -92,10 +96,10 @@ contextWithParsing <- function(testcases={}, preExec={}) { for(line in read_lines(student_code)){ match <- str_match(line, "^###\\h*(.+[^\\h])\\h*###")[,2] if(match %in% names(codeblocks)){ - # duplicate template name - # not sure if i want to add a warning here + get_reporter()$add_message(paste0("Warning: There are duplicate section title(s) found in the code.", + "This means the same test will be repeated for all sections with the same title.")) } - if(!is.na(match) && match %in% names(filtered_testcases)){ + if(!is.na(match) && match %in% names(testcases)){ if(!is.null(codeblock_name)){ codeblocks[[codeblock_name]] <- codeblock codeblock <- c() @@ -108,7 +112,20 @@ contextWithParsing <- function(testcases={}, preExec={}) { if(!is.null(codeblock_name)){ codeblocks[[codeblock_name]] <- codeblock } - + + # throw parsing error when section titles are missing in the student code to avoid students skipping tests + missing_sections <- setdiff(names(testcases), names(codeblocks)) + if(length(missing_sections) > 0) { + get_reporter()$add_message( + paste0("Parsing error: could not find rhe following section title(s): \r\n", + paste(sapply(missing_sections, function(x){paste("###", x, "###")}), collapse = ',\r\n')) + ) + get_reporter()$escalate("compilation error") + get_reporter()$end_context(accepted = FALSE) + do_exit <<- FALSE + return() + } + test_env$clean_env <- new.env(parent = globalenv()) tryCatch( withCallingHandlers({ @@ -116,7 +133,7 @@ contextWithParsing <- function(testcases={}, preExec={}) { eval(substitute(preExec), envir = test_env$clean_env) # run the codeblock in order and evaluate after each codeblock - for (code_index in 1:length(codeblocks)){ + for (code_index in seq_along(codeblocks)){ parent.env(.GlobalEnv) <- starting_parent_env tryCatch({ # We don't use source, because otherwise syntax errors leak the location of the student code @@ -126,7 +143,7 @@ contextWithParsing <- function(testcases={}, preExec={}) { }, finally = { parent.env(.GlobalEnv) <- old_parent }) - eval(filtered_testcases[[names(codeblocks[code_index])]]) + eval(testcases[[names(codeblocks[code_index])]]) } }, warning = function(w) { diff --git a/reporter-dodona.R b/reporter-dodona.R index 25d8a58..9c83f94 100644 --- a/reporter-dodona.R +++ b/reporter-dodona.R @@ -48,8 +48,8 @@ DodonaReporter <- R6::R6Class("DodonaReporter", write('{"command": "close-judgement"}', stdout()) }, - add_message = function(message, type="plain") { - write(paste('{"command": "append-message", "message": { "description": ', toJSON(toString(message), auto_unbox=TRUE), ', "format": ', toJSON(type, auto_unbox=TRUE), '} }', sep=''), stdout()) + add_message = function(message, type = "plain", permission = "student") { + write(paste('{"command": "append-message", "message": { "description": ', toJSON(toString(message), auto_unbox=TRUE), ', "format": ', toJSON(type, auto_unbox=TRUE), ', "permission": "', permission, '"} }', sep=''), stdout()) }, escalate = function(status) { From d9c0bf80e61a5f81d78efc7f9030c92155e94fee Mon Sep 17 00:00:00 2001 From: gubogaer Date: Fri, 24 Sep 2021 16:28:16 +0200 Subject: [PATCH 6/6] style fixes --- context.R | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/context.R b/context.R index 62092f2..6db20c5 100644 --- a/context.R +++ b/context.R @@ -76,12 +76,12 @@ contextWithParsing <- function(testcases=list(), preExec={}) { get_reporter()$start_context() do_exit <- TRUE on.exit({ - if(do_exit) { + if (do_exit) { get_reporter()$end_context() } }) - if(sum(duplicated(names(testcases)) | names(testcases) == "") > 0) { + if (sum(duplicated(names(testcases)) | names(testcases) == "") > 0) { get_reporter()$add_message("Error: There are duplicate named testcases and/or unnamed testcases found.", permission = "staff") get_reporter()$escalate("internal error") get_reporter()$end_context(accepted = FALSE) @@ -93,14 +93,14 @@ contextWithParsing <- function(testcases=list(), preExec={}) { codeblocks <- list() codeblock_name <- NULL codeblock <- c() - for(line in read_lines(student_code)){ + for (line in read_lines(student_code)) { match <- str_match(line, "^###\\h*(.+[^\\h])\\h*###")[,2] - if(match %in% names(codeblocks)){ + if (match %in% names(codeblocks)) { get_reporter()$add_message(paste0("Warning: There are duplicate section title(s) found in the code.", "This means the same test will be repeated for all sections with the same title.")) } - if(!is.na(match) && match %in% names(testcases)){ - if(!is.null(codeblock_name)){ + if (!is.na(match) && match %in% names(testcases)) { + if (!is.null(codeblock_name)) { codeblocks[[codeblock_name]] <- codeblock codeblock <- c() } @@ -109,16 +109,16 @@ contextWithParsing <- function(testcases=list(), preExec={}) { codeblock <- c(codeblock, line) } } - if(!is.null(codeblock_name)){ + if (!is.null(codeblock_name)) { codeblocks[[codeblock_name]] <- codeblock } # throw parsing error when section titles are missing in the student code to avoid students skipping tests missing_sections <- setdiff(names(testcases), names(codeblocks)) - if(length(missing_sections) > 0) { + if (length(missing_sections) > 0) { get_reporter()$add_message( paste0("Parsing error: could not find rhe following section title(s): \r\n", - paste(sapply(missing_sections, function(x){paste("###", x, "###")}), collapse = ',\r\n')) + paste(sapply(missing_sections, function(x) {paste("###", x, "###")}), collapse = ',\r\n')) ) get_reporter()$escalate("compilation error") get_reporter()$end_context(accepted = FALSE) @@ -133,7 +133,7 @@ contextWithParsing <- function(testcases=list(), preExec={}) { eval(substitute(preExec), envir = test_env$clean_env) # run the codeblock in order and evaluate after each codeblock - for (code_index in seq_along(codeblocks)){ + for (code_index in seq_along(codeblocks)) { parent.env(.GlobalEnv) <- starting_parent_env tryCatch({ # We don't use source, because otherwise syntax errors leak the location of the student code