Reduce duplication in parallel tests

Author: hadley

tests/testthat/helper.R

@@ -0,0 +1,20 @@
+local_parallel_test_config <- function(frame = caller_env()) {
+  skip_on_covr()
+  withr::local_envvar(
+    c(
+      TESTTHAT_PARALLEL = "TRUE",
+      TESTTHAT_GHA_SUMMARY = "FALSE"
+    ),
+    .local_envir = frame
+  )
+}
+
+capture_parallel_error <- function(path) {
+  tryCatch(
+    capture.output(suppressMessages(testthat::test_local(
+      path,
+      reporter = "summary"
+    ))),
+    error = function(e) e
+  )
+}

tests/testthat/test-parallel-crash.R

@@ -1,13 +1,8 @@
 test_that("crash", {
+  local_parallel_test_config()
   skip_on_cran()
-  skip_on_covr()
   skip_if_not(getRversion() >= "4.4.0")
 
-  withr::local_envvar(c(
-    TESTTHAT_PARALLEL = "TRUE",
-    TESTTHAT_GHA_SUMMARY = "FALSE"
-  ))
-
   pkg <- test_path("test-parallel", "crash")
   err <- callr::r(
     function() {

tests/testthat/test-parallel-errors.R

@@ -1,13 +1,7 @@
 test_that("error in parallel setup code", {
-  skip_on_covr()
-  withr::local_envvar(TESTTHAT_PARALLEL = "TRUE")
-  err <- tryCatch(
-    capture.output(suppressMessages(testthat::test_local(
-      test_path("test-parallel", "syntax-error"),
-      reporter = "summary"
-    ))),
-    error = function(e) e
-  )
+  local_parallel_test_config()
+
+  err <- capture_parallel_error(test_path("test-parallel", "syntax-error"))
   expect_s3_class(err, "testthat_process_error")
   # contains test file's name
   expect_match(conditionMessage(err), "test-error-1.R")

tests/testthat/test-parallel-outside.R

@@ -1,16 +1,6 @@
 test_that("error outside of test_that()", {
-  skip_on_covr()
-  withr::local_envvar(c(
-    TESTTHAT_PARALLEL = "TRUE",
-    TESTTHAT_GHA_SUMMARY = "FALSE"
-  ))
-  err <- tryCatch(
-    capture.output(suppressMessages(testthat::test_local(
-      test_path("test-parallel", "outside"),
-      reporter = "summary"
-    ))),
-    error = function(e) e
-  )
+  local_parallel_test_config()
 
+  err <- capture_parallel_error(test_path("test-parallel", "outside"))
   expect_match(err$message, "Test failures")
 })

tests/testthat/test-parallel-setup.R

@@ -1,16 +1,7 @@
 test_that("error in parallel setup code", {
-  skip_on_covr()
-  withr::local_envvar(c(
-    TESTTHAT_PARALLEL = "TRUE",
-    TESTTHAT_GHA_SUMMARY = "FALSE"
-  ))
-  err <- tryCatch(
-    capture.output(suppressMessages(testthat::test_local(
-      test_path("test-parallel", "setup"),
-      reporter = "summary"
-    ))),
-    error = function(e) e
-  )
+  local_parallel_test_config()
+
+  err <- capture_parallel_error(test_path("test-parallel", "setup"))
   expect_s3_class(err, "testthat_process_error")
   expect_match(conditionMessage(err), "Error in setup", fixed = TRUE)
 })

tests/testthat/test-parallel-startup.R

@@ -1,16 +1,7 @@
 test_that("startup error", {
-  skip_on_covr()
-  withr::local_envvar(c(
-    TESTTHAT_PARALLEL = "TRUE",
-    TESTTHAT_GHA_SUMMARY = "FALSE"
-  ))
-  err <- tryCatch(
-    capture.output(suppressMessages(testthat::test_local(
-      test_path("test-parallel", "startup"),
-      reporter = "summary"
-    ))),
-    error = function(e) e
-  )
+  local_parallel_test_config()
+
+  err <- capture_parallel_error(test_path("test-parallel", "startup"))
   expect_s3_class(err, "testthat_process_error")
   expect_match(conditionMessage(err), "This will fail", fixed = TRUE)
 })

tests/testthat/test-parallel-stdout.R

@@ -1,6 +1,5 @@
 test_that("stdout/stderr in parallel code", {
-  skip_on_covr()
-  withr::local_envvar(TESTTHAT_PARALLEL = "TRUE")
+  local_parallel_test_config()
 
   assemble_msgs <- function(txt, test_name) {
     prefix <- paste0("> ", test_name, ": ")

tests/testthat/test-parallel-teardown.R

@@ -1,17 +1,8 @@
 test_that("teardown error", {
   skip("teardown errors are ignored")
-  skip_on_covr()
-  withr::local_envvar(c(
-    TESTTHAT_PARALLEL = "TRUE",
-    TESTTHAT_GHA_SUMMARY = "FALSE"
-  ))
-  err <- tryCatch(
-    capture.output(suppressMessages(testthat::test_local(
-      test_path("test-parallel", "teardown"),
-      reporter = "summary"
-    ))),
-    error = function(e) e
-  )
+  local_parallel_test_config()
+
+  err <- capture_parallel_error(test_path("test-parallel", "teardown"))
   expect_s3_class(err, "testthat_process_error")
   expect_match(err$message, "Error in teardown", fixed = TRUE)
 })