Optionally report on lack of coverage (#2654)

* Optionally report on lack of coverage

And use that display for LLMs and in non-interactive contexts.

It may have been lazy to not deprecate `show_report`, but I just can't imagine anyone is actually using it. Let me know if you think I'm wrong.

Fixes #2632

* Move the requirement for DT to the interactive report case

* Fix so that claude can run this test file

* Avoid covr-ception

* Mention removal of `show_report`, in case someone's confused

---------

Co-authored-by: Jenny Bryan <jenny.f.bryan@gmail.com>

Author: hadley

NEWS.md

@@ -12,6 +12,7 @@
 * `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).
 * `release()` is deprecated in favour of `usethis::use_release_issue()`.
 * `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"`. The `show_report` argument has been removed (#2632).
 * `test_file()` and `test_coverage_file()` are now defunct. These were deprecated in devtools 2.4.0 (2021-04-07) in favour of `test_active_file()` and `test_coverage_active_file()`. Removing `test_file()` eliminates the conflict with `testthat::test_file()`.
 
 # devtools 2.4.6

R/test.R

@@ -86,11 +86,16 @@ 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(), ...) {
-  rlang::check_installed(c("covr", "DT"))
+test_coverage <- function(pkg = ".", report = NULL, ...) {
+  rlang::check_installed("covr")
 
   save_all()
   pkg <- as.package(pkg)
@@ -101,23 +106,19 @@ 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 test
 #' @export
 test_coverage_active_file <- function(
   file = find_active_file(),
   filter = TRUE,
-  show_report = interactive(),
+  report = NULL,
   export_all = TRUE,
   ...
 ) {
-  rlang::check_installed(c("covr", "DT"))
+  rlang::check_installed("covr")
   check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn))
 
   test_file <- find_test_file(file)
@@ -159,17 +160,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)
 }
 
 
@@ -188,6 +179,64 @@ 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") {
+    rlang::check_installed("DT")
+    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
+}
+
 
 #' Defunct functions
 #'

R/utils.R

@@ -49,6 +49,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)

man/test.Rd

@@ -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/_snaps/test.md

@@ -59,3 +59,74 @@ test_that("stop_on_failure defaults to FALSE", {
     "Test failures"
   )
 })
+
+test_that("test_coverage_active_file() computes coverage", {
+  skip_on_covr()
+  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", {
+  skip_on_covr()
+  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)
+  if (!is_llm()) {
+    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)
+})