github/shiny
1
1
Fork 0
mirror of https://github.com/rstudio/shiny.git synced 2026-04-29 03:00:45 -04:00
Code Issues Packages Projects Releases Wiki Activity

Stack trace domain explosion (#4155)

Browse Source 
* 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.
This commit is contained in:
Joe Cheng
2024-12-03 13:23:50 -08:00
committed by GitHub
parent 501b012b2b
commit 458924569a
6 changed files with 154 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
DESCRIPTION
View File

@@ -83,7 +83,7 @@ Imports:
R6 (>= 2.0), R6 (>= 2.0),
sourcetools, sourcetools,
later (>= 1.0.0), later (>= 1.0.0),
promises (>= 1.1.0), promises (>= 1.3.2),
tools, tools,
crayon, crayon,
rlang (>= 0.4.10), rlang (>= 0.4.10),

14
R/react.R
View File

@@ -53,10 +53,12 @@ Context <- R6Class(
promises::with_promise_domain(reactivePromiseDomain(), { promises::with_promise_domain(reactivePromiseDomain(), {
withReactiveDomain(.domain, { withReactiveDomain(.domain, {
env <- .getReactiveEnvironment() captureStackTraces({
rLog$enter(.reactId, id, .reactType, .domain) env <- .getReactiveEnvironment()
on.exit(rLog$exit(.reactId, id, .reactType, .domain), add = TRUE) rLog$enter(.reactId, id, .reactType, .domain)
env$runWith(self, func) on.exit(rLog$exit(.reactId, id, .reactType, .domain), add = TRUE)
env$runWith(self, func)
})
}) })
}) })
}, },
@@ -223,9 +225,7 @@ wrapForContext <- function(func, ctx) {
function(...) { function(...) {
.getReactiveEnvironment()$runWith(ctx, function() { .getReactiveEnvironment()$runWith(ctx, function() {
captureStackTraces( func(...)
func(...)
)
}) })
} }
} }

2
R/shiny.R
View File

@@ -2024,7 +2024,7 @@ ShinySession <- R6Class(
tmpdata <- tempfile(fileext = ext) tmpdata <- tempfile(fileext = ext)
return(Context$new(getDefaultReactiveDomain(), '[download]')$run(function() { return(Context$new(getDefaultReactiveDomain(), '[download]')$run(function() {
promises::with_promise_domain(reactivePromiseDomain(), { promises::with_promise_domain(reactivePromiseDomain(), {
promises::with_promise_domain(createStackTracePromiseDomain(), { captureStackTraces({
self$incrementBusyCount() self$incrementBusyCount()
hybrid_chain( hybrid_chain(
# ..stacktraceon matches with the top-level ..stacktraceoff.. # ..stacktraceon matches with the top-level ..stacktraceoff..

90
tests/testthat/_snaps/stacks.md Normal file
View File

@@ -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 <reactive:C> [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 <reactive:C> [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

49
tests/testthat/test-promise-domains.R Normal file
View File

@@ -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)
})

45
tests/testthat/test-stacks.R
View File

@@ -98,14 +98,15 @@ extractStackTrace <- function(calls,
num = index, num = index,
call = getCallNames(calls), call = getCallNames(calls),
loc = getLocs(calls), loc = getLocs(calls),
category = getCallCategories(calls), # category = getCallCategories(calls),
stringsAsFactors = FALSE stringsAsFactors = FALSE
) )
} }
cleanLocs <- function(locs) { cleanLocs <- function(locs) {
locs[!grepl("test-stacks\\.R", locs, perl = TRUE)] <- "" locs[!grepl("test-stacks\\.R", locs, perl = TRUE)] <- ""
sub("^.*#", "", locs) # sub("^.*#", "", locs)
locs
} }
dumpTests <- function(df) { dumpTests <- function(df) {
@@ -129,46 +130,12 @@ test_that("integration tests", {
df <- causeError(full = FALSE) df <- causeError(full = FALSE)
# dumpTests(df) # dumpTests(df)
expect_equal(df$num, c(56L, 55L, 54L, 38L, 37L, 36L, 35L, 34L, 33L)) expect_snapshot(df)
expect_equal(df$call, c("A", "B", "<reactive:C>", "C", "renderTable",
"func", "force", "withVisible", "withCallingHandlers"))
expect_equal(nzchar(df$loc), c(TRUE, TRUE, TRUE, FALSE, TRUE,
FALSE, FALSE, FALSE, FALSE))
df <- causeError(full = TRUE) df <- causeError(full = TRUE)
# dumpTests(df)
expect_equal(df$num, c(59L, 58L, 57L, 56L, 55L, 54L, 53L, expect_snapshot(df)
52L, 51L, 50L, 49L, 48L, 47L, 46L, 45L, 44L, 43L, 42L, 41L, # dumpTests(df)
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", "<reactive:C>", "..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))
}) })
test_that("shiny.error", { test_that("shiny.error", {