PoC of markdown summary on GHA

Author: gaborcsardi

R/gha-summary.R

@@ -0,0 +1,80 @@
+
+create_gha_summary <- function(results) {
+  nope <- c("false", "no", "off", "n", "0", "nope", "nay")
+  if (tolower(Sys.getenv("TESTTHAT_GHA_SUMMARY")) %in% nope) {
+    return()
+  }
+  if ((out <- Sys.getenv("GITHUB_STEP_SUMMARY")) == "") {
+    return()
+  }
+
+  p <- function(...) cat(..., file = out, append = TRUE)
+
+  # header
+  p("# Test results\n\n")
+  p("| FAIL | WARN | SKIP | PASS | Context | Test | Time |\n")
+  p("|-----:|-----:|-----:|-----:|:--------|:-----|:-----|\n")
+
+  # one line per test
+  per_test <- lapply(results, gha_file_summary, p = p)
+
+  # totals
+  totals <- lapply(do.call(rbind, per_test), sum)
+  p(paste0(
+    "|", totals$fail,
+    "|", totals$warn,
+    "|", totals$skip,
+    "|", totals$ok,
+    "|", "Total",
+    "|", "",
+    "|", sprintf("%.3f s", totals$time),
+    "|\n"
+  ))
+
+  invisible(results)
+}
+
+gha_file_summary <- function(result, p) {
+
+  n_fail <- n_skip <- n_warn <- n_ok <- 0L
+  for (exp in result$results) {
+    if (expectation_broken(exp)) {
+      n_fail <- n_fail + 1L
+    } else if (expectation_skip(exp)) {
+      n_skip <- n_skip + 1L
+    } else if (expectation_warning(exp)) {
+      n_warn <- n_warn + 1L
+    } else {
+      n_ok <- n_ok + 1L
+    }
+  }
+
+  ctx <- context_name(result$file)
+  time <- sprintf("%.3f s", result$real)
+
+  escape <- function(x) {
+    x <- gsub("|", "\\|", x, fixed = TRUE)
+    x <- gsub("\n", " ", x, fixed = TRUE)
+    x
+  }
+
+  p(paste0(
+    "|", n_fail,
+    "|", n_warn,
+    "|", n_skip,
+    "|", n_ok,
+    "|", escape(ctx),
+    "|", escape(result$test),
+    "|", time,
+    "|\n"
+  ))
+
+  data.frame(
+    stringsAsFactors = FALSE,
+    fail = n_fail,
+    skip = n_skip,
+    warn = n_warn,
+    ok = n_ok,
+    time = result$real
+  )
+}

R/parallel.R

@@ -79,6 +79,8 @@ test_files_parallel <- function(
     }
   })
 
