tests/testthat/test-cli.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(
  testthat[
    expect_equal,
    expect_false,
    expect_true,
    expect_match,
    expect_named,
    expect_null,
    test_that
  ]
)

# Drive cli_run in-process, capturing both streams and the returned exit code.
run_cli <- function(args) {
  outcon <- textConnection("outbuf", "w", local = TRUE)
  errcon <- textConnection("errbuf", "w", local = TRUE)

  # R supports only one active "message" diversion at a time (see ?sink) -
  # unlike "output", it does not stack. setup.R keeps one sunk for the whole
  # test run to silence incidental cli/warning noise; pushing a second one
  # here would silently replace it, and popping ours back off would then
  # remove the global one too instead of restoring it. Suspend it explicitly
  # for the duration of this capture and restore it afterward, since this
  # test genuinely needs cli_run()'s raw stderr content, not just silence.
  null_message_con <- getOption("artma.test.null_message_con")
  if (sink.number(type = "message") > 0) sink(type = "message")

  sink(outcon, type = "output")
  sink(errcon, type = "message")
  code <- tryCatch(
    artma::cli_run(args),
    finally = {
      sink(type = "message")
      sink(type = "output")
      if (!is.null(null_message_con)) sink(null_message_con, type = "message")
    }
  )
  close(outcon)
  close(errcon)
  list(
    code = code,
    stdout = paste(outbuf, collapse = "\n"),
    stderr = paste(errbuf, collapse = "\n")
  )
}

# --- Parser ----------------------------------------------------------------

test_that("cli_parse resolves subcommands, sub-actions and flag forms", {
  box::use(artma / cli / parser[cli_parse])

  # --key value and --key=value are equivalent.
  a <- cli_parse(c("run", "--options", "x.yaml", "--verbose", "4"))
  b <- cli_parse(c("run", "--options=x.yaml", "--verbose=4"))
  expect_equal(a$action, "dispatch")
  expect_equal(a$subcommand, "run")
  expect_equal(a$flags[["options"]], "x.yaml")
  expect_equal(a$flags[["verbose"]], 4L)
  expect_equal(a$flags, b$flags)

  # --methods is a comma-separated list.
  m <- cli_parse(c("run", "--methods", "funnel_plot,effect_summary_stats"))
  expect_equal(m$flags[["methods"]], c("funnel_plot", "effect_summary_stats"))

  # boolean flags take no value.
  f <- cli_parse(c("run", "--no-cache", "--json"))
  expect_true(f$flags[["no-cache"]])
  expect_true(f$flags[["json"]])

  # options requires a valid sub-action.
  ok <- cli_parse(c("options", "validate", "--options", "x.yaml"))
  expect_equal(ok$action, "dispatch")
  expect_equal(ok$subaction, "validate")
})

test_that("cli_parse reports usage errors without throwing", {
  box::use(artma / cli / parser[cli_parse])

  expect_equal(cli_parse(c("frobnicate"))$action, "error")
  expect_equal(cli_parse(c("run", "--nope"))$action, "error")
  expect_equal(cli_parse(c("run", "--verbose", "high"))$action, "error")
  expect_equal(cli_parse(c("run", "--no-cache=1"))$action, "error")
  expect_equal(cli_parse(c("run", "--options"))$action, "error") # missing value
  expect_equal(cli_parse(c("options", "frobnicate"))$action, "error") # bad sub-action
  expect_equal(cli_parse(c("options"))$action, "error") # missing sub-action
})

test_that("cli_parse treats --help anywhere as a help request", {
  box::use(artma / cli / parser[cli_parse])

  expect_equal(cli_parse(character(0))$action, "help")
  expect_equal(cli_parse("--help")$action, "help")
  top <- cli_parse("--help")
  expect_null(top$subcommand)
  sub <- cli_parse(c("run", "--help"))
  expect_equal(sub$action, "help")
  expect_equal(sub$subcommand, "run")
})

# --- Help ------------------------------------------------------------------

test_that("cli_help_text documents every subcommand and its flags", {
  box::use(artma / cli / parser[cli_help_text, cli_subcommands])

  top <- paste(cli_help_text(NULL), collapse = "\n")
  for (nm in names(cli_subcommands())) {
    expect_match(top, nm, fixed = TRUE)
  }

  run_help <- paste(cli_help_text("run"), collapse = "\n")
  for (flag in c("--options", "--data", "--methods", "--no-cache", "--report", "--json")) {
    expect_match(run_help, flag, fixed = TRUE)
  }
})

test_that("cli_run prints help to stdout and returns 0 for each subcommand", {
  for (sc in c("--help", "run", "methods", "options", "version")) {
    res <- run_cli(c(sc, "--help"))
    expect_equal(res$code, 0L)
    expect_true(nchar(res$stdout) > 0)
  }
})

