diff --git a/NEWS.md b/NEWS.md index 3d9740ba0..6ee56d4a7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -5,6 +5,7 @@ * `is_loading()` is now re-exported from pkgload (#2556). * `load_all()` now errors if called recursively, i.e. if you accidentally include a `load_all()` call in one of your R source files (#2617). * `show_news()` now looks for NEWS files in the same locations as `utils::news()`: `inst/NEWS.Rd`, `NEWS.md`, `NEWS`, and `inst/NEWS` (@arcresu, #2499). +* `test_coverage()` and `test_coverage_active_file()` gain a new `report` argument that can be set to `"html"` (the default, for an interactive browser report), `"zero"` (prints uncovered lines to the console, used for LLMs and non-interactive contexts), or `"silent"` (#2632). # devtools 2.4.6 diff --git a/R/test.R b/R/test.R index 575a6ea40..49eedc825 100644 --- a/R/test.R +++ b/R/test.R @@ -93,10 +93,15 @@ load_package_for_testing <- function(pkg) { } } -#' @param show_report Show the test coverage report. +#' @param report How to display the coverage report. +#' * `"html"` opens an interactive report in the browser. +#' * `"zero"` prints uncovered lines to the console. +#' * `"silent"` returns the coverage object without display. +#' +#' Defaults to `"html"` if interactive; otherwise to `"zero"`. #' @export #' @rdname test -test_coverage <- function(pkg = ".", show_report = interactive(), ...) { +test_coverage <- function(pkg = ".", report = NULL, ...) { rlang::check_installed(c("covr", "DT")) save_all() @@ -108,11 +113,7 @@ test_coverage <- function(pkg = ".", show_report = interactive(), ...) { withr::local_envvar(r_env_vars()) coverage <- covr::package_coverage(pkg$path, ...) - if (isTRUE(show_report)) { - covr::report(coverage) - } - - invisible(coverage) + show_report(coverage, report = report, path = pkg$path) } #' @rdname devtools-deprecated @@ -131,7 +132,7 @@ test_coverage_file <- function(file = find_active_file(), ...) { test_coverage_active_file <- function( file = find_active_file(), filter = TRUE, - show_report = interactive(), + report = NULL, export_all = TRUE, ... ) { @@ -177,17 +178,7 @@ test_coverage_active_file <- function( attr(coverage, "relative") <- TRUE attr(coverage, "package") <- pkg - if (isTRUE(show_report)) { - covered <- unique(covr::display_name(coverage)) - - if (length(covered) == 1) { - covr::file_report(coverage) - } else { - covr::report(coverage) - } - } - - invisible(coverage) + show_report(coverage, report = report, path = pkg$path) } @@ -205,3 +196,60 @@ uses_testthat <- function(pkg = ".") { any(dir_exists(paths)) } + +report_default <- function(report, call = rlang::caller_env()) { + if (is.null(report)) { + if (is_llm() || !rlang::is_interactive()) "zero" else "html" + } else { + rlang::arg_match(report, c("silent", "zero", "html"), error_call = call) + } +} + +show_report <- function(coverage, report, path, call = rlang::caller_env()) { + report <- report_default(report, call = call) + + if (report == "html") { + covered <- unique(covr::display_name(coverage)) + + if (length(covered) == 1) { + covr::file_report(coverage) + } else { + covr::report(coverage) + } + } else if (report == "zero") { + zero <- covr::zero_coverage(coverage) + if (nrow(zero) == 0) { + cli::cli_inform(c(v = "All lines covered!")) + } else { + for (file in unique(zero$filename)) { + file_zero <- zero[zero$filename == file, ] + lines_by_fun <- split(file_zero$line, file_zero$functions) + + rel_path <- path_rel(file, path) + cli::cli_inform("Uncovered lines in {.file {rel_path}}:") + for (fun in names(lines_by_fun)) { + lines <- paste0(collapse_lines(lines_by_fun[[fun]]), collapse = ", ") + cli::cli_inform(c("*" = "{.fn {fun}}: {lines}")) + } + } + } + } + invisible(coverage) +} + +collapse_lines <- function(x) { + x <- sort(unique(x)) + breaks <- c(0, which(diff(x) != 1), length(x)) + + ranges <- character(length(breaks) - 1) + for (i in seq_along(ranges)) { + start <- x[breaks[i] + 1] + end <- x[breaks[i + 1]] + if (start == end) { + ranges[i] <- as.character(start) + } else { + ranges[i] <- paste0(start, "-", end) + } + } + ranges +} diff --git a/R/utils.R b/R/utils.R index f68956aa6..070b7efa6 100644 --- a/R/utils.R +++ b/R/utils.R @@ -45,6 +45,14 @@ is_rstudio_running <- function() { !is_testing() && rstudioapi::isAvailable() } +# Copied from testthat:::is_llm() +is_llm <- function() { + nzchar(Sys.getenv("AGENT")) || + nzchar(Sys.getenv("CLAUDECODE")) || + nzchar(Sys.getenv("GEMINI_CLI")) || + nzchar(Sys.getenv("CURSOR_AGENT")) +} + # Suppress cli wrapping no_wrap <- function(x) { x <- gsub("{", "{{", x, fixed = TRUE) diff --git a/man/test.Rd b/man/test.Rd index 4e377a70e..fec710309 100644 --- a/man/test.Rd +++ b/man/test.Rd @@ -11,12 +11,12 @@ test(pkg = ".", filter = NULL, stop_on_failure = FALSE, export_all = TRUE, ...) test_active_file(file = find_active_file(), ...) -test_coverage(pkg = ".", show_report = interactive(), ...) +test_coverage(pkg = ".", report = NULL, ...) test_coverage_active_file( file = find_active_file(), filter = TRUE, - show_report = interactive(), + report = NULL, export_all = TRUE, ... ) @@ -41,7 +41,14 @@ in the NAMESPACE file.} corresponding test file will be run. The default is to use the active file in RStudio (if available).} -\item{show_report}{Show the test coverage report.} +\item{report}{How to display the coverage report. +\itemize{ +\item \code{"html"} opens an interactive report in the browser. +\item \code{"zero"} prints uncovered lines to the console. +\item \code{"silent"} returns the coverage object without display. +} + +Defaults to \code{"html"} if interactive; otherwise to \code{"zero"}.} } \description{ \itemize{ diff --git a/tests/testthat/_snaps/test.md b/tests/testthat/_snaps/test.md new file mode 100644 index 000000000..f04fef70c --- /dev/null +++ b/tests/testthat/_snaps/test.md @@ -0,0 +1,24 @@ +# test_coverage_active_file() computes coverage + + Code + test_coverage_active_file(file.path(pkg, "R", "math.R"), report = "zero") + Message + Uncovered lines in 'R/math.R': + * `compute()`: 4-5 + * `multiply()`: 2 + +# test_coverage_active_file() reports full coverage + + Code + test_coverage_active_file(file.path(pkg, "R", "math.R"), report = "zero") + Message + v All lines covered! + +# report_default() does its job + + Code + report_default("bad") + Condition + Error: + ! `report` must be one of "silent", "zero", or "html", not "bad". + diff --git a/tests/testthat/test-test.R b/tests/testthat/test-test.R index bfcb01af7..d890e5738 100644 --- a/tests/testthat/test-test.R +++ b/tests/testthat/test-test.R @@ -59,3 +59,70 @@ test_that("stop_on_failure defaults to FALSE", { "Test failures" ) }) + +test_that("test_coverage_active_file() computes coverage", { + pkg <- local_package_create() + writeLines( + c( + "add <- function(x, y) x + y", + "multiply <- function(x, y) x * y", + "compute <- function(x) {", + " x + 1", + " x + 2", + "}" + ), + file.path(pkg, "R", "math.R") + ) + dir_create(file.path(pkg, "tests", "testthat")) + writeLines( + c( + "test_that('add works', {", + " expect_equal(add(1, 2), 3)", + "})" + ), + file.path(pkg, "tests", "testthat", "test-math.R") + ) + + expect_snapshot(test_coverage_active_file( + file.path(pkg, "R", "math.R"), + report = "zero" + )) +}) + +test_that("test_coverage_active_file() reports full coverage", { + pkg <- local_package_create() + writeLines( + "add <- function(x, y) x + y", + file.path(pkg, "R", "math.R") + ) + dir_create(file.path(pkg, "tests", "testthat")) + writeLines( + c( + "test_that('add works', {", + " expect_equal(add(1, 2), 3)", + "})" + ), + file.path(pkg, "tests", "testthat", "test-math.R") + ) + + expect_snapshot(test_coverage_active_file( + file.path(pkg, "R", "math.R"), + report = "zero" + )) +}) + +test_that("report_default() does its job", { + withr::local_options(rlang_interactive = FALSE) + expect_equal(report_default(NULL), "zero") + + withr::local_options(rlang_interactive = TRUE) + expect_equal(report_default(NULL), "html") + + withr::local_envvar(AGENT = 1) + expect_equal(report_default(NULL), "zero") + + expect_equal(report_default("silent"), "silent") + expect_equal(report_default("zero"), "zero") + expect_equal(report_default("html"), "html") + expect_snapshot(report_default("bad"), error = TRUE) +})