Skip to content

Commit

Permalink
add support for test file points
Browse files Browse the repository at this point in the history
  • Loading branch information
chrispyles committed Dec 10, 2022
1 parent f559def commit 79e294f
Show file tree
Hide file tree
Showing 10 changed files with 98 additions and 11 deletions.
2 changes: 1 addition & 1 deletion R/GradingResults.R
Original file line number Diff line number Diff line change
Expand Up @@ -46,7 +46,7 @@ GradingResults <- R6::R6Class(
#'
#' @return The JSON string
to_json = function() {
return(jsonlite::toJSON(self$to_list(), auto_unbox = TRUE, pretty = TRUE))
return(jsonlite::toJSON(self$to_list(), auto_unbox = TRUE, pretty = TRUE, null = "null"))
}
)
)
16 changes: 13 additions & 3 deletions R/TestFileResult.R
Original file line number Diff line number Diff line change
Expand Up @@ -4,19 +4,23 @@
#'
#' @field test_case_results The [TestCaseResult] objects that make up this test file
#' @field filename The name of the test file
#' @field points The point value of the test file or a list of test case point values
TestFileResult <- R6::R6Class(
"TestFileResult",
public = list(
test_case_results = NA,
filename = NA,
points = NA,

#' @description Create a test file result.
#'
#' @param filename The name of the test file
#' @param test_case_results The [TestCaseResult] objects that make up this test file
initialize = function(filename, test_case_results) {
#' @param points The point value of the test file or a list of test case point values
initialize = function(filename, test_case_results, points = NULL) {
self$filename <- filename
self$test_case_results <- test_case_results
self$points <- points
},

#' @description Get the basename of the file this result corresponds to.
Expand Down Expand Up @@ -78,10 +82,16 @@ TestFileResult <- R6::R6Class(
tcr_lists[[i]] = self$test_case_results[[i]]$to_list()
}

return(list(
ret <- list(
filename = self$filename,
test_case_results = tcr_lists
))
)

if (!nullish(self$points)) {
ret$points <- self$points
}

return(ret)
}
)
)
6 changes: 4 additions & 2 deletions R/check.R
Original file line number Diff line number Diff line change
Expand Up @@ -32,12 +32,14 @@ check <- function(test_file, test_env, show_results) {

eval("options(testthat.use_colours = FALSE)", test_env)

test_suite <- list()
test_case_results <- c()

# redirect stdout so that testthat doesn't print
testthat::capture_output({
# read the test cases from the test file
test_cases <- load_test_cases(test_file)$cases
test_suite <- load_test_cases(test_file)
test_cases <- test_suite$cases

# run the tests
for (tc in test_cases) {
Expand All @@ -46,7 +48,7 @@ check <- function(test_file, test_env, show_results) {
}
})

file_result <- TestFileResult$new(test_file, test_case_results)
file_result <- TestFileResult$new(test_file, test_case_results, test_suite$points)

# collect the result if needed
if (!is.null(get_collector())) {
Expand Down
9 changes: 9 additions & 0 deletions R/utils.R
Original file line number Diff line number Diff line change
Expand Up @@ -58,3 +58,12 @@ valid_syntax <- function(script) {
)
return(!error)
}

#' Check whether a value is nullish (i.e. NULL or NA)
#'
#' @param x The value to cehck
#'
#' @return Whether the value is nullish
nullish <- function(x) {
return(is.null(x) || is.na(x))
}
6 changes: 5 additions & 1 deletion man/TestFileResult.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

6 changes: 3 additions & 3 deletions man/export.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

17 changes: 17 additions & 0 deletions man/nullish.Rd

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

2 changes: 1 addition & 1 deletion tests/testthat/test_GradingResults.R
Original file line number Diff line number Diff line change
Expand Up @@ -21,6 +21,6 @@ test_that("$to_json() returns the grading results as JSON", {

expect_equal(
gr$to_json(),
jsonlite::toJSON(make_test_file_results_list(), auto_unbox = TRUE, pretty = TRUE)
jsonlite::toJSON(make_test_file_results_list(), auto_unbox = TRUE, pretty = TRUE, null = "null")
)
})
24 changes: 24 additions & 0 deletions tests/testthat/test_TestFileResult.R
Original file line number Diff line number Diff line change
Expand Up @@ -17,6 +17,12 @@ test_that("$new() initializes fields correctly", {

expect_equal(tfr$filename, filename)
expect_equal(tfr$test_case_results, tcrs)

tfr <- TestFileResult$new(filename, tcrs, 2)

expect_equal(tfr$filename, filename)
expect_equal(tfr$test_case_results, tcrs)
expect_equal(tfr$points, 2)
})

test_that("$get_basename() returns the basename of the test file", {
Expand Down Expand Up @@ -79,4 +85,22 @@ test_that("$to_list() returns the test file results as a list", {
expect_equal(length(tfr_list), 2)
expect_equal(tfr_list$filename, filename)
expect_equal(tfr_list$test_case_results, lapply(tcrs, function(tcr) tcr$to_list()))

tfr <- TestFileResult$new(filename, tcrs, 2)
tfr_list <- tfr$to_list()

expect_true(is.list(tfr_list))
expect_equal(length(tfr_list), 3)
expect_equal(tfr_list$filename, filename)
expect_equal(tfr_list$test_case_results, lapply(tcrs, function(tcr) tcr$to_list()))
expect_equal(tfr_list$points, 2)

tfr <- TestFileResult$new(filename, tcrs, c(1, 1, 1))
tfr_list <- tfr$to_list()

expect_true(is.list(tfr_list))
expect_equal(length(tfr_list), 3)
expect_equal(tfr_list$filename, filename)
expect_equal(tfr_list$test_case_results, lapply(tcrs, function(tcr) tcr$to_list()))
expect_equal(tfr_list$points, c(1, 1, 1))
})
21 changes: 21 additions & 0 deletions tests/testthat/test_check.R
Original file line number Diff line number Diff line change
Expand Up @@ -33,3 +33,24 @@ test_that("runs a test against the student's environment and returns a TestFileR
# check that it errors if no test file is provided
expect_error(check(), regexp = "must have a test file")
})


test_that("correctly includes the test file point value in the TestFileR", {
test_env <- new.env()
mock_parent.frame <- mock(test_env, cycle = TRUE)
stub(check, "parent.frame", mock_parent.frame)

mock_cat <- mock()
stub(check, "cat", mock_cat)

mock_load_test_cases <- mock(list(
cases = list(ottr::TestCase$new(name = "q1")),
points = 1
), cycle = TRUE)
stub(check, "load_test_cases", mock_load_test_cases)
test_file_path <- "tests/q1.r"

results <- check(test_file_path)

expect_equal(results$points, 1)
})

0 comments on commit 79e294f

Please sign in to comment.