Nothing
test_that("events are properly generated", {
## This needs callr >= 3.0.0.90001, which is not yet on CRAN
if (packageVersion("callr") < "3.0.0.9001") skip("Need newer callr")
do <- function() {
options(cli.message_class = "callr_message")
cli::cli_div()
cli::cli_h1("title")
cli::cli_text("text")
}
rs <- callr::r_session$new()
on.exit(rs$kill(), add = TRUE)
msgs <- list()
handler <- function(msg) {
msgs <<- c(msgs, list(msg))
if (!is.null(findRestart("cli_message_handled"))) {
invokeRestart("cli_message_handled")
}
if (!is.null(findRestart("callr_r_session_muffle"))) {
invokeRestart("callr_r_session_muffle")
}
}
withCallingHandlers(
rs$run(do),
cli_message = handler)
expect_equal(length(msgs), 4)
lapply(msgs, expect_s3_class, "cli_message")
expect_equal(msgs[[1]]$type, "div")
expect_equal(msgs[[2]]$type, "h1")
expect_equal(msgs[[3]]$type, "text")
expect_equal(msgs[[4]]$type, "end")
rs$close()
})
test_that("subprocess with default handler", {
## This needs callr >= 3.0.0.90001, which is not yet on CRAN
if (packageVersion("callr") < "3.0.0.9001") skip("Need newer callr")
do <- function() {
options(cli.message_class = "callr_message")
cli::cli_div()
cli::cli_h1("title")
cli::cli_text("text")
}
rs <- callr::r_session$new()
on.exit(rs$kill(), add = TRUE)
msgs <- list()
withr::with_options(list(
cli.default_handler = function(msg) {
msgs <<- c(msgs, list(msg))
if (!is.null(findRestart("cli_message_handled"))) {
invokeRestart("cli_message_handled")
}
}),
rs$run(do)
)
expect_equal(length(msgs), 4)
lapply(msgs, expect_s3_class, "cli_message")
expect_equal(msgs[[1]]$type, "div")
expect_equal(msgs[[2]]$type, "h1")
expect_equal(msgs[[3]]$type, "text")
expect_equal(msgs[[4]]$type, "end")
rs$close()
})
test_that("output in child process", {
## This needs callr >= 3.0.0.90001, which is not yet on CRAN
if (packageVersion("callr") < "3.0.0.9001") skip("Need newer callr")
# We need to do our own condition handling, otherwise callr will
# handle `cli_message` and copy it to the main process.
# So on `cli_message` we just call the default handler, which will
# call `message()`, and on `message` we'll copy the formatted message
# to the main process.
do <- function() {
options(cli.num_colors = 256)
withCallingHandlers({
cli::start_app(theme = cli::simple_theme())
cli::cli_h1("Title")
cli::cli_text("This is generated in the {.emph subprocess}.")
"foobar"
},
cli_message = function(msg) {
withCallingHandlers({
cli:::cli_server_default(msg)
invokeRestart("cli_message_handled") },
message = function(mmsg) {
class(mmsg) <- c("callr_message", "message", "condition")
signalCondition(mmsg)
})
}
)
}
rs <- callr::r_session$new()
on.exit(rs$kill(), add = TRUE)
# Store the formatted messages from callr
# We also need to muffle the default handler here
msgs <- list()
result <- withCallingHandlers(
rs$run_with_output(do),
callr_message = function(msg) {
msgs <<- c(msgs, list(msg))
if (!is.null(msg$muffle) && !is.null(findRestart(msg$muffle))) {
invokeRestart(msg$muffle)
}
}
)
expect_equal(result$stdout, "")
expect_equal(result$stderr, "")
expect_identical(result$result, "foobar")
expect_null(result$error)
str <- paste(vcapply(msgs, "[[", "message"), collapse = "")
expect_true(ansi_has_any(str))
expect_match(str, "Title")
expect_match(str, "This is generated")
rs$close()
})
test_that("substitution in child process", {
do <- function() {
options(cli.message_class = "callr_message")
cli::cli_text("This is process {Sys.getpid()}.")
}
rs <- callr::r_session$new()
on.exit(rs$kill(), add = TRUE)
out <- capt0(rs$run(do))
expect_match(out, glue::glue("This is process {rs$get_pid()}"))
rs$close()
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.