context("reactlog")
keyValList <- function(key, value) {
ret <- list()
ret[[key]] <- value
ret
}
withOption <- function(key, value, oldVal = NULL, expr) {
oldVal <- getOption(key, oldVal)
do.call("options", keyValList(key, value))
on.exit({
do.call("options", keyValList(key, oldVal))
})
force(expr)
}
withLogging <- function(expr) {
rLog$reset()
# reset ctx counter
reactiveEnvr <- .getReactiveEnvironment()
reactiveEnvr$.nextId <- 0L
withOption("shiny.reactlog", TRUE, FALSE, {
withOption("shiny.reactlog.console", TRUE, FALSE, {
withOption("shiny.suppressMissingContextError", TRUE, FALSE, {
force(expr)
})
})
})
}
expect_logs <- function(expr, ...) {
expected_messages <- unlist(list(...))
captured_messages <- capture_messages(expr)
captured_messages <- sub("\n$", "", captured_messages)
if (length(captured_messages) != length(expected_messages)) {
cat("\nCaptured: \n"); print(captured_messages)
cat("Expected: \n"); print(expected_messages)
}
expect_equal(
captured_messages,
expected_messages
)
}
test_that("rLog resets when options are FALSE", {
withOption("shiny.reactlog", FALSE, FALSE, {
withOption("shiny.reactlog.console", FALSE, FALSE, {
rLog$reset()
# check for dummy and no reactid information
expect_true(!is.null(rLog$noReactId))
expect_true(!is.null(rLog$dummyReactId))
expect_equal(rLog$msg$getReact(rLog$noReactId, force = TRUE)$reactId, rLog$noReactId)
expect_equal(rLog$msg$getReact(rLog$dummyReactId, force = TRUE)$reactId, rLog$dummyReactId)
expect_equal(length(rLog$msg$reactCache), 2)
})
})
})
test_that("message logger appears", {
withLogging({
expect_logs(
{
val <- reactiveVal(1, label = "val")
},
"- define: r1:'val' - reactiveVal ' num 1'"
)
expect_silent(
{
values <- reactiveValues(a = 2, b = 3)
local({
values_obj <- .subset2(values, 'impl')
values_obj$.label <- "values"
})
}
)
expect_logs(
{
react <- reactive(val() + values$a)
},
"- define: r3:'reactive(val() + values$a)' - observable ' NULL'"
)
expect_logs(
{
react()
},
"- createContext: ctxDummy - isolate",
"- dependsOn: rDummyReactId:'DummyReactId' on r3:'reactive(val() + values$a)' in ctxDummy",
"- createContext: ctx1 - observable",
"- enter: r3:'reactive(val() + values$a)' in ctx1 - observable",
"= - dependsOn: r3:'reactive(val() + values$a)' on r1:'val' in ctx1",
"= - define: r2$a:'values$a' - reactiveValuesKey ' num 2'",
"= - dependsOn: r3:'reactive(val() + values$a)' on r2$a:'values$a' in ctx1",
"- exit: r3:'reactive(val() + values$a)' in ctx1 - observable"
)
expect_logs(
{
val(4)
},
"- valueChange: r1:'val' ' num 4'",
"- invalidateStart: r1:'val'",
"= - invalidateStart: r3:'reactive(val() + values$a)' in ctx1 - observable",
"= = - isolateInvalidateStart: rDummyReactId:'DummyReactId' in ctxDummy",
"= = = - dependsOnRemove: rDummyReactId:'DummyReactId' on r3:'reactive(val() + values$a)' in ctxDummy",
"= = - isolateInvalidateEnd: rDummyReactId:'DummyReactId' in ctxDummy",
"= = - dependsOnRemove: r3:'reactive(val() + values$a)' on r1:'val' in ctx1",
"= = - dependsOnRemove: r3:'reactive(val() + values$a)' on r2$a:'values$a' in ctx1",
"= - invalidateEnd: r3:'reactive(val() + values$a)' in ctx1 - observable",
"- invalidateEnd: r1:'val'"
)
expect_logs(
{values$a <- 5},
"- valueChange: r2$a:'values$a' ' num 5'",
"- invalidateStart: r2$a:'values$a'",
"- invalidateEnd: r2$a:'values$a'"
)
})
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.