Fix #3250 (#3602)

* Fix #3250

pruneStackTrace was interacting badly with dplyr errors. I'm still
not sure what causes these new cases, but the new behavior seems to
be much better, with no downside that I can think of.

* Fix existing unit tests

* Update news

Co-authored-by: Carson Sievert <[email protected]>

Author: jcheng5

NEWS.md

@@ -43,7 +43,9 @@ shiny development
 
 * Closed rstudio/shinytest2#222: When restoring a context (i.e., bookmarking) from a URL, Shiny now better handles a trailing `=` after `_inputs_` and `_values_`. (#3648)
 
-* Closed #3581: Errors in throttled/debounced reactive expressions cause session to exit. (#3624)
+* Closed #3581: Errors in throttled/debounced reactive expressions no longer cause the session to exit. (#3624)
+
+* Closed #3250:`{rlang}`/`{tidyeval}` conditions (i.e., warnings and errors) are no longer filtered from stack traces. (#3602)
 
 
 shiny 1.7.1

R/conditions.R

@@ -421,8 +421,17 @@ pruneStackTrace <- function(parents) {
   # Loop over the parent indices. Anything that is not parented by current_node
   # (a.k.a. last-known-good node), or is a dupe, can be discarded. Anything that
   # is kept becomes the new current_node.
+  #
+  # jcheng 2022-03-18: Two more reasons a node can be kept:
+  #   1. parent is 0
+  #   2. parent is i
+  # Not sure why either of these situations happen, but they're common when
+  # interacting with rlang/dplyr errors. See issue rstudio/shiny#3250 for repro
+  # cases.
   include <- vapply(seq_along(parents), function(i) {
-    if (!is_dupe[[i]] && parents[[i]] == current_node) {
+    if ((!is_dupe[[i]] && parents[[i]] == current_node) ||
+        parents[[i]] == 0 ||
+        parents[[i]] == i) {
       current_node <<- i
       TRUE
     } else {

tests/testthat/test-stacks-pruning.R

@@ -1,30 +1,33 @@
-capture <- function() {
-  list(
-    calls = sys.calls(),
-    parents = sys.parents()
-  )
-}
+foo <- function() {
+  capture <- function() {
+    list(
+      calls = sys.calls(),
+      parents = sys.parents()
+    )
+  }
 
-capture_1 <- function() {
-  capture()
-}
+  capture_1 <- function() {
+    capture()
+  }
 
-capture_2 <- function() {
-  capture_1()
-}
+  capture_2 <- function() {
+    capture_1()
+  }
 
-res <- do.call(
-  identity,
-  list(
-    identity(capture_2())
+  do.call(
+    identity,
+    list(
+      identity(capture_2())
+    )
   )
-)
-res$calls <- tail(res$calls, 5)
-res$parents <- tail(res$parents - (length(res$parents) - 5), 5)
+}
+res <- foo()
+res$calls <- tail(res$calls, 6)
+res$parents <- tail(res$parents - (length(res$parents) - 6), 6)
 
 describe("stack pruning", {
   it("passes basic example", {
-    expect_equal(pruneStackTrace(res$parents), c(F, F, T, T, T))
-    expect_equal(lapply(list(res$parents), pruneStackTrace), list(c(F, F, T, T, T)))
+    expect_equal(pruneStackTrace(res$parents), c(T, F, F, T, T, T))
+    expect_equal(lapply(list(res$parents), pruneStackTrace), list(c(T, F, F, T, T, T)))
   })
 })