Handle interrupts in tests

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* Interrupting a test now prints the test name. This makes it easier to tell where a very slow test might be hanging (#1464)
 * `expect_snapshot_value()` can now handle expressions that generate `-` (#1678) or zero length atomic vectors (#2042).
 * `expect_matches()` failures should be a little easier to read (#2135).
 * New `local_on_cran(TRUE)` allows you to simulate how your tests will run on CRAN (#2112).

R/reporter-stop.R

@@ -14,48 +14,53 @@ StopReporter <- R6::R6Class(
   "StopReporter",
   inherit = Reporter,
   public = list(
-    failures = NULL,
+    # All expectations that need to be reported (error, failure, warning, skip)
+    issues = NULL,
+    # Expectations that should cause the test to fail (error, failure)
     n_fail = 0L,
+    # Successful expectations
+    n_success = 0L,
     stop_reporter = TRUE,
     praise = TRUE,
 
     initialize = function(stop_reporter = TRUE, praise = TRUE) {
       super$initialize()
-      self$failures <- Stack$new()
+      self$issues <- Stack$new()
       self$praise <- praise
       self$stop_reporter <- stop_reporter
     },
 
     start_test = function(context, test) {
-      self$failures <- Stack$new()
+      self$issues <- Stack$new()
     },
 
     add_result = function(context, test, result) {
       if (expectation_success(result)) {
+        self$n_success <- self$n_success + 1
         return()
       }
 
       if (expectation_broken(result)) {
         self$n_fail <- self$n_fail + 1
       }
-
-      self$failures$push(result)
+      self$issues$push(result)
     },
 
     end_test = function(context, test) {
       self$local_user_output()
 
-      failures <- self$failures$as_list()
-      if (length(failures) == 0 && self$praise) {
-        self$cat_line(colourise("Test passed", "success"), " ", praise_emoji())
-        return()
-      }
-
-      messages <- vapply(failures, issue_summary, rule = TRUE, character(1))
-      if (length(messages) > 0) {
+      if (self$issues$size() == 0) {
+        if (self$praise && self$n_success > 0) {
+          emoji <- praise_emoji()
+          self$cat_line(colourise("Test passed", "success"), " ", emoji)
+        }
+      } else {
+        issues <- self$issues$as_list()
+        messages <- vapply(issues, issue_summary, rule = TRUE, character(1))
         self$cat_line(messages, "\n")
       }
     },
+
     stop_if_needed = function() {
       if (self$stop_reporter && self$n_fail > 0) {
         abort("Test failed", call = NULL)

R/test-that.R

@@ -178,6 +178,13 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
     signalCondition(e)
   }
 
+  handle_interrupt <- function(e) {
+    if (!is.null(test)) {
+      cat("\n")
+      cli::cli_inform(c("!" = "Interrupting test: {test}"))
+    }
+  }
+
   test_env <- new.env(parent = env)
   old <- options(rlang_trace_top_env = test_env)[[1]]
   on.exit(options(rlang_trace_top_env = old), add = TRUE)
@@ -197,7 +204,8 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
       skip = handle_skip,
       warning = handle_warning,
       message = handle_message,
-      error = handle_error
+      error = handle_error,
+      interrupt = handle_interrupt
     ),
     # some errors may need handling here, e.g., stack overflow
     error = handle_fatal,