diff --git a/R/gha-summary.R b/R/gha-summary.R new file mode 100644 index 000000000..10c98096e --- /dev/null +++ b/R/gha-summary.R @@ -0,0 +1,92 @@ + +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() + } + + out <- file(out, open = "a+b", encoding = "unknown") + on.exit(close(out), add = TRUE) + + p <- function(...) { + s <- paste0(...) + Encoding(s) <- "unknown" + cat(s, file = out, append = TRUE) + } + fmt_time <- function(x) sprintf("%.3fs", x) + + results <- lapply(results, gha_summarize_test) + totals <- list( + n_fail = sum(vapply(results, "[[", integer(1), "n_fail")), + n_warn = sum(vapply(results, "[[", integer(1), "n_warn")), + n_skip = sum(vapply(results, "[[", integer(1), "n_skip")), + n_ok = sum(vapply(results, "[[", integer(1), "n_ok")), + real = sum(vapply(results, "[[", double(1), "real")) + ) + + # summary + p("### Test summary\n\n") + p("| \u274c FAIL | \u26a0 WARN | \u23ed\ufe0f SKIP | \u2705 PASS | \u23f1 Time |\n") + p("|------------:|------------:|------------------:|------------:|:------------|\n") + + p(paste0( + "|", if (totals$n_fail > 0) paste0("\u274c **", totals$n_fail, "**"), + "|", if (totals$n_warn > 0) paste0("\u26a0 **", totals$n_warn, "**"), + "|", if (totals$n_skip > 0) paste0("\u23ed\ufe0f **", totals$n_skip, "**"), + "|", paste0("\u2705 **", totals$n_ok, "**"), + "|", fmt_time(totals$real), + "|\n" + )) + + # tests with issues + p("\n
\n\n") + + p("### Test details\n\n") + p("| \u274c FAIL | \u26a0 WARN | \u23ed\ufe0f SKIP | \u2705 PASS | context | test | \u23f1 Time |\n") + p("|------------:|------------:|------------------:|------------:|:--------|:-----|:------------|\n") + + escape <- function(x) { + x <- gsub("|", "\\|", x, fixed = TRUE) + x <- gsub("\n", " ", x, fixed = TRUE) + x + } + + issues <- Filter(function(x) length(x$results) != x$n_ok, results) + for (issue in issues) { + p(paste0( + "|", if (issue$n_fail > 0) paste0("\u274c **", issue$n_fail, "**"), + "|", if (issue$n_warn > 0) paste0("\u26a0 **", issue$n_warn, "**"), + "|", if (issue$n_skip > 0) paste0("\u23ed\ufe0f **", issue$n_skip, "**"), + "|", if (issue$n_ok > 0) paste0("\u2705 **", issue$n_ok, "**"), + "|", escape(context_name(issue$file)), + "|", escape(issue$test), + "|", fmt_time(issue$real), + "|\n" + )) + } + + p("\n
\n\n\n") + + invisible(results) +} + +gha_summarize_test <- function(test) { + + test$n_fail <- test$n_skip <- test$n_warn <- test$n_ok <- 0L + for (exp in test$results) { + if (expectation_broken(exp)) { + test$n_fail <- test$n_fail + 1L + } else if (expectation_skip(exp)) { + test$n_skip <- test$n_skip + 1L + } else if (expectation_warning(exp)) { + test$n_warn <- test$n_warn + 1L + } else { + test$n_ok <- test$n_ok + 1L + } + } + + test +} diff --git a/R/parallel.R b/R/parallel.R index 6f039d64d..e6c1add71 100644 --- a/R/parallel.R +++ b/R/parallel.R @@ -78,6 +78,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 diff --git a/R/test-files.R b/R/test-files.R index 362ccd85c..566e840df 100644 --- a/R/test-files.R +++ b/R/test-files.R @@ -125,6 +125,8 @@ test_file <- function(path, stop("`path` does not exist", call. = FALSE) } + withr::local_envvar(TESTTHAT_GHA_SUMMARY = "false") + test_files( test_dir = dirname(path), test_package = package, @@ -214,6 +216,8 @@ test_files_serial <- function(test_dir, ) ) + 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 diff --git a/tests/testthat/test-parallel-crash.R b/tests/testthat/test-parallel-crash.R index cb3b0d7e7..b56d97e3b 100644 --- a/tests/testthat/test-parallel-crash.R +++ b/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 diff --git a/tests/testthat/test-parallel-outside.R b/tests/testthat/test-parallel-outside.R index a2b7c396c..daedb2305 100644 --- a/tests/testthat/test-parallel-outside.R +++ b/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( capture.output(suppressMessages(testthat::test_local( test_path("test-parallel", "outside"), diff --git a/tests/testthat/test-parallel-setup.R b/tests/testthat/test-parallel-setup.R index 3136302a0..ad9d10a4b 100644 --- a/tests/testthat/test-parallel-setup.R +++ b/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( capture.output(suppressMessages(testthat::test_local( test_path("test-parallel", "setup"), diff --git a/tests/testthat/test-parallel-startup.R b/tests/testthat/test-parallel-startup.R index 108bb6a77..0cc7cf256 100644 --- a/tests/testthat/test-parallel-startup.R +++ b/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( capture.output(suppressMessages(testthat::test_local( test_path("test-parallel", "startup"), diff --git a/tests/testthat/test-parallel-teardown.R b/tests/testthat/test-parallel-teardown.R index 0df0a8aee..ad3f2230f 100644 --- a/tests/testthat/test-parallel-teardown.R +++ b/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( capture.output(suppressMessages(testthat::test_local( test_path("test-parallel", "teardown"), diff --git a/tests/testthat/test-parallel.R b/tests/testthat/test-parallel.R index f9c1bf1cd..305076bc9 100644 --- a/tests/testthat/test-parallel.R +++ b/tests/testthat/test-parallel.R @@ -23,9 +23,10 @@ test_that("detect number of cpus to use", { }) test_that("ok", { - withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE")) - # we cannot run these with the silent reporter, because it is not - # parallel compatible, and they'll not run in parallel + withr::local_envvar(c( + TESTTHAT_PARALLEL = "TRUE", + TESTTHAT_GHA_SUMMARY = "FALSE" + )) capture.output(suppressMessages(ret <- test_local( test_path("test-parallel", "ok"), reporter = "summary", diff --git a/tests/testthat/test-reporter-list.R b/tests/testthat/test-reporter-list.R index 14dc35da5..9d89d7f25 100644 --- a/tests/testthat/test-reporter-list.R +++ b/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) diff --git a/tests/testthat/test-snapshot-reporter.R b/tests/testthat/test-snapshot-reporter.R index 57955686f..f5477edf7 100644 --- a/tests/testthat/test-snapshot-reporter.R +++ b/tests/testthat/test-snapshot-reporter.R @@ -139,6 +139,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) { @@ -161,6 +162,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 diff --git a/tests/testthat/test-teardown.R b/tests/testthat/test-teardown.R index 4ac0cf517..64fea5f3c 100644 --- a/tests/testthat/test-teardown.R +++ b/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"))) }) diff --git a/tests/testthat/test-test-files.R b/tests/testthat/test-test-files.R index 42f51e076..b9a034716 100644 --- a/tests/testthat/test-test-files.R +++ b/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 = "FALSE", + 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 = "FALSE", + 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 = "FALSE", + 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 = "FALSE", + 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 = "FALSE", + TESTTHAT_GHA_SUMMARY = "FALSE" + )) out <- test_file(test_path("test_dir/test-basic.R"), reporter = "silent") expect_length(out, 5) })