tests/testthat/test-cliapp-output.R

In cli: Helpers for Developing Command Line Interfaces

start_app()
on.exit(stop_app(), add = TRUE)

test_that("cliapp output auto", {
  skip_on_cran()

  txt <- "Stay calm. This is a test."
  script <- tempfile(fileext = ".R")
  on.exit(unlink(script, recursive = TRUE), add = TRUE)

  # stderr if not interactive ----------------

  code <- substitute(env = list(txt = txt), {
    options(rlib_interactive = FALSE, cli.num_colors = 1L)
    cli::cli_text(txt)
  })
  cat(deparse(code), file = script, sep = "\n")

  out <- callr::rscript(script, show = FALSE, fail_on_status = FALSE)
  expect_true(out$stderr %in% paste0(txt, c("\n", "\r\n")))
  expect_equal(out$stdout, "")

  # stdout if interactive --------------------

  code <- substitute(env = list(txt = txt), {
    options(rlib_interactive = TRUE, cli.num_colors = 1L)
    cli::cli_text(txt)
  })
  cat(deparse(code), file = script, sep = "\n")

  out <- callr::rscript(script, show = FALSE, fail_on_status = FALSE)
  expect_true(out$stdout %in% paste0(txt, c("\n", "\r\n")))
  expect_equal(out$stderr, "")

  # choose explicitly -----------------------

  txt2 <- "Don't move"
  code <- substitute(env = list(txt = txt, txt2 = txt2), {
    options(rlib_interactive = FALSE, cli_num_colors = 1L)
    cli::start_app(output = "stderr")
    cli::cli_text(txt)
    cli::stop_app()
    options(rlib_interactive = TRUE)
    cli::start_app(output = "stdout")
    cli::cli_text(txt2)
    cli::stop_app()
  })
  cat(deparse(code), file = script, sep = "\n")

  out <- callr::rscript(script, show = FALSE, fail_on_status = FALSE)
  expect_true(out$stderr %in% paste0(txt, c("\n", "\r\n")))
  expect_true(out$stdout %in% paste0(txt2, c("\n", "\r\n")))
})

test_that("can also use a connection", {
  skip_on_cran()

  txt <- "Stay calm. This is a test."
  script <- tempfile(fileext = ".R")
  on.exit(unlink(script, recursive = TRUE), add = TRUE)

  code <- substitute(env = list(txt = txt), {
    options(cli.num_colors = 1L)
    con <- textConnection(NULL, open = "w", local = TRUE)
    cli::start_app(output = con)
    cli::cli_text(txt)
    cli::stop_app()
    flush(con)
    cat("output:", textConnectionValue(con), "\n", sep = "")
  })
  cat(deparse(code), file = script, sep = "\n")

  out <- callr::rscript(script, show = FALSE, fail_on_status = FALSE)
  expect_true(out$stdout %in% paste0("output:", txt, c("\n", "\r\n")))
  expect_equal(out$stderr, "")
})

test_that("message if there is a sink", {
  # if there is an output sink, non-interactive
  msgs <- NULL
  tmp <- NULL
  fun <- function() {
    sink(tmp <<- tempfile())
    on.exit(sink(NULL), add = TRUE)
    cli_text("Hola")
  }
  withCallingHandlers(
    fun(),
    cliMessage = function(m) {
      msgs <<- c(msgs, list(m))
      invokeRestart("muffleMessage")
    }
  )
  expect_equal(msgs[[1]]$message, "Hola\n")
  expect_equal(length(readLines(tmp)), 0)

  # if there is a message sink, non-interactive
  msgs <- NULL
  tmp <- tempfile()
  con <- file(tmp, open = "w+")
  fun <- function() {
    sink(con, type = "message")
    on.exit(sink(NULL, type = "message"), add = TRUE)
    cat("this\n", file = stderr())
    cli_text("Hola")
  }
  withCallingHandlers(
    fun(),
    cliMessage = function(m) {
      msgs <<- c(msgs, list(m))
      invokeRestart("muffleMessage")
    }
  )
  expect_equal(msgs[[1]]$message, "Hola\n")
  expect_equal(readLines(tmp), "this")

  withr::local_options(rlib_interactive = TRUE)

  # if there is an output sink, interactive
  msgs <- NULL
  tmp <- NULL
  fun <- function() {
    sink(tmp <<- tempfile())
    on.exit(sink(NULL), add = TRUE)
    cli_text("Hola")
  }
  withCallingHandlers(
    fun(),
    cliMessage = function(m) {
      msgs <<- c(msgs, list(m))
      invokeRestart("muffleMessage")
    }
  )
  expect_equal(msgs[[1]]$message, "Hola\n")
  expect_equal(length(readLines(tmp)), 0)

  # if there is a message sink, interactive
  msgs <- NULL
  tmp <- tempfile()
  con <- file(tmp, open = "w+")
  fun <- function() {
    sink(con, type = "message")
    on.exit(sink(NULL, type = "message"), add = TRUE)
    cat("this\n", file = stderr())
    cli_text("Hola")
  }
  withCallingHandlers(
    fun(),
    cliMessage = function(m) {
      msgs <<- c(msgs, list(m))
      invokeRestart("muffleMessage")
    }
  )
  expect_equal(msgs[[1]]$message, "Hola\n")
  expect_equal(readLines(tmp), "this")
})