Improve test coverage functionality (#2537)

Remove unneeded (and harmful) call to `local_test_directory()` from `test_coverage()`.  Fixes r-lib/testthat#1858.

Rewrite `test_coverage_active_file()` to ensure that test failures are forwarded to the user, and fix the problems (mostly with snapshotting thus revealed).

Author: hadley

DESCRIPTION

@@ -35,7 +35,7 @@ Imports:
     rversions (>= 2.1.1),
     sessioninfo (>= 1.2.2),
     stats,
-    testthat (>= 3.1.5),
+    testthat (>= 3.1.10.9000),
     tools,
     urlchecker (>= 1.0.1),
     utils,
@@ -68,3 +68,5 @@ Language: en-US
 Roxygen: list(markdown = TRUE)
 RoxygenNote: 7.2.3
 Config/testthat/edition: 3
+Remotes:  
+    r-lib/testthat

NEWS.md

@@ -1,5 +1,10 @@
 # devtools (development version)
 
+* `test_coverage()` now works if the package has not been installed.
+
+* `test_coverage_active_file()` now reports if any tests failed and does
+  a better job of executing snapshot comparisons.
+
 # devtools 2.4.5
 
 * `check(cleanup =)` was deprecated in devtools v1.11.0 (2016-04-12) and was

R/active.R

@@ -15,8 +15,10 @@ find_test_file <- function(path, call = parent.frame()) {
     )
   }
 
+  pkg <- as.package(dirname(path))
+
   is_test <- type == "test"
-  path[!is_test] <- paste0("tests/testthat/test-", name_source(path[!is_test]), ".R")
+  path[!is_test] <- paste0(pkg$path, "/tests/testthat/test-", name_source(path[!is_test]), ".R")
   path <- unique(path[file_exists(path)])
 
   if (length(path) == 0) {

R/test.R

@@ -100,7 +100,6 @@ test_coverage <- function(pkg = ".", show_report = interactive(), ...) {
   check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn))
 
   withr::local_envvar(r_env_vars())
-  testthat::local_test_directory(pkg$path, pkg$package)
   coverage <- covr::package_coverage(pkg$path, ...)
 
   if (isTRUE(show_report)) {
@@ -119,28 +118,42 @@ test_coverage_file <- function(file = find_active_file(), ...) {
 
 #' @rdname test
 #' @export
-test_coverage_active_file <- function(file = find_active_file(), filter = TRUE, show_report = interactive(), export_all = TRUE, ...) {
+test_coverage_active_file <- function(file = find_active_file(),
+                                      filter = TRUE,
+                                      show_report = interactive(),
+                                      export_all = TRUE,
+                                      ...) {
   rlang::check_installed(c("covr", "DT"))
-
-  save_all()
-  test_files <- find_test_file(file)
-  pkg <- as.package(path_dir(file)[[1]])
-
   check_dots_used(action = getOption("devtools.ellipsis_action", rlang::warn))
 
-  withr::local_envvar(r_env_vars())
-  testthat::local_test_directory(pkg$path, pkg$package)
-  reporter <- testthat::local_snapshotter()
-  reporter$start_file(file, "test")
+  test_file <- find_test_file(file)
+  test_dir <- path_dir(test_file)
+  pkg <- as.package(test_dir)
 
   env <- load_all(pkg$path, quiet = TRUE, export_all = export_all)$env
+  # this always ends up using the package DESCRIPTION, which will refer
+  # to the source package because of the load_all() above
+  testthat::local_test_directory(test_dir, pkg$package)
+
+  # To correctly simulate test_file() we need to set up both a temporary
+  # snapshotter (with correct directory specification) for snapshot comparisons
+  # and a stop reporter to inform the user about test failures
+  snap_reporter <- testthat::local_snapshotter(file.path(test_dir, "_snaps"))
+  snap_reporter$start_file(basename(test_file))
+  reporter <- testthat::MultiReporter$new(reporters = list(
+    testthat::StopReporter$new(praise = FALSE),
+    snap_reporter
+  ))
+
+  withr::local_envvar(r_env_vars())
   testthat::with_reporter(reporter, {
-    coverage <- covr::environment_coverage(env, test_files, ...)
+    coverage <- covr::environment_coverage(env, test_file, ...)
+    reporter$end_file() # needed to write new snapshots
   })
 
   if (isTRUE(filter)) {
     coverage_name <- name_source(covr::display_name(coverage))
-    local_name <- name_test(file)
+    local_name <- name_test(test_file)
     coverage <- coverage[coverage_name %in% local_name]
   }
 

tests/testthat/test-active.R

@@ -3,6 +3,9 @@ test_that("find_active_file() gives useful error if no RStudio", {
 })
 
 test_that("fails if can't find tests", {
+  dir <- local_package_create()
+  withr::local_dir(dir)
+
   expect_snapshot(error = TRUE, {
     find_test_file("R/foo.blah")
     find_test_file("R/foo.R")