Skip to content

Commit

Permalink
Use deep stack deduplication instead of elision
Browse files Browse the repository at this point in the history
This hopefully will avoid any potential ..stacktraceon../off..
scoring issues, and will be more useful for users. The downside
is that it's still possible to have uselessly large deep stack
traces, but at least that will only happen now if you have
manually written gigantic async/promise chains by hand or maybe
did some clever metaprogramming. The coro case should be fine.
  • Loading branch information
jcheng5 committed Dec 5, 2024
1 parent a533b05 commit ea6d093
Show file tree
Hide file tree
Showing 4 changed files with 255 additions and 124 deletions.
2 changes: 1 addition & 1 deletion NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -6,7 +6,7 @@

* When spinners and the pulse busy indicators are enabled, Shiny now shows the pulse indicator when dynamic UI elements are recalculating if no other spinners are present in the app. (#4137)

* The number of deep stack traces (stack traces that are tracked across steps in an async promise chain) Shiny will collect is no longer unbounded. The default is now 8, but can be adjusted by setting the `shiny.deepstacktrace` option, for example `options(shiny.deepstacktrace=12L)` to set the limit to 12. You can also set this option to `FALSE` to disable deep stack trace collection (for performance reasons) or `TRUE` to collect deep stack traces with no limit. (#4156)
* Improve collection of deep stack traces (stack traces that are tracked across steps in an async promise chain) with `coro` async generators such as `elmer` chat streams. Previously, Shiny treated each iteration of an async generator as a distinct deep stack, leading to pathologically long stack traces; now, Shiny only keeps/prints unique deep stack trace, discarding duplicates. (#4156)

## Bug fixes

Expand Down
104 changes: 34 additions & 70 deletions R/conditions.R
Original file line number Diff line number Diff line change
Expand Up @@ -130,60 +130,37 @@ captureStackTraces <- function(expr) {
#' @include globals.R
.globals$deepStack <- NULL

# (Warning, this is pretty crazy)
#
# appendWithLimit lets us append an element to a list, but if the list starts to
# exceed a limit, it will start eliding elements from the middle of the list.
# At the point of elision, it will insert a placeholder integer that indicates
# how many elements were elided.
#
# This is useful for storing deep stack traces, where we don't want to overwhelm
# the user with a huge number of stack traces, but both the head and tail may
# contain important information.
#
# Example:
# lst <- list("a", "b", "c", "d")
#
# appendWithLimit(lst, "e", limit = 4)
# # Result: list("a", 1L, "c", "d", "e")
#
# appendWithLimit(lst, "e", limit = 4, retain_first_n = 2L)
# # Result: list("a", "b", 1L, "d", "e")
appendWithLimit <- function(lst, x, limit, retain_first_n = 1L) {
# Sanity check that the parameters make sense
stopifnot(retain_first_n > 0)
stopifnot(limit > retain_first_n)
stopifnot(!is.null(x))
stopifnot(is.null(lst) || is.list(lst))

elide_count_index <- which(vapply(lst, is.integer, logical(1)))
elide_count <- sum(as.integer(lst[elide_count_index]))

# Sanity check -- shouldn't have more than one elide placeholder
stopifnot(length(elide_count_index) <= 1L)
if (length(elide_count_index) == 1L) {
# For a given list, retain_first_n must remain constant between calls to
# appendWithLimit; that is, the elide count, if one exists, must be exactly
# where we expect it to be
stopifnot(elide_count_index == retain_first_n + 1L)
getCallStackDigest <- function(callStack, warn = FALSE) {
dg <- attr(callStack, "digest", exact = TRUE)
if (!is.null(dg)) {
return(dg)
}

element_count <- length(lst) - length(elide_count_index)
if (element_count < limit) {
# No need to elide anything, just append and return
c(lst, list(x))
if (isTRUE(warn)) {
warning("Call stack doesn't have a cached digest; expensively computing one now")
}

digest::digest(getCallNames(callStack), algo = "md5")
}

saveCallStackDigest <- function(callStack) {
attr(callStack, "digest") <- getCallStackDigest(callStack, warn = FALSE)
callStack
}

# Appends a call stack to a list of call stacks, but only if it's not already
# in the list. The list is deduplicated by digest; ideally the digests on the
# list are cached before calling this function (you will get a warning if not).
appendCallStackWithDedupe <- function(lst, x) {
digests <- vapply(lst, getCallStackDigest, character(1), warn = TRUE)
xdigest <- getCallStackDigest(x, warn = FALSE)
stopifnot(all(nzchar(digests)))
stopifnot(length(xdigest) == 1)
stopifnot(nzchar(xdigest))
if (xdigest %in% digests) {
return(lst)
} else {
# The list may or may not already contain an elide count. If it does, we
# need to increment it. If it doesn't, we need to add one.

# Keep the first `retain_first_n` elements...
prefix <- utils::head(lst, retain_first_n)
# ...and just enough of the last elements to leave room for the new one
suffix <- utils::tail(lst, limit - retain_first_n - 1L)
# Calculate the new elide count
new_elide_count <- (element_count - limit + 1L) + elide_count
# Construct the final list
c(prefix, list(as.integer(new_elide_count)), suffix, list(x))
return(c(lst, list(x)))
}
}

Expand All @@ -199,13 +176,14 @@ createStackTracePromiseDomain <- function() {
currentStack <- sys.calls()
currentParents <- sys.parents()
attr(currentStack, "parents") <- currentParents
currentStack <- saveCallStackDigest(currentStack)
currentDeepStack <- .globals$deepStack
}
function(...) {
# Fulfill time
if (deepStacksEnabled()) {
origDeepStack <- .globals$deepStack
.globals$deepStack <- appendWithLimit(currentDeepStack, currentStack, deepStackLimit())
.globals$deepStack <- appendCallStackWithDedupe(currentDeepStack, currentStack)
on.exit(.globals$deepStack <- origDeepStack, add = TRUE)
}

Expand All @@ -222,13 +200,14 @@ createStackTracePromiseDomain <- function() {
currentStack <- sys.calls()
currentParents <- sys.parents()
attr(currentStack, "parents") <- currentParents
currentStack <- saveCallStackDigest(currentStack)
currentDeepStack <- .globals$deepStack
}
function(...) {
# Fulfill time
if (deepStacksEnabled()) {
origDeepStack <- .globals$deepStack
.globals$deepStack <- appendWithLimit(currentDeepStack, currentStack, deepStackLimit())
.globals$deepStack <- appendCallStackWithDedupe(currentDeepStack, currentStack)
on.exit(.globals$deepStack <- origDeepStack, add = TRUE)
}

Expand All @@ -248,30 +227,15 @@ createStackTracePromiseDomain <- function() {
}

deepStacksEnabled <- function() {
deepStackLimit() > 0L
}

deepStackLimit <- function() {
opt <- getOption("shiny.deepstacktrace", 8L)
if (!is.numeric(opt) && !is.logical(opt)) {
opt <- FALSE
}
stopifnot(length(opt) == 1L)

if (rlang::is_false(opt)) {
0L
} else if (isTRUE(opt)) {
Inf
} else {
as.integer(opt)
}
getOption("shiny.deepstacktrace", TRUE)
}

doCaptureStack <- function(e) {
if (is.null(attr(e, "stack.trace", exact = TRUE))) {
calls <- sys.calls()
parents <- sys.parents()
attr(calls, "parents") <- parents
calls <- saveCallStackDigest(calls)
attr(e, "stack.trace") <- calls
}
if (deepStacksEnabled()) {
Expand Down
213 changes: 211 additions & 2 deletions tests/testthat/_snaps/stacks-deep.md
Original file line number Diff line number Diff line change
Expand Up @@ -363,7 +363,7 @@
: test_files_serial
: test_files

# deep stack culling
# deep stacks long chain

Code
cat(sep = "\n", stacktrace <- formatError(dserr))
Expand Down Expand Up @@ -451,7 +451,216 @@
: lapply
: test_files_serial
: test_files
[ reached getOption("shiny.deepstacktrace") -- omitted 7 more stack traces ]
From earlier call:
: domain$wrapOnFulfilled
: promiseDomain$onThen
: action
: promise
: promise$then
: then
: %...>%
: H__ [test-stacks-deep.R#XXX]
: onFulfilled
: callback
: <Anonymous>
: onFulfilled
: handleFulfill
: <Anonymous>
: execCallbacks
: later::run_now
: wait_for_it
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: test_that
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: source_file
: FUN
: lapply
: test_files_serial
: test_files
From earlier call:
: domain$wrapOnFulfilled
: promiseDomain$onThen
: action
: promise
: promise$then
: then
: %...>%
: G__ [test-stacks-deep.R#XXX]
: onFulfilled
: callback
: <Anonymous>
: onFulfilled
: handleFulfill
: <Anonymous>
: execCallbacks
: later::run_now
: wait_for_it
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: test_that
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: source_file
: FUN
: lapply
: test_files_serial
: test_files
From earlier call:
: domain$wrapOnFulfilled
: promiseDomain$onThen
: action
: promise
: promise$then
: then
: %...>%
: F__ [test-stacks-deep.R#XXX]
: onFulfilled
: callback
: <Anonymous>
: onFulfilled
: handleFulfill
: <Anonymous>
: execCallbacks
: later::run_now
: wait_for_it
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: test_that
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: source_file
: FUN
: lapply
: test_files_serial
: test_files
From earlier call:
: domain$wrapOnFulfilled
: promiseDomain$onThen
: action
: promise
: promise$then
: then
: %...>%
: E__ [test-stacks-deep.R#XXX]
: onFulfilled
: callback
: <Anonymous>
: onFulfilled
: handleFulfill
: <Anonymous>
: execCallbacks
: later::run_now
: wait_for_it
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: test_that
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: source_file
: FUN
: lapply
: test_files_serial
: test_files
From earlier call:
: domain$wrapOnFulfilled
: promiseDomain$onThen
: action
: promise
: promise$then
: then
: %...>%
: D__ [test-stacks-deep.R#XXX]
: onFulfilled
: callback
: <Anonymous>
: onFulfilled
: handleFulfill
: <Anonymous>
: execCallbacks
: later::run_now
: wait_for_it
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: test_that
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: source_file
: FUN
: lapply
: test_files_serial
: test_files
From earlier call:
: domain$wrapOnFulfilled
: promiseDomain$onThen
: action
: promise
: promise$then
: then
: %...>%
: C__ [test-stacks-deep.R#XXX]
: onFulfilled
: callback
: <Anonymous>
: onFulfilled
: handleFulfill
: <Anonymous>
: execCallbacks
: later::run_now
: wait_for_it
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: test_that
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: source_file
: FUN
: lapply
: test_files_serial
: test_files
From earlier call:
: domain$wrapOnFulfilled
: promiseDomain$onThen
: action
: promise
: promise$then
: then
: %...>%
: B__ [test-stacks-deep.R#XXX]
: onFulfilled
: callback
: <Anonymous>
: onFulfilled
: handleFulfill
: <Anonymous>
: execCallbacks
: later::run_now
: wait_for_it
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: test_that
: eval [test-stacks-deep.R#XXX]
: eval
: test_code
: source_file
: FUN
: lapply
: test_files_serial
: test_files
From earlier call:
: domain$wrapOnFulfilled
: promiseDomain$onThen
Expand Down
Loading

0 comments on commit ea6d093

Please sign in to comment.