Merge pull request #18 from ucbds-infra/tfr-points

add support for test file points

R/GradingResults.R

@@ -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"))
     }
   )
 )

R/TestFileResult.R

@@ -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.
@@ -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)
     }
   )
 )

R/check.R

@@ -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) {
@@ -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())) {

R/utils.R

@@ -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))
+}

tests/testthat/test_GradingResults.R

@@ -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")
   )
 })

tests/testthat/test_TestFileResult.R

@@ -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", {
@@ -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))
 })

tests/testthat/test_check.R

@@ -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)
+})