From 1b2fe7700295aba34ec9fb515206f55b3ceeba74 Mon Sep 17 00:00:00 2001
From: George Stagg <george.stagg@posit.co>
Date: Fri, 5 May 2023 12:23:26 +0100
Subject: [PATCH] Unsafe changes to further reduce stack use

The internal function `.addCondHands` is used in place of
`withConditionHandlers` to avoid adding a call to the stack. This
generates a warning during `R CMD check`.

The `captureStackTraces` function is removed from `hybrid_chain`.
Instead stack traces are captured and annotated by a `captureStackTraces`
invoked by `runApp` higher up the call stack.
---
 R/utils.R | 54 ++++++++++++++++++++++++------------------------------
 1 file changed, 24 insertions(+), 30 deletions(-)

diff --git a/R/utils.R b/R/utils.R
index b4c0297364..e0a7b9b3d2 100644
--- a/R/utils.R
+++ b/R/utils.R
@@ -1523,38 +1523,32 @@ hybrid_chain <- function(expr, ..., catch = NULL, finally = NULL,
       }
     )
 
-    withCallingHandlers(
-      {
-        captureStackTraces({
-          result <- withVisible(force(expr))
-          if (promises::is.promising(result$value)) {
-            # Purposefully NOT including domain (nor replace), as we're already in
-            # the domain at this point
-            p <- promise_chain(valueWithVisible(result), ..., catch = catch, finally = finally)
-            runFinally <- FALSE
-            p
+    handlers <- list(error = function(e) { catch_e <<- e; do_catch })
+    classes <- names(handlers)
+    .Internal(.addCondHands(classes, handlers, parent.frame(), NULL, TRUE))
+
+    result <- withVisible(force(expr))
+    if (promises::is.promising(result$value)) {
+      # Purposefully NOT including domain (nor replace), as we're already in
+      # the domain at this point
+      p <- promise_chain(valueWithVisible(result), ..., catch = catch, finally = finally)
+      runFinally <- FALSE
+      p
+    } else {
+      result <- Reduce(
+        function(v, func) {
+          if (v$visible) {
+            withVisible(func(v$value))
           } else {
-            result <- Reduce(
-              function(v, func) {
-                if (v$visible) {
-                  withVisible(func(v$value))
-                } else {
-                  withVisible(func(invisible(v$value)))
-                }
-              },
-              list(...),
-              result
-            )
-
-            valueWithVisible(result)
+            withVisible(func(invisible(v$value)))
           }
-        })
-      },
-      error = function(e) {
-        catch_e <<- e
-        do_catch
-      }
-    )
+        },
+        list(...),
+        result
+      )
+
+      valueWithVisible(result)
+    }
   }
 
   if (!is.null(domain)) {