# --- Exit-code contract ----------------------------------------------------

test_that("cli_run returns 2 and prints usage to stderr on a usage error", {
  res <- run_cli(c("run", "--bogus"))
  expect_equal(res$code, 2L)
  expect_match(res$stderr, "Unknown flag", fixed = TRUE)
  expect_equal(nchar(res$stdout), 0L)
})

# --- Overlay ---------------------------------------------------------------

test_that("build_option_overlay maps run flags to artma.* options", {
  box::use(artma / cli / parser[build_option_overlay])

  overlay <- build_option_overlay(list(
    data = "/tmp/data.csv",
    `output-dir` = "/tmp/out",
    verbose = 2L,
    `no-cache` = TRUE,
    report = TRUE
  ))

  expect_equal(overlay[["artma.data.source_path"]], "/tmp/data.csv")
  expect_equal(overlay[["artma.output.dir"]], "/tmp/out")
  expect_equal(overlay[["artma.verbose"]], 2L)
  expect_false(overlay[["artma.cache.use_cache"]])
  expect_true(overlay[["artma.output.report"]])
})

test_that("the --no-cache overlay is scoped to the call and unset outside", {
  box::use(artma / cli / parser[build_option_overlay])

  withr::local_options(list(artma.cache.use_cache = NULL))
  overlay <- build_option_overlay(list(`no-cache` = TRUE))

  inside <- withr::with_options(overlay, getOption("artma.cache.use_cache", TRUE))
  expect_false(inside)
  # Outside the overlay the option is untouched (back to its default sentinel).
  expect_null(getOption("artma.cache.use_cache"))
})

test_that("an empty flag set yields an empty overlay", {
  box::use(artma / cli / parser[build_option_overlay])
  expect_equal(build_option_overlay(list()), list())
})

# --- Dispatch --------------------------------------------------------------

test_that("cli_run version prints the package version to stdout", {
  res <- run_cli("version")
  expect_equal(res$code, 0L)
  expect_match(res$stdout, as.character(utils::packageVersion("artma")), fixed = TRUE)
})

test_that("cli_run methods dispatches to methods_list without error", {
  res <- run_cli("methods")
  expect_equal(res$code, 0L)
})

# --- Run manifest ----------------------------------------------------------

# Point the marker that names the last results directory at a temp directory,
# and return that directory.
local_export_dir <- function(.local_envir = parent.frame()) {
  cache_dir <- withr::local_tempdir(.local_envir = .local_envir)
  withr::local_envvar(R_USER_CACHE_DIR = cache_dir, .local_envir = .local_envir)

  output_dir <- withr::local_tempdir(.local_envir = .local_envir)
  marker_dir <- tools::R_user_dir("artma", which = "cache")
  dir.create(marker_dir, recursive = TRUE, showWarnings = FALSE)
  writeLines(output_dir, file.path(marker_dir, "last_export_dir"))
  output_dir
}

test_that("the CLI manifest reports the run, not the output directory's contents", {
  testthat::skip_if_not_installed("jsonlite")
  box::use(artma / output / run_manifest[write_run_manifest])

  output_dir <- local_export_dir()
  dir.create(file.path(output_dir, "tables"))
  written <- file.path(output_dir, "tables", "fma.csv")
  file.create(written)
  # Left behind by an earlier run into the same directory.
  file.create(file.path(output_dir, "tables", "stale.csv"))

  results <- list(fma = list(tables = list(), plots = list(), meta = list()))
  attr(results, "skipped_methods") <- c(bma = "missing suggested package: BMS")
  attr(results, "run_info") <- list(methods_requested = c("fma", "bma"), seed = 77L)
  write_run_manifest(results, output_dir = output_dir, run_files = written)

  manifest <- artma:::cli_build_run_manifest(list())

  expect_equal(as.character(manifest$methods_run), "fma")
  expect_equal(manifest$methods_skipped$bma, "missing suggested package: BMS")
  expect_equal(manifest$seed, 77)
  expect_equal(basename(manifest$exported_files), "fma.csv")
})

test_that("the CLI manifest falls back to the results when no run.json exists", {
  output_dir <- local_export_dir()

  results <- list(fma = list())
  attr(results, "failed_methods") <- c(bma = "boom")
  attr(results, "run_info") <- list(methods_requested = "fma", seed = 5L)

  manifest <- artma:::cli_build_run_manifest(results)

  expect_equal(as.character(manifest$methods_run), "fma")
  expect_equal(manifest$methods_skipped$bma, "boom")
  expect_equal(manifest$output_dir, output_dir)
  expect_equal(length(manifest$exported_files), 0L)
})