Optionally report on lack of coverage

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
 

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
+}

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)

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".
+

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)
+})