From 0481828b51cb4bb17fb68867c2cc5198a866e5a2 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Wed, 27 Sep 2023 08:40:12 -0500
Subject: [PATCH] Rewrite test_coverage_active_file()

---
 DESCRIPTION                  |  4 +++-
 NEWS.md                      |  5 +++++
 R/active.R                   |  4 +++-
 R/test.R                     | 37 +++++++++++++++++++++++++-----------
 tests/testthat/test-active.R |  3 +++
 5 files changed, 40 insertions(+), 13 deletions(-)

diff --git a/DESCRIPTION b/DESCRIPTION
index 4fbbf782e..47a83fe4e 100644
--- a/DESCRIPTION
+++ b/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
diff --git a/NEWS.md b/NEWS.md
index bcdf37f11..30c1fbf1a 100644
--- a/NEWS.md
+++ b/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
diff --git a/R/active.R b/R/active.R
index ebe7792a3..e54f893d8 100644
--- a/R/active.R
+++ b/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) {
diff --git a/R/test.R b/R/test.R
index 9626bf45a..0bbe0fcc9 100644
--- a/R/test.R
+++ b/R/test.R
@@ -118,27 +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())
-  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]
   }
 
diff --git a/tests/testthat/test-active.R b/tests/testthat/test-active.R
index 53984da67..5e4ca6ce8 100644
--- a/tests/testthat/test-active.R
+++ b/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")