tests/testthat/test-progress-along.R

In r-lib/cli: Helpers for Developing Command Line Interfaces

test_that("cli_progress_along crud", {
  fun <- function() {
    sapply(cli_progress_along(letters), function(i) i)
  }
  capture_cli_messages(ret <- fun())
  expect_identical(ret, seq_along(letters))
})

test_that("progress bar terminated at mapping function exit", {
  fun <- function() {
    snap <- as.character(names(clienv$progress))
    sapply(cli_progress_along(letters), function(i) i)
    expect_identical(as.character(names(clienv$progress)), snap)
  }
  capture_cli_messages(fun())
})

test_that("interpolation uses the right env", {
  if (getRversion() < "3.5.0") skip("Needs ALTREP")
  fun <- function() {
    withr::local_options(
      cli.ansi = TRUE,
      cli.dynamic = TRUE,
      cli.progress_show_after = 0,
      cli.progress_handlers_only = "cli"
    )
    x <- 10
    sapply(cli_progress_along(1:5, format = "x: {x}"), function(i) i)
  }

  out <- capture_cli_messages(cli_with_ticks(fun()))
  expect_snapshot(out)
})

test_that("cli_progress_along", {
  if (getRversion() < "3.5.0") skip("Needs ALTREP")
  withr::local_envvar(CLI_NO_THREAD = "1")
  fun <- function() {
    withr::local_options(
      cli.ansi = TRUE,
      cli.dynamic = TRUE,
      cli.progress_show_after = 0,
      cli.progress_handlers_only = "logger"
    )
    vapply(cli::cli_progress_along(1:10), function(i) i, integer(1))
  }

  lines <- fix_logger_output(capture.output(cli_with_ticks(fun())))
  expect_snapshot(lines)
})

test_that("cli_progress_along error", {
  if (getRversion() < "3.5.0") skip("Needs ALTREP")
  withr::local_envvar(CLI_NO_THREAD = "1")
  fun <- function() {
    withr::local_options(
      cli.ansi = TRUE,
      cli.dynamic = TRUE,
      cli.progress_show_after = 0,
      cli.progress_handlers_only = "logger"
    )
    suppressWarnings(testthat::local_reproducible_output())
    lapply(
      cli::cli_progress_along(1:10, clear = FALSE),
      function(i) { if (i == 5) stop("oops") }
    )
  }

  outfile <- tempfile()
  expect_error(callr::r(fun, stdout = outfile, stderr = outfile))

  lines <- fix_logger_output(readLines(outfile))
  expect_snapshot(lines)
})

test_that("old R is just seq_along", {
  # It is tricky to check that we get seq_along(), because
  # identical(cli_progress_along(1:10), seq_along(1:10)) holds,
  # so we just check that no progress bar is created.
  local_mocked_bindings(getRversion = function() package_version("3.4.0"))
  snapshot <- names(clienv$progress)
  it <- cli_progress_along(1:10)
  expect_identical(snapshot, names(clienv$progress))
  expect_identical(it, seq_along(1:10))
})

test_that("error in handler is a single warning", {
  if (getRversion() < "3.5.0") skip("Needs ALTREP")
  fun <- function() {
    withr::local_options(
      cli.ansi = TRUE,
      cli.dynamic = TRUE,
      cli.progress_show_after = 0,
      cli.progress_handlers_only = "cli"
    )
    x <- 10
    sapply(cli_progress_along(1:5, format = "{1+''}"), function(i) i)
  }

  expect_snapshot(
    cli_with_ticks(fun()),
    transform = sanitize_srcref
  )
})

test_that("length 1 seq", {
  fun <- function() {
    sapply(cli_progress_along(1L), function(i) i)
  }
  capture_cli_messages(ret <- cli_with_ticks(fun()))
  expect_identical(ret, 1L)
})

test_that("ALTREP methods", {
  if (getRversion() < "3.5.0") skip("Needs ALTREP")
  seq <- cli_progress_along(1:10)
  expect_output(.Internal(inspect(seq)), "progress_along")

  expect_equal(is.unsorted(seq), FALSE)
  expect_equal(sum(seq), sum(1:10))

  seq <- cli_progress_along(letters)
  expect_equal(min(seq), 1L)
  expect_equal(max(seq), length(letters))

  z <- cli_progress_along(character())
  expect_equal(min(z), Inf)

  seq <- cli_progress_along(letters)
  expect_equal(.Call(clic_dataptr, seq), seq_along(letters) * 2)

  seq2 <- seq
  expect_silent(seq2[1] <- 100)
})