From 79ee25620f9bc8388f74c2dbf3b59b5cd311e630 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Fri, 6 Dec 2024 10:17:05 -0800 Subject: [PATCH] Limit deep stack growth (#4156) * Limit deep stack growth * Improvements to deep stack trace culling - Keep around the first deep stack trace; it may have useful information. (We may want to change this in the future to keep the first two stack traces, or even make it an option) - Print out an indicator that we've elided stack traces, and how many * Add comments * Add NEWS item * Add test for unlimited deep stacks * Code review feedback * Code review feedback Co-authored-by: Carson Sievert * Use head() over indexing Co-authored-by: Carson Sievert * Improve unit test robustness * Remove vector indices from snapshot * Make stack trace stripping work across deep stacks * Pass tests * Try passing tests again * Rename keep_head to retain_first_n * Remove misleading variable assignment * Add more comments, refine dropTrivialTestFrames * Don't call stripStackTraces if we're not stripping * Use deep stack deduplication instead of elision 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. * Add coro-based unit test * Use rlang::hash, it's much faster * typo Co-authored-by: Carson Sievert * Remove unnecessary logic * Simplify/robustify reactlog version checking test * Warn only once on call stack digest cache miss * Super conservatively wrap appendCallStackWithDupe in try/catch * Use more specific attribute name Co-authored-by: Carson Sievert * Remove excessively cautious try/catch --------- Co-authored-by: Carson Sievert --- DESCRIPTION | 1 + NEWS.md | 2 + R/conditions.R | 233 ++++++--- tests/testthat/_snaps/stacks-deep.md | 685 +++++++++++++++++++++++++++ tests/testthat/test-reactlog.R | 12 +- tests/testthat/test-stacks-deep.R | 211 +++++++++ 6 files changed, 1067 insertions(+), 77 deletions(-) create mode 100644 tests/testthat/_snaps/stacks-deep.md diff --git a/DESCRIPTION b/DESCRIPTION index 9d0ea67871..11a6c31bf7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -95,6 +95,7 @@ Imports: cachem (>= 1.1.0), lifecycle (>= 0.2.0) Suggests: + coro (>= 1.1.0), datasets, DT, Cairo (>= 1.5-5), diff --git a/NEWS.md b/NEWS.md index aebc2a5063..359deea445 100644 --- a/NEWS.md +++ b/NEWS.md @@ -6,6 +6,8 @@ * 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) +* 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 * Fixed a bug in `conditionalPanel()` that would cause the panel to repeatedly show/hide itself when the provided condition was not boolean. (@kamilzyla, #4127) diff --git a/R/conditions.R b/R/conditions.R index 670a87432e..164792a8de 100644 --- a/R/conditions.R +++ b/R/conditions.R @@ -130,6 +130,44 @@ captureStackTraces <- function(expr) { #' @include globals.R .globals$deepStack <- NULL +getCallStackDigest <- function(callStack, warn = FALSE) { + dg <- attr(callStack, "shiny.stack.digest", exact = TRUE) + if (!is.null(dg)) { + return(dg) + } + + if (isTRUE(warn)) { + rlang::warn( + "Call stack doesn't have a cached digest; expensively computing one now", + .frequency = "once", + .frequency_id = "deepstack-uncached-digest-warning" + ) + } + + rlang::hash(getCallNames(callStack)) +} + +saveCallStackDigest <- function(callStack) { + attr(callStack, "shiny.stack.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 = TRUE) + stopifnot(all(nzchar(digests))) + stopifnot(length(xdigest) == 1) + stopifnot(nzchar(xdigest)) + if (xdigest %in% digests) { + return(lst) + } else { + return(c(lst, list(x))) + } +} + createStackTracePromiseDomain <- function() { # These are actually stateless, we wouldn't have to create a new one each time # if we didn't want to. They're pretty cheap though. @@ -142,13 +180,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 <- c(currentDeepStack, list(currentStack)) + .globals$deepStack <- appendCallStackWithDedupe(currentDeepStack, currentStack) on.exit(.globals$deepStack <- origDeepStack, add = TRUE) } @@ -165,13 +204,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 <- c(currentDeepStack, list(currentStack)) + .globals$deepStack <- appendCallStackWithDedupe(currentDeepStack, currentStack) on.exit(.globals$deepStack <- origDeepStack, add = TRUE) } @@ -199,6 +239,7 @@ doCaptureStack <- function(e) { calls <- sys.calls() parents <- sys.parents() attr(calls, "parents") <- parents + calls <- saveCallStackDigest(calls) attr(e, "stack.trace") <- calls } if (deepStacksEnabled()) { @@ -281,86 +322,113 @@ printStackTrace <- function(cond, full = get_devmode_option("shiny.fullstacktrace", FALSE), offset = getOption("shiny.stacktraceoffset", TRUE)) { - should_drop <- !full - should_strip <- !full - should_prune <- !full - - stackTraceCalls <- c( + stackTraces <- c( attr(cond, "deep.stack.trace", exact = TRUE), list(attr(cond, "stack.trace", exact = TRUE)) ) - stackTraceParents <- lapply(stackTraceCalls, attr, which = "parents", exact = TRUE) - stackTraceCallNames <- lapply(stackTraceCalls, getCallNames) - stackTraceCalls <- lapply(stackTraceCalls, offsetSrcrefs, offset = offset) - - # Use dropTrivialFrames logic to remove trailing bits (.handleSimpleError, h) - if (should_drop) { - # toKeep is a list of logical vectors, of which elements (stack frames) to keep - toKeep <- lapply(stackTraceCallNames, dropTrivialFrames) - # We apply the list of logical vector indices to each data structure - stackTraceCalls <- mapply(stackTraceCalls, FUN = `[`, toKeep, SIMPLIFY = FALSE) - stackTraceCallNames <- mapply(stackTraceCallNames, FUN = `[`, toKeep, SIMPLIFY = FALSE) - stackTraceParents <- mapply(stackTraceParents, FUN = `[`, toKeep, SIMPLIFY = FALSE) + # Stripping of stack traces is the one step where the different stack traces + # interact. So we need to do this in one go, instead of individually within + # printOneStackTrace. + if (!full) { + stripResults <- stripStackTraces(lapply(stackTraces, getCallNames)) + } else { + # If full is TRUE, we don't want to strip anything + stripResults <- rep_len(list(TRUE), length(stackTraces)) } - delayedAssign("all_true", { - # List of logical vectors that are all TRUE, the same shape as - # stackTraceCallNames. Delay the evaluation so we don't create it unless - # we need it, but if we need it twice then we don't pay to create it twice. - lapply(stackTraceCallNames, function(st) { - rep_len(TRUE, length(st)) - }) - }) - - # stripStackTraces and lapply(stackTraceParents, pruneStackTrace) return lists - # of logical vectors. Use mapply(FUN = `&`) to boolean-and each pair of the - # logical vectors. - toShow <- mapply( - if (should_strip) stripStackTraces(stackTraceCallNames) else all_true, - if (should_prune) lapply(stackTraceParents, pruneStackTrace) else all_true, - FUN = `&`, + mapply( + seq_along(stackTraces), + rev(stackTraces), + rev(stripResults), + FUN = function(i, trace, stripResult) { + if (is.integer(trace)) { + noun <- if (trace > 1L) "traces" else "trace" + message("[ reached getOption(\"shiny.deepstacktrace\") -- omitted ", trace, " more stack ", noun, " ]") + } else { + if (i != 1) { + message("From earlier call:") + } + printOneStackTrace( + stackTrace = trace, + stripResult = stripResult, + full = full, + offset = offset + ) + } + # No mapply return value--we're just printing + NULL + }, SIMPLIFY = FALSE ) - dfs <- mapply(seq_along(stackTraceCalls), rev(stackTraceCalls), rev(stackTraceCallNames), rev(toShow), FUN = function(i, calls, nms, index) { - st <- data.frame( - num = rev(which(index)), - call = rev(nms[index]), - loc = rev(getLocs(calls[index])), - category = rev(getCallCategories(calls[index])), - stringsAsFactors = FALSE - ) + invisible() +} - if (i != 1) { - message("From earlier call:") - } +printOneStackTrace <- function(stackTrace, stripResult, full, offset) { + calls <- offsetSrcrefs(stackTrace, offset = offset) + callNames <- getCallNames(stackTrace) + parents <- attr(stackTrace, "parents", exact = TRUE) - if (nrow(st) == 0) { - message(" [No stack trace available]") - } else { - width <- floor(log10(max(st$num))) + 1 - formatted <- paste0( - " ", - formatC(st$num, width = width), - ": ", - mapply(paste0(st$call, st$loc), st$category, FUN = function(name, category) { - if (category == "pkg") - crayon::silver(name) - else if (category == "user") - crayon::blue$bold(name) - else - crayon::white(name) - }), - "\n" - ) - cat(file = stderr(), formatted, sep = "") - } + should_drop <- !full + should_strip <- !full + should_prune <- !full - st - }, SIMPLIFY = FALSE) + if (should_drop) { + toKeep <- dropTrivialFrames(callNames) + calls <- calls[toKeep] + callNames <- callNames[toKeep] + parents <- parents[toKeep] + stripResult <- stripResult[toKeep] + } - invisible() + toShow <- rep(TRUE, length(callNames)) + if (should_prune) { + toShow <- toShow & pruneStackTrace(parents) + } + if (should_strip) { + toShow <- toShow & stripResult + } + + # If we're running in testthat, hide the parts of the stack trace that can + # vary based on how testthat was launched. It's critical that this is not + # happen at the same time as dropTrivialFrames, which happens before + # pruneStackTrace; because dropTrivialTestFrames removes calls from the top + # (or bottom? whichever is the oldest?) of the stack, it breaks `parents` + # which is based on absolute indices of calls. dropTrivialFrames gets away + # with this because it only removes calls from the opposite side of the stack. + toShow <- toShow & dropTrivialTestFrames(callNames) + + st <- data.frame( + num = rev(which(toShow)), + call = rev(callNames[toShow]), + loc = rev(getLocs(calls[toShow])), + category = rev(getCallCategories(calls[toShow])), + stringsAsFactors = FALSE + ) + + if (nrow(st) == 0) { + message(" [No stack trace available]") + } else { + width <- floor(log10(max(st$num))) + 1 + formatted <- paste0( + " ", + formatC(st$num, width = width), + ": ", + mapply(paste0(st$call, st$loc), st$category, FUN = function(name, category) { + if (category == "pkg") + crayon::silver(name) + else if (category == "user") + crayon::blue$bold(name) + else + crayon::white(name) + }), + "\n" + ) + cat(file = stderr(), formatted, sep = "") + } + + invisible(st) } stripStackTraces <- function(stackTraces, values = FALSE) { @@ -458,6 +526,33 @@ dropTrivialFrames <- function(callnames) { ) } +dropTrivialTestFrames <- function(callnames) { + if (!identical(Sys.getenv("TESTTHAT_IS_SNAPSHOT"), "true")) { + return(rep_len(TRUE, length(callnames))) + } + + hideable <- callnames %in% c( + "test", + "devtools::test", + "test_check", + "testthat::test_check", + "test_dir", + "testthat::test_dir", + "test_file", + "testthat::test_file", + "test_local", + "testthat::test_local" + ) + + firstGoodCall <- min(which(!hideable)) + toRemove <- firstGoodCall - 1L + + c( + rep_len(FALSE, toRemove), + rep_len(TRUE, length(callnames) - toRemove) + ) +} + offsetSrcrefs <- function(calls, offset = TRUE) { if (offset) { srcrefs <- getSrcRefs(calls) diff --git a/tests/testthat/_snaps/stacks-deep.md b/tests/testthat/_snaps/stacks-deep.md new file mode 100644 index 0000000000..0b7ca14c8d --- /dev/null +++ b/tests/testthat/_snaps/stacks-deep.md @@ -0,0 +1,685 @@ +# deep stack capturing + + Code + cat(sep = "\n", formatError(err)) + Output + Error in onFinally: boom + : stop + : onFinally [test-stacks-deep.R#XXX] + : onFulfilled + : callback + : + : onFulfilled + : handleFulfill + : + : 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 + : self$then + : promise$finally + : finally + : onRejected [test-stacks-deep.R#XXX] + : callback + : + : onRejected + : handleReject + : + : 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$wrapOnRejected + : promiseDomain$onThen + : action + : promise + : self$then + : promise$catch + : catch + : %...!% + : onFulfilled [test-stacks-deep.R#XXX] + : callback + : + : onFulfilled + : handleFulfill + : + : 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 + : %...>% + : 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 + +--- + + Code + cat(sep = "\n", formatError(err, full = TRUE)) + Output + Error in onFinally: boom + : h + : .handleSimpleError + : stop + : onFinally [test-stacks-deep.R#XXX] + : onFulfilled + : withCallingHandlers + : callback + : force + : reenter_promise_domain + : + : onFulfilled + : withVisible + : private$doResolve + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : base::tryCatch + : tryCatch + : resolve + : handleFulfill + : + : execCallbacks + : later::run_now + : wait_for_it + : eval [test-stacks-deep.R#XXX] + : eval + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : test_code + : test_that + : eval [test-stacks-deep.R#XXX] + : eval + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : test_code + : source_file + : FUN + : lapply + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : with_reporter + : test_files_serial + : test_files + From earlier call: + : domain$wrapOnFulfilled + : promiseDomain$onThen + : action + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : base::tryCatch + : tryCatch + : promise + : self$then + : promise$finally + : finally + : onRejected [test-stacks-deep.R#XXX] + : withCallingHandlers + : callback + : force + : reenter_promise_domain + : + : onRejected + : withVisible + : private$doResolve + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : base::tryCatch + : tryCatch + : resolve + : handleReject + : + : execCallbacks + : later::run_now + : wait_for_it + : eval [test-stacks-deep.R#XXX] + : eval + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : test_code + : test_that + : eval [test-stacks-deep.R#XXX] + : eval + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : test_code + : source_file + : FUN + : lapply + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : with_reporter + : test_files_serial + : test_files + From earlier call: + : domain$wrapOnRejected + : promiseDomain$onThen + : action + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : base::tryCatch + : tryCatch + : promise + : self$then + : promise$catch + : catch + : %...!% + : onFulfilled [test-stacks-deep.R#XXX] + : withCallingHandlers + : callback + : force + : reenter_promise_domain + : + : onFulfilled + : withVisible + : private$doResolve + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : base::tryCatch + : tryCatch + : resolve + : handleFulfill + : + : execCallbacks + : later::run_now + : wait_for_it + : eval [test-stacks-deep.R#XXX] + : eval + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : test_code + : test_that + : eval [test-stacks-deep.R#XXX] + : eval + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : test_code + : source_file + : FUN + : lapply + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : with_reporter + : test_files_serial + : test_files + From earlier call: + : domain$wrapOnFulfilled + : promiseDomain$onThen + : action + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : base::tryCatch + : tryCatch + : promise + : promise$then + : then + : %...>% + : withCallingHandlers [test-stacks-deep.R#XXX] + : domain$wrapSync + : promises::with_promise_domain + : captureStackTraces + : as.promise + : catch + : %...!% + : eval [test-stacks-deep.R#XXX] + : eval + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : test_code + : test_that + : eval [test-stacks-deep.R#XXX] + : eval + : withCallingHandlers + : doTryCatch + : tryCatchOne + : tryCatchList + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : test_code + : source_file + : FUN + : lapply + : doTryCatch + : tryCatchOne + : tryCatchList + : tryCatch + : with_reporter + : test_files_serial + : test_files + +# deep stacks long chain + + Code + cat(sep = "\n", stacktrace <- formatError(dserr)) + Output + Error in onFulfilled: boom + : stop + : onFulfilled [test-stacks-deep.R#XXX] + : callback + : + : onFulfilled + : handleFulfill + : + : 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 + : %...>% + : J__ [test-stacks-deep.R#XXX] + : onFulfilled + : callback + : + : onFulfilled + : handleFulfill + : + : 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 + : %...>% + : I__ [test-stacks-deep.R#XXX] + : onFulfilled + : callback + : + : onFulfilled + : handleFulfill + : + : 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 + : %...>% + : H__ [test-stacks-deep.R#XXX] + : onFulfilled + : callback + : + : onFulfilled + : handleFulfill + : + : 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 + : + : onFulfilled + : handleFulfill + : + : 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 + : + : onFulfilled + : handleFulfill + : + : 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 + : + : onFulfilled + : handleFulfill + : + : 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 + : + : onFulfilled + : handleFulfill + : + : 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 + : + : onFulfilled + : handleFulfill + : + : 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 + : + : onFulfilled + : handleFulfill + : + : 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 + : %...>% + : A__ [test-stacks-deep.R#XXX] + : 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 + diff --git a/tests/testthat/test-reactlog.R b/tests/testthat/test-reactlog.R index 6c26cc9f68..3a9799af5f 100644 --- a/tests/testthat/test-reactlog.R +++ b/tests/testthat/test-reactlog.R @@ -129,13 +129,9 @@ test_that("message logger appears", { test_that("reactlog_version is as expected", { - suggests <- strsplit(packageDescription("shiny")$Suggests, ",")[[1]] - reactlog <- trimws( - grep("reactlog", suggests, value = TRUE) - ) - expect_length(reactlog, 1) - expect_equal( - reactlog, - sprintf("reactlog (>= %s)", reactlog_min_version) + expect_match( + packageDescription("shiny")$Suggests, + # The space between reactlog and the version number can include \n + sprintf("\\breactlog\\s+\\Q(>= %s)\\E", reactlog_min_version) ) }) diff --git a/tests/testthat/test-stacks-deep.R b/tests/testthat/test-stacks-deep.R index b4262b1ed6..eb335ad1e3 100644 --- a/tests/testthat/test-stacks-deep.R +++ b/tests/testthat/test-stacks-deep.R @@ -1,3 +1,47 @@ +formatError <- function(err, full = FALSE, offset = TRUE, cleanPaths = TRUE) { + # This complicated capturing code is necessary because printStackTrace uses a + # combination of `message()` and `cat(file=stderr())` to print the error, + # stack traces, and stack trace boundaries ("From earlier call:"). We want to + # treat all of it as part of the same string. + + str <- noquote(capture.output( + suppressWarnings( + suppressMessages( + withCallingHandlers( + printError(err, full = full, offset = offset), + warning = function(cnd) { + cat(conditionMessage(cnd), "\n", sep = "", file = stderr()) + }, + message = function(cnd) { + cat(conditionMessage(cnd), file = stderr()) + } + ) + ) + ), + type = "message" + )) + + # Remove directories and line numbers from file/line references, e.g. + # 53: callback [/Users/jcheng/Development/rstudio/shiny/R/conditions.R#155] + # becomes + # 53: callback [conditions.R#XXX] + # + # This is to make the snapshot tests more stable across different machines and + # ignores benign code movement within a file. + str <- sub("#\\d+\\]$", "#XXX]", str, perl = TRUE) + # Remove any file/line number reference that's not test-stacks-deep.R. These + # are just too inconsistent across different ways of invoking testthat--not + # relative vs. absolute paths, but whether the file/line number is included at + # all! + str <- sub(" \\[(?!test-stacks-deep.R)[^[]+#XXX\\]", "", str, perl = TRUE) + # The frame numbers vary too much between different ways of invoking testthat + # ("Run Tests" editor toolbar button and "Test" Build tab button in RStudio, + # devtools::test(), etc.) so we blank them out. + str <- sub("^[ \\d]+:", " :", str, perl = TRUE) + str +} + + describe("deep stack trace filtering", { it("passes smoke test", { st <- list( @@ -43,3 +87,170 @@ describe("deep stack trace filtering", { ) }) }) + +test_that("deep stack capturing", { + `%...>%` <- promises::`%...>%` + `%...!%` <- promises::`%...!%` + finally <- promises::finally + + err <- NULL + captureStackTraces({ + promise_resolve("one") %...>% { + promise_reject("error") %...!% { + finally(promise_resolve("two"), ~{ + stop("boom") + }) + } + } + }) %...!% (function(err) { + err <<- err + }) + + wait_for_it() + + expect_s3_class(err, "error", exact = FALSE) + expect_snapshot(cat(sep="\n", formatError(err))) + expect_snapshot(cat(sep="\n", formatError(err, full = TRUE))) +}) + +test_that("deep stack capturing within reactives", { + rerr <- NULL + observe({ + promise_resolve("one") %...>% { + promise_resolve("two") %...>% { + stop("boom") + } + } %...!% (function(err) { + rerr <<- err + }) + }) + + flushReact() + wait_for_it() + + expect_s3_class(rerr, "error", exact = FALSE) + expect_length(attr(rerr, "deep.stack.trace"), 2) +}) + +test_that("deep stacks long chain", { + op <- options(shiny.deepstacktrace = 3L) + on.exit(options(op), add = TRUE, after = FALSE) + + # Without deep stack traces, the stack trace would give no clue that the error + # originally started from a call to `A__()`. With deep stack traces, we can + # see that the error originated from `A__` and passed through `I__` and `J__`. + # But due to culling, we don't see `B__` through `H__`--these are omitted for + # brevity and to prevent unbounded growth of the accounting we do. + + A__ <- function() promise_resolve(TRUE) %...>% B__() + B__ <- function(x) promise_resolve(TRUE) %...>% C__() + C__ <- function(x) promise_resolve(TRUE) %...>% D__() + D__ <- function(x) promise_resolve(TRUE) %...>% E__() + E__ <- function(x) promise_resolve(TRUE) %...>% F__() + F__ <- function(x) promise_resolve(TRUE) %...>% G__() + G__ <- function(x) promise_resolve(TRUE) %...>% H__() + H__ <- function(x) promise_resolve(TRUE) %...>% I__() + I__ <- function(x) promise_resolve(TRUE) %...>% J__() + J__ <- function(x) promise_resolve(TRUE) %...>% { stop("boom") } + + dserr <- NULL + captureStackTraces( + A__() + ) %...!% (function(err) { + dserr <<- err + }) + + wait_for_it() + + expect_s3_class(dserr, "error", exact = FALSE) + expect_snapshot(cat(sep="\n", stacktrace <- formatError(dserr))) + # Ensure we dropTrivialTestFrames only when snapshotting + expect_false(length(stacktrace) == length(formatError(dserr))) + # Ensure that A__ through J__ are present in the traces + for (letter in LETTERS[1:10]) { + expect_length(which(grepl(paste0(letter, "__"), stacktrace)), 1L) + } +}) + +test_that("Deep stack deduplication", { + recursive_promise <- function(n) { + if (n <= 0) { + stop("boom") + } + + p <- promises::promise_resolve(TRUE) + promises::then(p, ~{ + recursive_promise(n - 1) + }) + } + + op <- options(shiny.deepstacktrace = TRUE) + on.exit(options(op), add = TRUE, after = FALSE) + + uerr <- NULL + captureStackTraces(recursive_promise(100)) %...!% (function(err) { + uerr <<- err + }) + + wait_for_it() + + expect_s3_class(uerr, "error", exact = FALSE) + # Even though we traveled through 100 promises recursively, we only retained + # the unique ones + expect_identical(length(attr(uerr, "deep.stack.trace", exact = TRUE)), 2L) +}) + +test_that("stack trace stripping works", { + A__ <- function() promise_resolve(TRUE) %...>% B__() + B__ <- function(x) promise_resolve(TRUE) %...>% { ..stacktraceoff..(C__()) } + C__ <- function(x) promise_resolve(TRUE) %...>% D__() + D__ <- function(x) promise_resolve(TRUE) %...>% { ..stacktraceon..(E__()) } + E__ <- function(x) promise_resolve(TRUE) %...>% { stop("boom") } + + strperr <- NULL + captureStackTraces(A__()) %...!% (function(err) { + strperr <<- err + }) + + ..stacktracefloor..( + wait_for_it() + ) + + expect_s3_class(strperr, "error", exact = FALSE) + + str <- formatError(strperr) + expect_length(which(grepl("A__", str)), 1L) + expect_length(which(grepl("B__", str)), 1L) + expect_length(which(grepl("C__", str)), 0L) + expect_length(which(grepl("D__", str)), 0L) + expect_length(which(grepl("E__", str)), 1L) + + str_full <- formatError(strperr, full = TRUE) + expect_length(which(grepl("A__", str_full)), 1L) + expect_length(which(grepl("B__", str_full)), 1L) + expect_length(which(grepl("C__", str_full)), 1L) + expect_length(which(grepl("D__", str_full)), 1L) + expect_length(which(grepl("E__", str_full)), 1L) +}) + +test_that("coro async generator deep stack count is low", { + gen <- coro::async_generator(function() { + for (i in 1:50) { + await(coro::async_sleep(0.001)) + yield(i) + } + stop("boom") + }) + + cgerr <- NULL + captureStackTraces( + coro::async_collect(gen()) %...!% (function(err) { + cgerr <<- err + }) + ) + + wait_for_it() + + expect_s3_class(cgerr, "error", exact = FALSE) + expect_length(attr(cgerr, "deep.stack.trace"), 2L) +})