From a6fa753cb013c4c88330944b2d8f7a813dcb0a03 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Fri, 1 Aug 2025 07:42:26 -0500
Subject: [PATCH 1/3] Use restart in `test_code()`

---
 R/test-that.R | 47 ++++++++++++++++++++---------------------------
 1 file changed, 20 insertions(+), 27 deletions(-)

diff --git a/R/test-that.R b/R/test-that.R
index 51b4fa0ae..637704d3b 100644
--- a/R/test-that.R
+++ b/R/test-that.R
@@ -124,19 +124,11 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
     # to be able to debug with the DebugReporter
     register_expectation(e, 2)
 
-    e[["handled"]] <- TRUE
     test_error <<- e
+    invokeRestart("end_test")
   }
   handle_fatal <- function(e) {
     handled <<- TRUE
-    # Error caught in handle_error() has precedence
-    if (!is.null(test_error)) {
-      e <- test_error
-      if (isTRUE(e[["handled"]])) {
-        return()
-      }
-    }
-
     register_expectation(e, 0)
   }
   handle_expectation <- function(e) {
@@ -175,7 +167,7 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
 
     debug_end <- if (inherits(e, "skip_empty")) -1 else 2
     register_expectation(e, debug_end)
-    signalCondition(e)
+    invokeRestart("end_test")
   }
 
   test_env <- new.env(parent = env)
@@ -185,24 +177,25 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
   withr::local_options(testthat_topenv = test_env)
 
   before <- inspect_state()
-  tryCatch(
-    withCallingHandlers(
-      {
-        eval(code, test_env)
-        if (!handled && !is.null(test)) {
-          skip_empty()
-        }
-      },
-      expectation = handle_expectation,
-      skip = handle_skip,
-      warning = handle_warning,
-      message = handle_message,
-      error = handle_error
+  withRestarts(
+    tryCatch(
+      withCallingHandlers(
+        {
+          eval(code, test_env)
+          if (!handled && !is.null(test)) {
+            skip_empty()
+          }
+        },
+        expectation = handle_expectation,
+        skip = handle_skip,
+        warning = handle_warning,
+        message = handle_message,
+        error = handle_error
+      ),
+      # some errors may need handling here, e.g., stack overflow
+      error = handle_fatal
     ),
-    # some errors may need handling here, e.g., stack overflow
-    error = handle_fatal,
-    # skip silently terminate code
-    skip = function(e) {}
+    end_test = function() {}
   )
   after <- inspect_state()
 

From 1cee2de142f5a638a9d7ac878d46bebfb3f23999 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Tue, 5 Aug 2025 08:17:51 -0500
Subject: [PATCH 2/3] Minor polishing

---
 R/test-that.R | 16 +---------------
 1 file changed, 1 insertion(+), 15 deletions(-)

diff --git a/R/test-that.R b/R/test-that.R
index 637704d3b..048af8315 100644
--- a/R/test-that.R
+++ b/R/test-that.R
@@ -89,11 +89,6 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
     reporter$add_result(context = reporter$.context, test = test, result = e)
   }
 
-  # Any error will be assigned to this variable first
-  # In case of stack overflow, no further processing (not even a call to
-  # signalCondition() ) might be possible
-  test_error <- NULL
-
   expressions_opt <- getOption("expressions")
   expressions_opt_new <- min(expressions_opt + 500L, 500000L)
 
@@ -104,11 +99,9 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
 
   handle_error <- function(e) {
     handled <<- TRUE
-    # First thing: Collect test error
-    test_error <<- e
 
     # Increase option(expressions) to handle errors here if possible, even in
-    # case of a stack overflow.  This is important for the DebugReporter.
+    # case of a stack overflow. This is important for the DebugReporter.
     # Call options() manually, avoid withr overhead.
     options(expressions = expressions_opt_new)
     on.exit(options(expressions = expressions_opt), add = TRUE)
@@ -118,13 +111,7 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
       e <- cnd_entrace(e)
     }
 
-    test_error <<- e
-
-    # Error will be handled by handle_fatal() if this fails; need to do it here
-    # to be able to debug with the DebugReporter
     register_expectation(e, 2)
-
-    test_error <<- e
     invokeRestart("end_test")
   }
   handle_fatal <- function(e) {
@@ -154,7 +141,6 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
     }
 
     register_expectation(e, 5)
-
     tryInvokeRestart("muffleWarning")
   }
   handle_message <- function(e) {

From 9638d43caf3ed393c11f7fb0f7d96fa528bbdbc6 Mon Sep 17 00:00:00 2001
From: Hadley Wickham <h.wickham@gmail.com>
Date: Tue, 5 Aug 2025 08:19:56 -0500
Subject: [PATCH 3/3] Use low-overhead rlang function

---
 R/test-that.R | 4 +---
 1 file changed, 1 insertion(+), 3 deletions(-)

diff --git a/R/test-that.R b/R/test-that.R
index 123c6c428..a6dcc67ef 100644
--- a/R/test-that.R
+++ b/R/test-that.R
@@ -102,9 +102,7 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
 
     # Increase option(expressions) to handle errors here if possible, even in
     # case of a stack overflow. This is important for the DebugReporter.
-    # Call options() manually, avoid withr overhead.
-    options(expressions = expressions_opt_new)
-    withr::defer(options(expressions = expressions_opt))
+    local_options(expressions = expressions_opt_new)
 
     # Add structured backtrace to the expectation
     if (can_entrace(e)) {