From 458924569a8f8f69c324653418803aadb71d6cd0 Mon Sep 17 00:00:00 2001 From: Joe Cheng Date: Tue, 3 Dec 2024 13:23:50 -0800 Subject: [PATCH] Stack trace domain explosion (#4155) * Avoid way too many promise domains being activated Using `captureStackTraces` in wrapForContext is a bad idea, it piles on a new domain every time a handler is bound. * Use captureStackTraces, it means the same thing * Update promises version requirement * Add test for stack trace growth * Simplify stack trace snapshot tests The `category` column isn't a good candidate for snapshot testing, as its contents vary depending on how the package was loaded/installed. During devtools::test() or similar, shiny package code shows up as 'user'. But during CI, it doesn't show up as anything. --- DESCRIPTION | 2 +- R/react.R | 14 ++--- R/shiny.R | 2 +- tests/testthat/_snaps/stacks.md | 90 +++++++++++++++++++++++++++ tests/testthat/test-promise-domains.R | 49 +++++++++++++++ tests/testthat/test-stacks.R | 45 ++------------ 6 files changed, 154 insertions(+), 48 deletions(-) create mode 100644 tests/testthat/_snaps/stacks.md create mode 100644 tests/testthat/test-promise-domains.R diff --git a/DESCRIPTION b/DESCRIPTION index 08e0f6edea..9d0ea67871 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -83,7 +83,7 @@ Imports: R6 (>= 2.0), sourcetools, later (>= 1.0.0), - promises (>= 1.1.0), + promises (>= 1.3.2), tools, crayon, rlang (>= 0.4.10), diff --git a/R/react.R b/R/react.R index 5232486b8c..bdc0f4a938 100644 --- a/R/react.R +++ b/R/react.R @@ -53,10 +53,12 @@ Context <- R6Class( promises::with_promise_domain(reactivePromiseDomain(), { withReactiveDomain(.domain, { - env <- .getReactiveEnvironment() - rLog$enter(.reactId, id, .reactType, .domain) - on.exit(rLog$exit(.reactId, id, .reactType, .domain), add = TRUE) - env$runWith(self, func) + captureStackTraces({ + env <- .getReactiveEnvironment() + rLog$enter(.reactId, id, .reactType, .domain) + on.exit(rLog$exit(.reactId, id, .reactType, .domain), add = TRUE) + env$runWith(self, func) + }) }) }) }, @@ -223,9 +225,7 @@ wrapForContext <- function(func, ctx) { function(...) { .getReactiveEnvironment()$runWith(ctx, function() { - captureStackTraces( - func(...) - ) + func(...) }) } } diff --git a/R/shiny.R b/R/shiny.R index 55b70172bb..c5e1eadc15 100644 --- a/R/shiny.R +++ b/R/shiny.R @@ -2024,7 +2024,7 @@ ShinySession <- R6Class( tmpdata <- tempfile(fileext = ext) return(Context$new(getDefaultReactiveDomain(), '[download]')$run(function() { promises::with_promise_domain(reactivePromiseDomain(), { - promises::with_promise_domain(createStackTracePromiseDomain(), { + captureStackTraces({ self$incrementBusyCount() hybrid_chain( # ..stacktraceon matches with the top-level ..stacktraceoff.. diff --git a/tests/testthat/_snaps/stacks.md b/tests/testthat/_snaps/stacks.md new file mode 100644 index 0000000000..46741f909c --- /dev/null +++ b/tests/testthat/_snaps/stacks.md @@ -0,0 +1,90 @@ +# integration tests + + Code + df + Output + num call loc + 1 64 A [test-stacks.R#3] + 2 63 B [test-stacks.R#7] + 3 62 [test-stacks.R#11] + 4 42 C + 5 41 renderTable [test-stacks.R#18] + 6 40 func + 7 39 force + 8 38 withVisible + 9 37 withCallingHandlers + +--- + + Code + df + Output + num call loc + 1 67 h + 2 66 .handleSimpleError + 3 65 stop + 4 64 A [test-stacks.R#3] + 5 63 B [test-stacks.R#7] + 6 62 [test-stacks.R#11] + 7 61 ..stacktraceon.. + 8 60 .func + 9 59 withVisible + 10 58 withCallingHandlers + 11 57 contextFunc + 12 56 env$runWith + 13 55 withCallingHandlers + 14 54 domain$wrapSync + 15 53 promises::with_promise_domain + 16 52 captureStackTraces + 17 51 force + 18 50 domain$wrapSync + 19 49 promises::with_promise_domain + 20 48 withReactiveDomain + 21 47 domain$wrapSync + 22 46 promises::with_promise_domain + 23 45 ctx$run + 24 44 self$.updateValue + 25 43 ..stacktraceoff.. + 26 42 C + 27 41 renderTable [test-stacks.R#18] + 28 40 func + 29 39 force + 30 38 withVisible + 31 37 withCallingHandlers + 32 36 domain$wrapSync + 33 35 promises::with_promise_domain + 34 34 captureStackTraces + 35 33 doTryCatch + 36 32 tryCatchOne + 37 31 tryCatchList + 38 30 tryCatch + 39 29 do + 40 28 hybrid_chain + 41 27 renderFunc + 42 26 renderTable({ C() }, server = FALSE) + 43 25 ..stacktraceon.. [test-stacks.R#17] + 44 24 contextFunc + 45 23 env$runWith + 46 22 withCallingHandlers + 47 21 domain$wrapSync + 48 20 promises::with_promise_domain + 49 19 captureStackTraces + 50 18 force + 51 17 domain$wrapSync + 52 16 promises::with_promise_domain + 53 15 withReactiveDomain + 54 14 domain$wrapSync + 55 13 promises::with_promise_domain + 56 12 ctx$run + 57 11 ..stacktraceoff.. + 58 10 isolate + 59 9 withCallingHandlers [test-stacks.R#16] + 60 8 domain$wrapSync + 61 7 promises::with_promise_domain + 62 6 captureStackTraces + 63 5 doTryCatch [test-stacks.R#15] + 64 4 tryCatchOne + 65 3 tryCatchList + 66 2 tryCatch + 67 1 try + diff --git a/tests/testthat/test-promise-domains.R b/tests/testthat/test-promise-domains.R new file mode 100644 index 0000000000..6181f9ed7c --- /dev/null +++ b/tests/testthat/test-promise-domains.R @@ -0,0 +1,49 @@ +with_several_promise_domains <- function(expr) { + withReactiveDomain(MockShinySession$new(), { + promises::with_promise_domain(reactivePromiseDomain(), { + captureStackTraces({ + expr + }) + }) + }) +} + +recursive_promise <- function(n, callback = identity) { + if (n <= 0) { + return(promise_resolve(0)) + } + + p <- promises::promise_resolve(TRUE) + promises::then(p, ~{ + callback(n) + recursive_promise(n - 1, callback = callback) + }) +} + +test_that("Stack trace doesn't grow (resolution within domain)", { + + depths <- list() + with_several_promise_domains({ + recursive_promise(10, function(n) { + depths <<- c(depths, list(length(sys.calls()))) + }) + while (!later::loop_empty()) { + later::run_now() + } + }) + expect_equal(diff(range(depths)), 0) +}) + +test_that("Stack trace doesn't grow (resolution outside domain)", { + + depths <- list() + with_several_promise_domains({ + recursive_promise(10, function(n) { + depths <<- c(depths, list(length(sys.calls()))) + }) + }) + while (!later::loop_empty()) { + later::run_now() + } + expect_equal(diff(range(depths)), 0) +}) diff --git a/tests/testthat/test-stacks.R b/tests/testthat/test-stacks.R index 1b95b82796..4e77bbec32 100644 --- a/tests/testthat/test-stacks.R +++ b/tests/testthat/test-stacks.R @@ -98,14 +98,15 @@ extractStackTrace <- function(calls, num = index, call = getCallNames(calls), loc = getLocs(calls), - category = getCallCategories(calls), + # category = getCallCategories(calls), stringsAsFactors = FALSE ) } cleanLocs <- function(locs) { locs[!grepl("test-stacks\\.R", locs, perl = TRUE)] <- "" - sub("^.*#", "", locs) + # sub("^.*#", "", locs) + locs } dumpTests <- function(df) { @@ -129,46 +130,12 @@ test_that("integration tests", { df <- causeError(full = FALSE) # dumpTests(df) - expect_equal(df$num, c(56L, 55L, 54L, 38L, 37L, 36L, 35L, 34L, 33L)) - expect_equal(df$call, c("A", "B", "", "C", "renderTable", - "func", "force", "withVisible", "withCallingHandlers")) - expect_equal(nzchar(df$loc), c(TRUE, TRUE, TRUE, FALSE, TRUE, - FALSE, FALSE, FALSE, FALSE)) + expect_snapshot(df) df <- causeError(full = TRUE) - # dumpTests(df) - expect_equal(df$num, c(59L, 58L, 57L, 56L, 55L, 54L, 53L, - 52L, 51L, 50L, 49L, 48L, 47L, 46L, 45L, 44L, 43L, 42L, 41L, - 40L, 39L, 38L, 37L, 36L, 35L, 34L, 33L, 32L, 31L, 30L, 29L, - 28L, 27L, 26L, 25L, 24L, 23L, 22L, 21L, 20L, 19L, 18L, 17L, - 16L, 15L, 14L, 13L, 12L, 11L, 10L, 9L, 8L, 7L, 6L, 5L, 4L, - 3L, 2L, 1L)) - expect_equal(df$call, c("h", ".handleSimpleError", "stop", - "A", "B", "", "..stacktraceon..", ".func", "withVisible", - "withCallingHandlers", "contextFunc", "env$runWith", "force", - "domain$wrapSync", "promises::with_promise_domain", - "withReactiveDomain", "domain$wrapSync", "promises::with_promise_domain", - "ctx$run", "self$.updateValue", "..stacktraceoff..", "C", - "renderTable", "func", "force", "withVisible", "withCallingHandlers", - "domain$wrapSync", "promises::with_promise_domain", - "captureStackTraces", "doTryCatch", "tryCatchOne", "tryCatchList", - "tryCatch", "do", "hybrid_chain", "renderFunc", "renderTable({ C() }, server = FALSE)", - "..stacktraceon..", "contextFunc", "env$runWith", "force", - "domain$wrapSync", "promises::with_promise_domain", - "withReactiveDomain", "domain$wrapSync", "promises::with_promise_domain", - "ctx$run", "..stacktraceoff..", "isolate", "withCallingHandlers", - "domain$wrapSync", "promises::with_promise_domain", - "captureStackTraces", "doTryCatch", "tryCatchOne", "tryCatchList", - "tryCatch", "try")) - expect_equal(nzchar(df$loc), c(FALSE, FALSE, FALSE, TRUE, - TRUE, TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, - FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, - TRUE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, - FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, TRUE, FALSE, - FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, FALSE, - FALSE, TRUE, FALSE, FALSE, FALSE, TRUE, FALSE, FALSE, FALSE, - FALSE)) + expect_snapshot(df) + # dumpTests(df) }) test_that("shiny.error", {