diff --git a/R/reporter-list.R b/R/reporter-list.R index f02214a0d..4f73e9e7f 100644 --- a/R/reporter-list.R +++ b/R/reporter-list.R @@ -11,50 +11,52 @@ ListReporter <- R6::R6Class( "ListReporter", inherit = Reporter, public = list( - current_start_time = NA, - current_expectations = NULL, - current_file = NULL, - current_context = NULL, - current_test = NULL, + running = NULL, + current_file = "", # so we can still subset with this results = NULL, initialize = function() { super$initialize() self$capabilities$parallel_support <- TRUE + self$capabilities$parallel_updates <- TRUE self$results <- Stack$new() + self$running <- new.env(parent = emptyenv()) }, start_test = function(context, test) { + # is this a new test block? if ( - !identical(self$current_context, context) || - !identical(self$current_test, test) + !identical(self$running[[self$current_file]]$context, context) || + !identical(self$running[[self$current_file]]$test, test) ) { - self$current_context <- context - self$current_test <- test - self$current_expectations <- Stack$new() - self$current_start_time <- proc.time() + self$running[[self$current_file]]$context <- context + self$running[[self$current_file]]$test <- test + self$running[[self$current_file]]$expectations <- Stack$new() + self$running[[self$current_file]]$start_time <- proc.time() } }, add_result = function(context, test, result) { - if (is.null(self$current_expectations)) { + if (is.null(self$running[[self$current_file]]$expectations)) { # we received a result outside of a test: # could be a bare expectation or an exception/error if (!inherits(result, 'error')) { return() } - self$current_expectations <- Stack$new() + self$running[[self$current_file]]$expectations <- Stack$new() } - self$current_expectations$push(result) + self$running[[self$current_file]]$expectations$push(result) }, end_test = function(context, test) { - elapsed <- as.double(proc.time() - self$current_start_time) + elapsed <- as.double( + proc.time() - self$running[[self$current_file]]$start_time + ) results <- list() - if (!is.null(self$current_expectations)) { - results <- self$current_expectations$as_list() + if (!is.null(self$running[[self$current_file]]$expectations)) { + results <- self$running[[self$current_file]]$expectations$as_list() } self$results$push(list( @@ -67,28 +69,39 @@ ListReporter <- R6::R6Class( results = results )) - self$current_expectations <- NULL + self$running[[self$current_file]]$expectations <- NULL }, start_file = function(name) { + if (!name %in% names(self$running)) { + newfile <- list( + start_time = NA, + expectations = NULL, + context = NULL, + test = NULL + ) + assign(name, newfile, envir = self$running) + } self$current_file <- name }, end_file = function() { # fallback in case we have errors but no expectations self$end_context(self$current_file) + rm(list = self$current_file, envir = self$running) }, end_context = function(context) { - results <- self$current_expectations + results <- self$running[[self$current_file]]$expectations if (is.null(results)) { return() } - self$current_expectations <- NULL + self$running[[self$current_file]]$expectations <- NULL # look for exceptions raised outside of tests - # they happened just before end_context since they interrupt the test_file execution + # they happened just before end_context since they interrupt the test_ + # file execution results <- results$as_list() if (length(results) == 0) { return() diff --git a/tests/testthat/_snaps/reporter-list.md b/tests/testthat/_snaps/reporter-list.md new file mode 100644 index 000000000..c3fea3cac --- /dev/null +++ b/tests/testthat/_snaps/reporter-list.md @@ -0,0 +1,10 @@ +# works in parallel + + Code + results[, c(1:8, 12:13)] + Output + file context test nb failed skipped error warning passed result + 1 f1 t11 2 0 FALSE FALSE 0 2 msg111, msg112 + 2 f2 t21 2 0 FALSE FALSE 0 2 msg211, msg212 + 3 f2 t22 1 0 TRUE FALSE 0 0 skip221 + diff --git a/tests/testthat/test-reporter-list.R b/tests/testthat/test-reporter-list.R index 0c22d0dfa..15ec15586 100644 --- a/tests/testthat/test-reporter-list.R +++ b/tests/testthat/test-reporter-list.R @@ -70,3 +70,45 @@ test_that("ListReporter and bare expectations", { # 2 tests, "before" and "after". no result for the bare expectation expect_identical(df$test, c("before", "after")) }) + +test_that("works in parallel", { + lr <- ListReporter$new() + + lr$start_file("f1") + lr$start_test(NULL, "t11") + lr$add_result(NULL, "t11", new_expectation("success", "msg111")) + + lr$start_file("f2") + lr$start_test(NULL, "t21") + lr$add_result(NULL, "t21", new_expectation("success", "msg211")) + + lr$start_file("f1") + lr$start_test(NULL, "t11") + lr$add_result(NULL, "t11", new_expectation("success", "msg112")) + lr$end_test(NULL, "t11") + + lr$start_file("f2") + lr$start_test(NULL, "t21") + lr$add_result(NULL, "t21", new_expectation("success", "msg212")) + lr$end_test(NULL, "t21") + + lr$start_file("f2") + lr$start_test(NULL, "t22") + lr$add_result(NULL, "t22", new_expectation("skip", "skip221")) + lr$end_test(NULL, "t22") + + lr$start_file("f2") + lr$end_file() + + lr$start_file("f1") + lr$end_file() + + results <- as.data.frame(lr$get_results()) + expect_snapshot({ + results[, c(1:8, 12:13)] + }) + + expect_true(all(!is.na(results$user))) + expect_true(all(!is.na(results$system))) + expect_true(all(!is.na(results$real))) +})