diff --git a/R/gha-summary.R b/R/gha-summary.R new file mode 100644 index 000000000..7fc871fd5 --- /dev/null +++ b/R/gha-summary.R @@ -0,0 +1,100 @@ +create_gha_summary <- function(results) { + 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 ----------------------------------------------------------------- + gha_summary_write("### Test summary") + gha_summary_write() + gha_summary_write("| FAIL | WARN | SKIP | PASS | Time |") + gha_summary_write("|-----:|-----:|-----:|-----:|:-----|") + gha_summary_write( + c("|", if (totals$n_fail > 0) totals$n_fail), + c("|", if (totals$n_warn > 0) totals$n_warn), + c("|", if (totals$n_skip > 0) totals$n_skip), + c("|", totals$n_ok), + c("|", num_exact(totals$real, 2), "|") + ) + + # issue details ----------------------------------------------------------- + gha_summary_write() + gha_summary_write("
") + gha_summary_write("Test details") + + gha_summary_write("") + gha_summary_write() + gha_summary_write("| File | Test | FAIL | WARN | SKIP | PASS | Time |") + gha_summary_write("|:-----|:-----|-----:|-----:|-----:|-----:|:-----|") + + issues <- Filter(function(x) length(x$results) != x$n_ok, results) + for (issue in issues) { + gha_summary_write( + c("|", issue$file), + c("|", md_escape(issue$test)), + c("|", if (totals$n_fail > 0) issue$n_fail), + c("|", if (totals$n_warn > 0) issue$n_warn), + c("|", if (totals$n_skip > 0) issue$n_skip), + c("|", issue$n_ok), + c("|", num_exact(issue$real, 2), "|") + ) + } + gha_summary_write() + gha_summary_write("
") + gha_summary_write() + + invisible(results) +} + +# Helpers ---------------------------------------------------------------------- + +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 +} + +gha_path <- function() { + 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 +} + + +gha_summary_write <- function(...) { + path <- gha_path() + if (is.null(path)) { + return() + } + + string <- paste0(c(..., "\n"), collapse = "") + Encoding(string) <- "unknown" + cat(string, file = path, append = TRUE) +} + +md_escape <- function(x) { + x <- gsub("|", "\\|", x, fixed = TRUE) + x <- gsub("\n", " ", x, fixed = TRUE) + x +} diff --git a/R/parallel.R b/R/parallel.R index f82be232d..903ee5f0f 100644 --- a/R/parallel.R +++ b/R/parallel.R @@ -74,6 +74,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, diff --git a/R/test-files.R b/R/test-files.R index 686b9943f..85b114d2a 100644 --- a/R/test-files.R +++ b/R/test-files.R @@ -129,6 +129,8 @@ test_file <- function( cli::cli_abort("{.arg path} does not exist.") } + withr::local_envvar(TESTTHAT_GHA_SUMMARY = "false") + test_files( test_dir = dirname(path), test_package = package, @@ -235,6 +237,8 @@ test_files_serial <- function( ) ) + create_gha_summary(reporters$list$get_results()) + test_files_check( reporters$list$get_results(), stop_on_failure = stop_on_failure, diff --git a/tests/testthat/_snaps/gha-summary.md b/tests/testthat/_snaps/gha-summary.md new file mode 100644 index 000000000..453f66259 --- /dev/null +++ b/tests/testthat/_snaps/gha-summary.md @@ -0,0 +1,21 @@ +# multiplication works + + Code + create_gha_summary(list()) + Output + ### Test summary + + | FAIL | WARN | SKIP | PASS | Time | + |-----:|-----:|-----:|-----:|:-----| + ||||0|0.00| + +
+ Test details + + + | File | Test | FAIL | WARN | SKIP | PASS | Time | + |:-----|:-----|-----:|-----:|-----:|-----:|:-----| + +
+ + diff --git a/tests/testthat/helper.R b/tests/testthat/helper.R new file mode 100644 index 000000000..5bded57b2 --- /dev/null +++ b/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 + ) +} diff --git a/tests/testthat/test-gha-summary.R b/tests/testthat/test-gha-summary.R new file mode 100644 index 000000000..a959b6eb0 --- /dev/null +++ b/tests/testthat/test-gha-summary.R @@ -0,0 +1,4 @@ +test_that("multiplication works", { + local_mocked_bindings(gha_path = function() stdout()) + expect_snapshot(create_gha_summary(list())) +}) diff --git a/tests/testthat/test-parallel-crash.R b/tests/testthat/test-parallel-crash.R index 5e9794c07..7c8addc6e 100644 --- a/tests/testthat/test-parallel-crash.R +++ b/tests/testthat/test-parallel-crash.R @@ -1,10 +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(TESTTHAT_PARALLEL = "TRUE") - pkg <- test_path("test-parallel", "crash") err <- callr::r( function() { diff --git a/tests/testthat/test-parallel-errors.R b/tests/testthat/test-parallel-errors.R index 5d4180af5..f1535b743 100644 --- a/tests/testthat/test-parallel-errors.R +++ b/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") diff --git a/tests/testthat/test-parallel-outside.R b/tests/testthat/test-parallel-outside.R index e1ca91383..9467d8682 100644 --- a/tests/testthat/test-parallel-outside.R +++ b/tests/testthat/test-parallel-outside.R @@ -1,13 +1,6 @@ test_that("error outside of test_that()", { - skip_on_covr() - withr::local_envvar(TESTTHAT_PARALLEL = "TRUE") - 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") }) diff --git a/tests/testthat/test-parallel-setup.R b/tests/testthat/test-parallel-setup.R index 2eff8a4d1..16d622f44 100644 --- a/tests/testthat/test-parallel-setup.R +++ b/tests/testthat/test-parallel-setup.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", "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) }) diff --git a/tests/testthat/test-parallel-startup.R b/tests/testthat/test-parallel-startup.R index 240aeff1d..86826b6f7 100644 --- a/tests/testthat/test-parallel-startup.R +++ b/tests/testthat/test-parallel-startup.R @@ -1,13 +1,7 @@ test_that("startup error", { - skip_on_covr() - withr::local_envvar(TESTTHAT_PARALLEL = "TRUE") - 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) }) diff --git a/tests/testthat/test-parallel-stdout.R b/tests/testthat/test-parallel-stdout.R index 35d19eebd..32826a431 100644 --- a/tests/testthat/test-parallel-stdout.R +++ b/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, ": ") diff --git a/tests/testthat/test-parallel-teardown.R b/tests/testthat/test-parallel-teardown.R index b0eee4338..0bf32ff19 100644 --- a/tests/testthat/test-parallel-teardown.R +++ b/tests/testthat/test-parallel-teardown.R @@ -1,14 +1,8 @@ test_that("teardown error", { skip("teardown errors are ignored") - skip_on_covr() - withr::local_envvar(TESTTHAT_PARALLEL = "TRUE") - 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) }) diff --git a/tests/testthat/test-parallel.R b/tests/testthat/test-parallel.R index cb74151b2..b3556e039 100644 --- a/tests/testthat/test-parallel.R +++ b/tests/testthat/test-parallel.R @@ -26,10 +26,7 @@ test_that("good error if bad option", { }) test_that("ok", { - skip_on_covr() - 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 + local_parallel_test_config() capture.output(suppressMessages( ret <- test_local( test_path("test-parallel", "ok"), @@ -44,8 +41,7 @@ test_that("ok", { }) test_that("fail", { - skip_on_covr() - withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE")) + local_parallel_test_config() # we cannot run these with the silent reporter, because it is not # parallel compatible, and they'll not run in parallel capture.output(suppressMessages( @@ -61,9 +57,7 @@ test_that("fail", { }) test_that("snapshots", { - skip_on_covr() - skip_on_cran() - withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE")) + local_parallel_test_config() tmp <- withr::local_tempdir("testthat-snap-") file.copy(test_path("test-parallel", "snap"), tmp, recursive = TRUE) @@ -86,9 +80,8 @@ test_that("snapshots", { }) test_that("new snapshots are added", { - skip_on_covr() - skip_on_cran() - withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE", CI = "false")) + local_parallel_test_config() + withr::local_envvar(CI = "false") tmp <- withr::local_tempdir("testthat-snap-") file.copy(test_path("test-parallel", "snap"), tmp, recursive = TRUE) @@ -113,9 +106,7 @@ test_that("new snapshots are added", { }) test_that("snapshots are removed if test file has no snapshots", { - skip_on_covr() - skip_on_cran() - withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE")) + local_parallel_test_config() tmp <- withr::local_tempdir("testthat-snap-") file.copy(test_path("test-parallel", "snap"), tmp, recursive = TRUE) @@ -143,10 +134,8 @@ test_that("snapshots are removed if test file has no snapshots", { }) test_that("snapshots are removed if test file is removed", { - skip_on_covr() - skip_on_cran() + local_parallel_test_config() - withr::local_envvar(c(TESTTHAT_PARALLEL = "TRUE")) withr::defer(unlink(tmp, recursive = TRUE)) dir.create(tmp <- tempfile("testthat-snap-")) file.copy(test_path("test-parallel", "snap"), tmp, recursive = TRUE) diff --git a/tests/testthat/test-reporter-list.R b/tests/testthat/test-reporter-list.R index 0c22d0dfa..c9487bdfc 100644 --- a/tests/testthat/test-reporter-list.R +++ b/tests/testthat/test-reporter-list.R @@ -1,5 +1,6 @@ # 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_no_error(test_file(test_path(test_file_path), reporter = NULL)) }) @@ -8,6 +9,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) @@ -30,6 +32,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) @@ -39,6 +42,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") @@ -62,6 +66,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 fbdeb55da..df336919a 100644 --- a/tests/testthat/test-snapshot-reporter.R +++ b/tests/testthat/test-snapshot-reporter.R @@ -159,6 +159,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) { @@ -179,6 +180,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 0103b1ecc..c9ca0f7b1 100644 --- a/tests/testthat/test-teardown.R +++ b/tests/testthat/test-teardown.R @@ -28,6 +28,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 3243f59f9..5c1bf792b 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_snapshot(error = TRUE, { 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", @@ -23,7 +29,10 @@ test_that("runs all tests and records output", { }) test_that("complains if no files", { - withr::local_envvar(TESTTHAT_PARALLEL = "FALSE") + withr::local_envvar( + TESTTHAT_PARALLEL = "FALSE", + TESTTHAT_GHA_SUMMARY = "FALSE" + ) path <- withr::local_tempfile() dir.create(path) @@ -31,7 +40,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", ...) } @@ -41,7 +53,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", ...) } @@ -53,6 +69,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) }) @@ -88,6 +108,11 @@ test_that("can filter test scripts", { # ---------------------------------------------------------------------- test_that("can configure `load_all()` (#1636)", { + withr::local_envvar( + TESTTHAT_PARALLEL = "FALSE", + TESTTHAT_GHA_SUMMARY = "FALSE" + ) + path <- test_path("testConfigLoadAll") args <- find_load_all_args(path)