Fix observeEvent stack trace stripping (#4163)

* Fix observeEvent stack trace stripping

* Add unit test

* Add deep stack version of unit test

NEWS.md

@@ -26,6 +26,8 @@
 
 * Updating the choices of a `selectizeInput()` via `updateSelectizeInput()` with `server = TRUE` no longer retains the selected choice as a deselected option if the current value is not part of the new choices. (@dvg-p4 #4142)
 
+* Fixed a bug where stack traces from `observeEvent` were being stripped of stack frames too aggressively.
+
 # shiny 1.9.1
 
 ## Bug fixes

R/reactives.R

@@ -2304,7 +2304,7 @@ observeEvent <- function(eventExpr, handlerExpr,
     priority = priority,
     domain = domain,
     autoDestroy = TRUE,
-    ..stacktraceon = FALSE # TODO: Does this go in the bindEvent?
+    ..stacktraceon = TRUE
   ))
 
   o <- inject(bindEvent(

tests/testthat/test-stacks.R

@@ -206,6 +206,57 @@ test_that("validation error logging", {
   captureErrorLog(validate("boom"))
   expect_null(caught)
 
+  caught <- NULL
   captureErrorLog(stop("boom"))
   expect_true(!is.null(caught))
 })
+
+test_that("observeEvent is not overly stripped (#4162)", {
+  caught <- NULL
+  ..stacktraceoff..(
+    ..stacktracefloor..({
+      observeEvent(1, {
+        tryCatch(
+          captureStackTraces(stop("boom")),
+          error = function(cond) {
+            caught <<- cond
+          }
+        )
+      })
+      flushReact()
+    })
+  )
+  st_str <- capture.output(printStackTrace(caught), type = "message")
+  expect_true(any(grepl("observeEvent\\(1\\)", st_str)))
+
+  # Now same thing, but deep stack trace version
+
+  A__ <- function() {
+    promises::then(promises::promise_resolve(TRUE), ~{
+      stop("boom")
+    })
+  }
+
+  B__ <- function() {
+    promises::then(promises::promise_resolve(TRUE), ~{
+      A__()
+    })
+  }
+
+  caught <- NULL
+  ..stacktraceoff..(
+    ..stacktracefloor..({
+      observeEvent(1, {
+        captureStackTraces(promises::catch(B__(), ~{
+          caught <<- .
+        }))
+      })
+      flushReact()
+      wait_for_it()
+    })
+  )
+  st_str <- capture.output(printStackTrace(caught), type = "message")
+  # cat(st_str, sep = "\n")
+  expect_true(any(grepl("A__", st_str)))
+  expect_true(any(grepl("B__", st_str)))
+})