Fix the lister when running in parallel (#2233)

It was not prepared for receiving updates from multiple files concurrently and some results were lost.

Author: gaborcsardi

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

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
+

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