+  create_gha_summary(reporters$list$get_results())
+
   test_files_check(reporters$list$get_results(),
     stop_on_failure = stop_on_failure,
     stop_on_warning = stop_on_warning

R/test-files.R

@@ -204,6 +204,8 @@ test_files_serial <- function(test_dir,
     lapply(test_paths, test_one_file, env = env, wrap = wrap)
   )
 
+  create_gha_summary(reporters$list$get_results())
+
   test_files_check(reporters$list$get_results(),
     stop_on_failure = stop_on_failure,
     stop_on_warning = stop_on_warning

tests/testthat/test-parallel-crash.R

@@ -4,7 +4,10 @@ test_that("crash", {
 
   skip_on_cran()
   skip_on_covr()
-  withr::local_envvar(TESTTHAT_PARALLEL = "TRUE")
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
 
   do <- function() {
     err <- NULL

tests/testthat/test-parallel-outside.R

@@ -1,6 +1,9 @@
 
 test_that("error outside of test_that()", {
-  withr::local_envvar(TESTTHAT_PARALLEL = "TRUE")
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
   err <- tryCatch(
     suppressMessages(testthat::test_local(
       test_path("test-parallel", "outside"),

tests/testthat/test-parallel-setup.R

@@ -1,7 +1,10 @@
 
 test_that("error in parallel setup code", {
   skip_on_covr()
-  withr::local_envvar(TESTTHAT_PARALLEL = "TRUE")
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
   err <- tryCatch(
     suppressMessages(testthat::test_local(
       test_path("test-parallel", "setup"),

tests/testthat/test-parallel-startup.R

@@ -1,7 +1,10 @@
 
 test_that("startup error", {
   skip_on_covr()
-  withr::local_envvar(TESTTHAT_PARALLEL = "TRUE")
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
   err <- tryCatch(
     suppressMessages(testthat::test_local(
       test_path("test-parallel", "startup"),

tests/testthat/test-parallel-teardown.R

@@ -1,7 +1,10 @@
 
 test_that("teardown error", {
   skip("teardown errors are ignored")
-  withr::local_envvar(TESTTHAT_PARALLEL = "TRUE")
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
   err <- tryCatch(
     suppressMessages(testthat::test_local(
       test_path("test-parallel", "teardown"),

tests/testthat/test-parallel.R

@@ -23,7 +23,10 @@ test_that("detect number of cpus to use", {
 })
 
 test_that("ok", {
-  withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE"))
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
   suppressMessages(ret <- test_local(
     test_path("test-parallel", "ok"),
     reporter = "silent",

tests/testthat/test-reporter-list.R

@@ -1,6 +1,7 @@
 
 # regression test: test_file() used to crash with a NULL reporter
 test_that("ListReporter with test_file and NULL reporter", {
+  withr::local_envvar(TESTTHAT_GHA_SUMMARY = "FALSE")
   test_file_path <- 'test-list-reporter/test-exercise-list-reporter.R'
   expect_error(test_file(test_path(test_file_path), reporter = NULL), NA)
 })
@@ -9,6 +10,7 @@ test_that("ListReporter with test_file and NULL reporter", {
 # of a test (test_that() call).
 # N.B: the exception here happens between two tests: "before" and "after"
 test_that("ListReporter - exception outside of test_that()", {
+  withr::local_envvar(TESTTHAT_GHA_SUMMARY = "FALSE")
   test_file_path <- 'test-list-reporter/test-exception-outside-tests.R'
   res <- test_file(test_path(test_file_path), reporter = NULL)
 
@@ -31,6 +33,7 @@ test_that("ListReporter - exception outside of test_that()", {
 
 
 test_that("captures error if only thing in file", {
+  withr::local_envvar(TESTTHAT_GHA_SUMMARY = "FALSE")
   test_file_path <- 'test-list-reporter/test-only-error.R'
   res <- test_file(test_path(test_file_path), reporter = NULL)
 
@@ -40,6 +43,7 @@ test_that("captures error if only thing in file", {
 
 # ListReporter on a "standard" test file: 2 contexts, passing, failing and crashing tests
 test_that("exercise ListReporter", {
+  withr::local_envvar(TESTTHAT_GHA_SUMMARY = "FALSE")
   test_file_path <- 'test-list-reporter/test-exercise-list-reporter.R'
   res <- test_file(test_path(test_file_path), reporter = NULL)
   expect_s3_class(res, "testthat_results")
@@ -60,6 +64,7 @@ test_that("exercise ListReporter", {
 
 # bare expectations are ignored
 test_that("ListReporter and bare expectations", {
+  withr::local_envvar(TESTTHAT_GHA_SUMMARY = "FALSE")
   test_file_path <- 'test-list-reporter/test-bare-expectations.R'
   res <- test_file(test_path(test_file_path), reporter = NULL)
 

tests/testthat/test-snapshot-reporter.R

@@ -144,6 +144,7 @@ test_that("errors in test doesn't change snapshot", {
 })
 
 test_that("skips and unexpected errors reset snapshots", {
+  withr::local_envvar(TESTTHAT_GHA_SUMMARY = "FALSE")
   regenerate <- FALSE
 
   if (regenerate) {
@@ -166,6 +167,7 @@ test_that("skips and unexpected errors reset snapshots", {
 })
 
 test_that("`expect_error()` can fail inside `expect_snapshot()`", {
+  withr::local_envvar(TESTTHAT_GHA_SUMMARY = "FALSE")
   out <- test_file(
     test_path("test-snapshot", "test-expect-condition.R"),
     reporter = NULL

tests/testthat/test-teardown.R

@@ -26,6 +26,7 @@ test_that("teardowns runs in order", {
 })
 
 test_that("teardown run after tests complete", {
+  withr::local_envvar(TESTTHAT_GHA_SUMMARY = "FALSE")
   test_file(test_path("test-teardown/test-teardown.R"), "silent")
   expect_false(file.exists(test_path("test-teardown/teardown.txt")))
 })

tests/testthat/test-test-files.R

@@ -1,14 +1,20 @@
 # test_dir() --------------------------------------------------------------
 
 test_that("stops on failure", {
-  withr::local_envvar(TESTTHAT_PARALLEL = "FALSE")
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
   expect_error(
     test_dir(test_path("test_dir"), reporter = "silent")
   )
 })
 
 test_that("runs all tests and records output", {
-  withr::local_envvar(TESTTHAT_PARALLEL = "FALSE")
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
   res <- test_dir(test_path("test_dir"), reporter = "silent", stop_on_failure = FALSE)
   df <- as.data.frame(res)
   df$user <- df$system <- df$real <- df$result <- NULL
@@ -27,7 +33,10 @@ test_that("complains if no files", {
 })
 
 test_that("can control if failures generate errors", {
-  withr::local_envvar(TESTTHAT_PARALLEL = "FALSE")
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
   test_error <- function(...) {
     test_dir(test_path("test-error"), reporter = "silent", ...)
   }
@@ -37,7 +46,11 @@ test_that("can control if failures generate errors", {
 })
 
 test_that("can control if warnings errors", {
-  withr::local_envvar(TESTTHAT_PARALLEL = "FALSE")
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
+
   test_warning <- function(...) {
     test_dir(test_path("test-warning"), reporter = "silent", ...)
   }
@@ -49,6 +62,10 @@ test_that("can control if warnings errors", {
 # test_file ---------------------------------------------------------------
 
 test_that("can test single file", {
+  withr::local_envvar(c(
+    TESTTHAT_PARALLEL = "TRUE",
+    TESTTHAT_GHA_SUMMARY = "FALSE"
+  ))
   out <- test_file(test_path("test_dir/test-basic.R"), reporter = "silent")
   expect_length(out, 5)
 })