tests/testthat/test-run.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(
  testing / mocks / index[MOCKS],
  testthat[
    capture_messages,
    capture_warnings,
    expect_equal,
    expect_error,
    expect_false,
    expect_length,
    expect_match,
    expect_named,
    expect_null,
    expect_setequal,
    expect_true,
    test_that
  ]
)

# Options backed by a real mock dataset, so the prepare step can run its full
# provided-data branch (config lookups included). Built once at file scope:
# options_load() is pure, so each test activates the returned list with
# withr::local_options() and stays isolated.
prepare_step_options <- local({
  fixture_dir <- withr::local_tempdir(.local_envir = testthat::teardown_env())

  df <- MOCKS$create_mock_df(seed = 42, nrow = 60, n_studies = 5)
  source_path <- file.path(fixture_dir, "run-pipeline-data.csv")
  utils::write.csv(df, source_path, row.names = FALSE)

  options_dir <- file.path(fixture_dir, "options")
  dir.create(options_dir)

  artma::options_create(
    options_file_name = "run-pipeline.yaml",
    options_dir = options_dir,
    user_input = list(
      "data.source_path" = source_path,
      "data.na_handling" = "remove",
      "data.reconcile_mode" = "auto",
      "calc.se_zero_handling" = "ignore",
      "cache.use_cache" = FALSE,
      "verbose" = 1L
    ),
    should_validate = TRUE,
    should_overwrite = TRUE
  )

  artma::options_load(
    options_file_name = "run-pipeline.yaml",
    options_dir = options_dir,
    load_with_prefix = TRUE,
    should_validate = TRUE,
    should_add_temp_options = TRUE,
    should_return = TRUE
  )
})

mock_methods <- function() {
  list(
    method_a = list(run = function(df, ...) "method_a"),
    method_b = list(run = function(df, ...) "method_b"),
    method_c = list(run = function(df, ...) paste("called", nrow(df)))
  )
}

# Write the fake methods into a temporary box module tree and return the
# methods directory, to be passed to invoke_runtime_methods(modules_dir = ...).
# All state changes (temp files, the scoped box.path prepend needed for the
# generated box imports to resolve, and module cache entries) are registered
# for cleanup in the caller's frame via withr, so they are undone even when a
# test fails midway. Package bindings such as PATHS are never touched.
local_mock_methods_dir <- function(fake_methods, env = parent.frame()) {
  temp_root <- withr::local_tempdir(pattern = "artma-test-methods-", .local_envir = env)
  methods_dir <- file.path(temp_root, "artma", "methods")
  dir.create(methods_dir, recursive = TRUE, showWarnings = FALSE)

  for (name in names(fake_methods)) {
    file_path <- file.path(methods_dir, paste0(name, ".R"))
    run_fun <- fake_methods[[name]]$run
    stopifnot(is.function(run_fun))

    run_fun_code <- paste(deparse(run_fun), collapse = "\n")
    module_code <- paste0("run <- ", run_fun_code, "\n")

    meta <- fake_methods[[name]]$meta
    if (!is.null(meta)) {
      meta_code <- paste(deparse(meta), collapse = "\n")
      module_code <- paste0(
        module_code,
        "attr(run, \"artma_method_meta\") <- ", meta_code, "\n"
      )
    }

    writeLines(module_code, file_path)
  }

  withr::local_options(list(box.path = c(temp_root, getOption("box.path"))), .local_envir = env)

  withr::defer(
    {
      for (name in names(fake_methods)) {
        try(box::unload(sprintf("artma/methods/%s", name)), silent = TRUE)
      }
    },
    envir = env
  )

  methods_dir
}

test_that("invoke_runtime_methods handles explicit character vectors", {
  fake_methods <- mock_methods()
  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(
    methods = c("method_b", "method_a", "method_b"),
    df = df,
    modules_dir = methods_dir
  )

  expected_order <- names(fake_methods)[names(fake_methods) %in% c("method_b", "method_a")]

  expect_equal(names(results), expected_order)
  expect_equal(unname(unlist(results)), expected_order)
})

test_that("invoke_runtime_methods expands the all keyword", {
  fake_methods <- mock_methods()
  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame()
  results <- artma:::invoke_runtime_methods(methods = "all", df = df, modules_dir = methods_dir)

  expect_setequal(names(results), names(fake_methods))
})

test_that("invoke_runtime_methods leaves opt-in methods out of the all keyword", {
  fake_methods <- mock_methods()
  fake_methods$method_c$meta <- list(stage = "method_c", opt_in = TRUE)
  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame()
  results <- artma:::invoke_runtime_methods(methods = "all", df = df, modules_dir = methods_dir)

  expect_setequal(names(results), c("method_a", "method_b"))
})

test_that("invoke_runtime_methods still runs opt-in methods when named", {
  fake_methods <- mock_methods()
  fake_methods$method_c$meta <- list(stage = "method_c", opt_in = TRUE)
  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(
    methods = "method_c",
    df = df,
    modules_dir = methods_dir
  )

  expect_equal(names(results), "method_c")
})

test_that("invoke_runtime_methods surfaces invalid inputs early", {
  fake_methods <- mock_methods()
  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame()
  expect_error(
    artma:::invoke_runtime_methods(methods = c("missing", "method_a"), df = df, modules_dir = methods_dir),
    "Invalid runtime methods selected"
  )

  expect_error(
    artma:::invoke_runtime_methods(methods = c("method_a", NA_character_), df = df, modules_dir = methods_dir),
    "must not contain missing values"
  )

  expect_error(
    artma:::invoke_runtime_methods(methods = numeric(), df = df, modules_dir = methods_dir),
    "Runtime methods must be supplied as a character vector"
  )
})

test_that("invoke_runtime_methods isolates a failing method and keeps the rest", {
  fake_methods <- list(
    method_a = list(run = function(df, ...) "a-ok"),
    method_b = list(run = function(df, ...) cli::cli_abort("boom")),
    method_c = list(run = function(df, ...) "c-ok")
  )
  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(methods = "all", df = df, modules_dir = methods_dir)

  expect_setequal(names(results), c("method_a", "method_c"))
  expect_equal(results$method_a, "a-ok")
  expect_equal(results$method_c, "c-ok")

  failed <- attr(results, "failed_methods")
  expect_named(failed, "method_b")
  expect_match(unname(failed[["method_b"]]), "boom")
})

test_that("invoke_runtime_methods warns about failed methods when verbosity allows", {
  fake_methods <- list(
    method_a = list(run = function(df, ...) "a-ok"),
    method_b = list(run = function(df, ...) cli::cli_abort("boom"))
  )
  withr::local_options(list(artma.verbose = 2))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  warnings <- capture_warnings(
    results <- artma:::invoke_runtime_methods(methods = "all", df = df, modules_dir = methods_dir)
  )

  expect_true(any(grepl("method_b", warnings)))
  expect_equal(results$method_a, "a-ok")
})

test_that("invoke_runtime_methods emits a final warning when every method fails", {
  fake_methods <- list(
    method_a = list(run = function(df, ...) cli::cli_abort("first failure")),
    method_b = list(run = function(df, ...) cli::cli_abort("second failure"))
  )
  withr::local_options(list(artma.verbose = 2))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  warnings <- capture_warnings(
    results <- artma:::invoke_runtime_methods(methods = "all", df = df, modules_dir = methods_dir)
  )

  expect_equal(length(results), 0L)
  expect_setequal(names(attr(results, "failed_methods")), c("method_a", "method_b"))
  expect_true(any(grepl("All 2 requested methods failed", warnings)))
})

test_that("partial results from a run with a failing method are exported", {
  box::use(artma / output / export[export_results])

  fake_methods <- list(
    method_a = list(run = function(df, ...) list(tables = list(summary = data.frame(estimate = 1)))),
    method_b = list(run = function(df, ...) cli::cli_abort("boom")),
    method_c = list(run = function(df, ...) list(tables = list(summary = data.frame(estimate = 3))))
  )
  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(methods = "all", df = df, modules_dir = methods_dir)

  output_dir <- withr::local_tempdir()
  dir.create(file.path(output_dir, "tables"), recursive = TRUE)
  export_results(results, output_dir)

  expect_true(file.exists(file.path(output_dir, "tables", "method_a.csv")))
  expect_true(file.exists(file.path(output_dir, "tables", "method_c.csv")))
  expect_equal(length(list.files(file.path(output_dir, "tables"))), 2L)
})

test_that("invoke_runtime_methods forwards BMA result to dependent methods", {
  fake_methods <- list(
    bma = list(run = function(df, ...) list(token = "bma-ready")),
    best_practice_estimate = list(
      run = function(df, bma_result = NULL, ...) {
        if (is.null(bma_result)) {
          return("missing")
        }
        bma_result$token
      },
      meta = list(depends_on = "bma")
    )
  )

  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(
    methods = c("best_practice_estimate", "bma"),
    df = df,
    modules_dir = methods_dir
  )

  expect_named(results, c("bma", "best_practice_estimate"))
  expect_equal(results$best_practice_estimate, "bma-ready")
})

test_that("invoke_runtime_methods runs bma before its dependents when requested in reverse", {
  # fma and best_practice_estimate both depend on bma. Requested last-first,
  # the topological sort must still run bma before either dependent.
  fake_methods <- list(
    best_practice_estimate = list(
      run = function(df, ...) "bpe",
      meta = list(depends_on = "bma")
    ),
    fma = list(
      run = function(df, ...) "fma",
      meta = list(depends_on = "bma")
    ),
    bma = list(run = function(df, ...) "bma")
  )

  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(
    methods = c("best_practice_estimate", "fma", "bma"),
    df = df,
    modules_dir = methods_dir
  )

  bma_pos <- which(names(results) == "bma")
  expect_true(bma_pos < which(names(results) == "fma"))
  expect_true(bma_pos < which(names(results) == "best_practice_estimate"))
})

test_that("invoke_runtime_methods honors a transitive dependency chain", {
  # Explicit chain c -> b -> a; requested in reverse must run a, then b, then c.
  fake_methods <- list(
    c_method = list(run = function(df, ...) "c", meta = list(depends_on = "b_method")),
    b_method = list(run = function(df, ...) "b", meta = list(depends_on = "a_method")),
    a_method = list(run = function(df, ...) "a")
  )

  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(
    methods = c("c_method", "b_method", "a_method"),
    df = df,
    modules_dir = methods_dir
  )

  expect_equal(names(results), c("a_method", "b_method", "c_method"))
})

test_that("invoke_runtime_methods runs a discovered method absent from any order list", {
  # Regression for the silent-drop bug: a method with no declared metadata and
  # no place in a hardcoded order must still run.
  fake_methods <- list(
    method_a = list(run = function(df, ...) "a"),
    orphan_method = list(run = function(df, ...) "orphan")
  )

  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(methods = "all", df = df, modules_dir = methods_dir)

  expect_setequal(names(results), c("method_a", "orphan_method"))
  expect_equal(results$orphan_method, "orphan")
})

test_that("invoke_runtime_methods skips a method whose required columns are missing", {
  fake_methods <- list(
    needs_effect = list(
      run = function(df, ...) "ran",
      meta = list(required_columns = "effect")
    ),
    always_runs = list(run = function(df, ...) "ok")
  )

  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(methods = "all", df = df, modules_dir = methods_dir)

  expect_setequal(names(results), "always_runs")
  skipped <- attr(results, "skipped_methods")
  expect_named(skipped, "needs_effect")
  expect_match(unname(skipped[["needs_effect"]]), "effect")
})

test_that("invoke_runtime_methods skips a method whose suggested package is missing", {
  fake_methods <- list(
    needs_pkg = list(
      run = function(df, ...) "ran",
      meta = list(suggests = "artmaNoSuchPackage")
    ),
    always_runs = list(run = function(df, ...) "ok")
  )

  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(methods = "all", df = df, modules_dir = methods_dir)

  expect_setequal(names(results), "always_runs")
  skipped <- attr(results, "skipped_methods")
  expect_named(skipped, "needs_pkg")
  expect_match(unname(skipped[["needs_pkg"]]), "artmaNoSuchPackage")
})

test_that("invoke_runtime_methods aborts for a lone non-interactive method missing its package", {
  fake_methods <- list(
    needs_pkg = list(
      run = function(df, ...) "ran",
      meta = list(suggests = "artmaNoSuchPackage")
    )
  )

  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  # Non-interactive session (testthat) with a single requested method: hard abort.
  expect_error(
    artma:::invoke_runtime_methods(methods = "needs_pkg", df = df, modules_dir = methods_dir),
    "artmaNoSuchPackage"
  )
})

test_that("invoke_runtime_methods hands the unwinsorized frame to methods that opt out", {
  fake_methods <- list(
    clipped = list(run = function(df, ...) max(df$effect)),
    raw = list(
      run = function(df, ...) max(df$effect),
      meta = list(winsorize = FALSE)
    )
  )
  methods_dir <- local_mock_methods_dir(fake_methods)
  withr::local_options(list(artma.verbose = 1, artma.data.winsorization_level = 0.05))
  df <- data.frame(effect = c(1, 2, 3), se = 1)
  unwinsorized <- data.frame(effect = c(1, 2, 30), se = 1)
  builds <- 0L

  results <- artma:::invoke_runtime_methods(
    methods = c("clipped", "raw"),
    df = df,
    modules_dir = methods_dir,
    unwinsorized_df = function() {
      builds <<- builds + 1L
      unwinsorized
    }
  )

  expect_equal(results$clipped, 3)
  expect_equal(results$raw, 30)
  expect_equal(builds, 1L)
})

test_that("invoke_runtime_methods runs an opted-out method on df when winsorization is off", {
  fake_methods <- list(
    raw = list(run = function(df, ...) max(df$effect), meta = list(winsorize = FALSE))
  )
  methods_dir <- local_mock_methods_dir(fake_methods)
  withr::local_options(list(artma.verbose = 1, artma.data.winsorization_level = 0))
  built <- FALSE

  results <- artma:::invoke_runtime_methods(
    methods = "raw",
    df = data.frame(effect = c(1, 2, 3), se = 1),
    modules_dir = methods_dir,
    unwinsorized_df = function() {
      built <<- TRUE
      data.frame(effect = 30, se = 1)
    }
  )

  expect_equal(results$raw, 3)
  expect_false(built)
})

test_that("invoke_runtime_methods warns when an opted-out method gets no unwinsorized frame", {
  fake_methods <- list(
    raw = list(run = function(df, ...) max(df$effect), meta = list(winsorize = FALSE))
  )
  methods_dir <- local_mock_methods_dir(fake_methods)
  withr::local_options(list(artma.verbose = 2, artma.data.winsorization_level = 0.05))

  messages <- capture_messages(
    results <- artma:::invoke_runtime_methods(
      methods = "raw",
      df = data.frame(effect = c(1, 2, 3), se = 1),
      modules_dir = methods_dir
    )
  )

  expect_equal(results$raw, 3)
  expect_true(any(grepl("no unwinsorized data frame", messages)))
})

test_that("invoke_runtime_methods fails only the opted-out methods when the unwinsorized frame cannot be built", {
  # The unwinsorized frame reruns the data pipeline with the clipping off, so it
  # can abort (a zero standard error winsorization lifted, say) on data the
  # winsorized frame survived. Only the methods that asked for it fail (#540).
  fake_methods <- list(
    clipped = list(run = function(df, ...) max(df$effect)),
    raw = list(
      run = function(df, ...) max(df$effect),
      meta = list(winsorize = FALSE)
    ),
    raw_too = list(
      run = function(df, ...) min(df$effect),
      meta = list(winsorize = FALSE)
    )
  )
  methods_dir <- local_mock_methods_dir(fake_methods)
  withr::local_options(list(artma.verbose = 1, artma.data.winsorization_level = 0.05))
  builds <- 0L

  results <- artma:::invoke_runtime_methods(
    methods = c("clipped", "raw", "raw_too"),
    df = data.frame(effect = c(1, 2, 3), se = 1),
    modules_dir = methods_dir,
    unwinsorized_df = function() {
      builds <<- builds + 1L
      cli::cli_abort("The 'se' column contains zero values in 1 row.")
    }
  )

  expect_equal(results$clipped, 3)
  expect_setequal(names(results), "clipped")

  failed <- attr(results, "failed_methods")
  expect_setequal(names(failed), c("raw", "raw_too"))
  expect_match(unname(failed[["raw"]]), "without winsorization")
  expect_match(unname(failed[["raw"]]), "contains zero values")
  expect_match(unname(failed[["raw_too"]]), "without winsorization")

  # The failing build is attempted once and its reason reused.
  expect_equal(builds, 1L)
})

test_that("invoke_runtime_methods warns about an unbuildable unwinsorized frame", {
  fake_methods <- list(
    raw = list(run = function(df, ...) max(df$effect), meta = list(winsorize = FALSE))
  )
  methods_dir <- local_mock_methods_dir(fake_methods)
  withr::local_options(list(artma.verbose = 2, artma.data.winsorization_level = 0.05))

  warnings <- capture_warnings(
    results <- artma:::invoke_runtime_methods(
      methods = "raw",
      df = data.frame(effect = c(1, 2, 3), se = 1),
      modules_dir = methods_dir,
      unwinsorized_df = function() cli::cli_abort("no unwinsorized frame for you")
    )
  )

  expect_length(results, 0L)
  expect_true(any(grepl("without winsorization", warnings)))
  expect_true(any(grepl("no unwinsorized frame for you", warnings)))
})

test_that("invoke_runtime_methods produces the same results in parallel and sequentially", {
  cores <- tryCatch(parallel::detectCores(), error = function(err) NA_integer_)
  testthat::skip_if(
    identical(.Platform$OS.type, "windows") || !is.numeric(cores) || is.na(cores) || cores < 2L,
    "forking is unavailable"
  )

  fake_methods <- list(
    method_a = list(run = function(df, ...) list(name = "a", draws = stats::runif(3))),
    method_b = list(run = function(df, ...) list(name = "b", draws = stats::runif(3))),
    method_c = list(run = function(df, ...) list(name = "c", rows = nrow(df)))
  )
  # Pin the seed: without one configured, each invocation derives its own run
  # seed from the session RNG, so two separate runs would differ by design.
  withr::local_options(list(artma.verbose = 0, artma.general.seed = 20240101L))
  methods_dir <- local_mock_methods_dir(fake_methods)
  df <- data.frame(x = 1:5)
  method_names <- c("method_a", "method_b", "method_c")

  withr::local_options(list(artma.general.parallel = FALSE))
  sequential <- artma:::invoke_runtime_methods(
    methods = method_names, df = df, modules_dir = methods_dir
  )

  withr::local_options(list(artma.general.parallel = TRUE))
  concurrent <- artma:::invoke_runtime_methods(
    methods = method_names, df = df, modules_dir = methods_dir
  )

  expect_equal(names(concurrent), method_names)
  # Per-method RNG streams make the stochastic draws identical either way.
  expect_equal(concurrent, sequential)
})

test_that("invoke_runtime_methods records a failure from a forked method", {
  cores <- tryCatch(parallel::detectCores(), error = function(err) NA_integer_)
  testthat::skip_if(
    identical(.Platform$OS.type, "windows") || !is.numeric(cores) || is.na(cores) || cores < 2L,
    "forking is unavailable"
  )

  fake_methods <- list(
    method_a = list(run = function(df, ...) "method_a"),
    method_b = list(run = function(df, ...) stop("method_b exploded")),
    method_c = list(run = function(df, ...) "method_c")
  )
  withr::local_options(list(artma.verbose = 0, artma.general.parallel = TRUE))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(
    methods = c("method_a", "method_b", "method_c"), df = df, modules_dir = methods_dir
  )

  expect_setequal(names(results), c("method_a", "method_c"))
  failed <- attr(results, "failed_methods")
  expect_equal(names(failed), "method_b")
  expect_match(failed[["method_b"]], "method_b exploded")
})

test_that("invoke_runtime_methods explains a forked method that was killed", {
  cores <- tryCatch(parallel::detectCores(), error = function(err) NA_integer_)
  testthat::skip_if(
    identical(.Platform$OS.type, "windows") || !is.numeric(cores) || is.na(cores) || cores < 2L,
    "forking is unavailable"
  )

  # A worker that dies without signalling (a segfault in a graphics device is
  # the real-world case) used to be recorded as a failure with an empty message.
  # Only ever signal a *forked child*: if this were to run in the current
  # process (because the layer fell back to sequential execution) the kill would
  # take down the testthat subprocess running this file. These methods are
  # written out to a module file, so they cannot close over a local variable;
  # the forked-worker option is set in the child and is readable there.
  fake_methods <- list(
    method_a = list(run = function(df, ...) "method_a"),
    method_b = list(run = function(df, ...) {
      if (!isTRUE(getOption("artma.temp.forked_worker", FALSE))) {
        return("method_b ran in the parent")
      }
      tools::pskill(Sys.getpid())
    }),
    method_c = list(run = function(df, ...) "method_c")
  )
  # Graphics exports force sequential execution where no fork-safe device
  # exists, so turn them off to keep this layer genuinely parallel.
  withr::local_options(list(
    artma.verbose = 0,
    artma.general.parallel = TRUE,
    artma.visualization.export_graphics = FALSE
  ))
  methods_dir <- local_mock_methods_dir(fake_methods)

  box::use(artma / modules / method_execution[resolve_worker_count])
  testthat::skip_if(
    resolve_worker_count(3L) < 2L,
    "this environment runs method layers sequentially"
  )

  df <- data.frame(x = 1:3)
  results <- suppressWarnings(artma:::invoke_runtime_methods(
    methods = c("method_a", "method_b", "method_c"), df = df, modules_dir = methods_dir
  ))

  failed <- attr(results, "failed_methods")
  expect_equal(names(failed), "method_b")
  expect_true(nzchar(failed[["method_b"]]))
  expect_match(failed[["method_b"]], "method_b")
})

test_that("invoke_runtime_methods passes dependency results across layers", {
  fake_methods <- list(
    method_a = list(run = function(df, ...) "from_a"),
    method_b = list(
      run = function(df, method_a_result = NULL, ...) method_a_result,
      meta = list(stage = "method_b", depends_on = "method_a")
    )
  )
  withr::local_options(list(artma.verbose = 0, artma.general.parallel = TRUE))
  methods_dir <- local_mock_methods_dir(fake_methods)

  df <- data.frame(x = 1:3)
  results <- artma:::invoke_runtime_methods(
    methods = c("method_a", "method_b"), df = df, modules_dir = methods_dir
  )

  expect_equal(results$method_b, "from_a")
})

test_that("two runs with the same pinned seed produce identical stochastic results", {
  fake_methods <- list(
    noisy = list(run = function(df, ...) stats::rnorm(5))
  )
  withr::local_options(list(artma.verbose = 0, artma.general.seed = 20240101L))
  methods_dir <- local_mock_methods_dir(fake_methods)
  df <- data.frame(x = 1:3)

  first <- artma:::invoke_runtime_methods(methods = "noisy", df = df, modules_dir = methods_dir)
  second <- artma:::invoke_runtime_methods(methods = "noisy", df = df, modules_dir = methods_dir)
  expect_equal(first, second)

  withr::local_options(list(artma.general.seed = 7L))
  reseeded <- artma:::invoke_runtime_methods(methods = "noisy", df = df, modules_dir = methods_dir)
  expect_false(identical(first$noisy, reseeded$noisy))
})

test_that("an NA seed hands control of the run to the session RNG", {
  fake_methods <- list(
    noisy = list(run = function(df, ...) stats::rnorm(5))
  )
  withr::local_options(list(artma.verbose = 0, artma.general.seed = NA))
  methods_dir <- local_mock_methods_dir(fake_methods)
  df <- data.frame(x = 1:3)

  run_once <- function() {
    artma:::invoke_runtime_methods(methods = "noisy", df = df, modules_dir = methods_dir)
  }

  set.seed(42)
  first <- run_once()
  set.seed(42)
  second <- run_once()
  expect_equal(first, second)

  # Without reseeding, the next run derives a fresh seed from the session RNG.
  third <- run_once()
  expect_false(identical(first$noisy, third$noisy))

  # The pin of the derived seed is scoped to the run.
  expect_true(is.na(getOption("artma.general.seed")))
})

test_that("invoke_runtime_methods restores the session RNG state it found", {
  fake_methods <- list(
    noisy = list(run = function(df, ...) stats::rnorm(5))
  )
  withr::local_options(list(artma.verbose = 0, artma.general.seed = 20240101L))
  methods_dir <- local_mock_methods_dir(fake_methods)
  df <- data.frame(x = 1:3)

  set.seed(1)
  expected_next <- stats::rnorm(1)
  set.seed(1)
  artma:::invoke_runtime_methods(methods = "noisy", df = df, modules_dir = methods_dir)

  # A sequential layer runs methods in this process; their stream state must
  # not leak into what the caller draws next.
  expect_equal(stats::rnorm(1), expected_next)
})

# Pipeline steps ------------------------------------------------------------
#
# artma()'s linear path is prepare_run_context() -> execute_run() ->
# summarize_run(); the session hub calls the same three steps repeatedly. These
# tests drive the steps directly, with the stub methods dir standing in for the
# package methods.

# Current depth of the output-file capture stack, measured by opening a probe
# frame (its identifier is the new depth) and closing it again.
capture_depth <- function() {
  box::use(
    artma / libs / infrastructure / output_files[
      begin_output_file_capture, end_output_file_capture
    ]
  )
  probe <- begin_output_file_capture()
  end_output_file_capture(probe)
  probe - 1L
}

# A context as prepare_run_context() returns one, without preparing any data.
local_run_context <- function(df, save_results = TRUE, env = parent.frame()) {
  box::use(
    artma / libs / infrastructure / output_files[
      begin_output_file_capture, end_output_file_capture
    ],
    artma / output / export[ensure_output_dirs]
  )

  output_dir <- NULL
  if (isTRUE(save_results)) {
    output_dir <- withr::local_tempdir(.local_envir = env)
    ensure_output_dirs(output_dir)
  }

  capture <- begin_output_file_capture()
  withr::defer(end_output_file_capture(capture), envir = env)

  list(df = df, output_dir = output_dir, save_results = save_results, capture = capture)
}

test_that("execute_run invokes the methods and reports no files when results are not saved", {
  fake_methods <- list(
    method_a = list(run = function(df, ...) list(tables = list(summary = data.frame(estimate = 1))))
  )
  withr::local_options(list(artma.verbose = 0))
  methods_dir <- local_mock_methods_dir(fake_methods)

  context <- local_run_context(data.frame(x = 1:3), save_results = FALSE)
  depth_before <- capture_depth()

  run <- artma:::execute_run(context, methods = "method_a", modules_dir = methods_dir)

  expect_named(run, c("results", "run_files", "context"))
  expect_named(run$results, "method_a")
  expect_equal(run$run_files, character())
  # Nothing was exported, so the capture is still the caller's to close.
  expect_equal(capture_depth(), depth_before)
})

test_that("execute_run hands an opted-out method the context's unwinsorized frame", {
  fake_methods <- list(
    raw = list(
      run = function(df, ...) list(tables = list(), meta = list(max_effect = max(df$effect))),
      meta = list(winsorize = FALSE)
    )
  )
  withr::local_options(list(artma.verbose = 0, artma.data.winsorization_level = 0.05))
  methods_dir <- local_mock_methods_dir(fake_methods)

  context <- local_run_context(data.frame(effect = c(1, 2, 3), se = 1), save_results = FALSE)
  context$unwinsorized_df <- function() data.frame(effect = c(1, 2, 30), se = 1)

  run <- artma:::execute_run(context, methods = "raw", modules_dir = methods_dir)

  expect_equal(run$results$raw$meta$max_effect, 30)
})

test_that("execute_run exports tables, writes the manifest, and closes the capture", {
  box::use(artma / output / run_manifest[read_run_manifest])

  fake_methods <- list(
    method_a = list(run = function(df, ...) list(tables = list(summary = data.frame(estimate = 1)))),
    method_b = list(run = function(df, ...) list(tables = list(summary = data.frame(estimate = 2))))
  )
  withr::local_options(list(artma.verbose = 0, artma.output.report = FALSE))
  methods_dir <- local_mock_methods_dir(fake_methods)

  context <- local_run_context(data.frame(x = 1:3))
  depth_before <- capture_depth()

  run <- artma:::execute_run(
    context,
    methods = c("method_a", "method_b"),
    modules_dir = methods_dir
  )

  expect_setequal(names(run$results), c("method_a", "method_b"))
  expect_true(file.exists(file.path(context$output_dir, "tables", "method_a.csv")))
  expect_true(file.exists(file.path(context$output_dir, "run.json")))

  # The exported tables were recorded before the capture closed, so the
  # manifest describes this run rather than the directory's contents.
  expect_true(any(basename(run$run_files) == "method_a.csv"))
  manifest <- read_run_manifest(context$output_dir)
  expect_setequal(as.character(manifest$methods_run), c("method_a", "method_b"))

  # The run step owns closing the capture it was handed.
  expect_equal(capture_depth(), depth_before - 1L)
})

test_that("execute_run gives every run its own subdirectory when they are enabled", {
  box::use(
    artma / libs / infrastructure / output_files[begin_output_file_capture],
    artma / output / export[latest_run_output_dir],
    artma / output / run_manifest[read_run_manifest]
  )

  fake_methods <- list(
    method_a = list(run = function(df, ...) list(tables = list(summary = data.frame(estimate = 1)))),
    method_b = list(run = function(df, ...) list(tables = list(summary = data.frame(estimate = 2))))
  )
  withr::local_options(list(
    artma.verbose = 0,
    artma.output.report = FALSE,
    artma.output.run_subdirectories = TRUE,
    artma.temp.run_output_dir = NULL
  ))
  methods_dir <- local_mock_methods_dir(fake_methods)

  # Both runs share one base directory, the way the hub's runs share one
  # prepared context.
  base <- withr::local_tempdir()
  run_context <- function() {
    list(
      df = data.frame(x = 1:3),
      output_dir = base,
      save_results = TRUE,
      capture = begin_output_file_capture()
    )
  }

  first <- artma:::execute_run(run_context(), methods = "method_a", modules_dir = methods_dir)
  second <- artma:::execute_run(run_context(), methods = "method_b", modules_dir = methods_dir)

  first_dir <- first$context$output_dir
  second_dir <- second$context$output_dir
  expect_false(identical(first_dir, second_dir))
  runs_dir <- normalizePath(file.path(base, "runs"), winslash = "/", mustWork = FALSE)
  expect_equal(normalizePath(dirname(first_dir), winslash = "/"), runs_dir)
  expect_equal(normalizePath(dirname(second_dir), winslash = "/"), runs_dir)

  # Each run's outputs and manifest stay with that run.
  expect_true(file.exists(file.path(first_dir, "tables", "method_a.csv")))
  expect_true(file.exists(file.path(second_dir, "tables", "method_b.csv")))
  expect_false(file.exists(file.path(first_dir, "tables", "method_b.csv")))
  expect_equal(as.character(read_run_manifest(first_dir)$methods_run), "method_a")
  expect_equal(as.character(read_run_manifest(second_dir)$methods_run), "method_b")

  # What results_open() lands on.
  expect_equal(latest_run_output_dir(base), second_dir)
})

test_that("execute_run keeps the run alive when the report fails to render", {
  fake_methods <- list(
    method_a = list(run = function(df, ...) list(tables = list(summary = data.frame(estimate = 1))))
  )
  withr::local_options(list(artma.verbose = 0, artma.output.report = TRUE))
  methods_dir <- local_mock_methods_dir(fake_methods)

  context <- local_run_context(data.frame(x = 1:3))
  # An unwritable report path makes the render fail without touching anything
  # else the run produces.
  dir.create(file.path(context$output_dir, "report.html"))

  run <- artma:::execute_run(context, methods = "method_a", modules_dir = methods_dir)

  expect_named(run$results, "method_a")
  expect_true(file.exists(file.path(context$output_dir, "run.json")))
})

test_that("prepare_run_context hands over an open capture with the prepared data", {
  withr::local_options(prepare_step_options)
  withr::local_options(list(artma.verbose = 0, artma.output.save_results = FALSE))
  depth_before <- capture_depth()

  context <- artma:::prepare_run_context(data = NULL, methods = "funnel_plot")
  withr::defer({
    box::use(artma / libs / infrastructure / output_files[end_output_file_capture])
    end_output_file_capture(context$capture)
  })

  expect_null(context$output_dir)
  expect_false(isTRUE(context$save_results))
  expect_true(is.data.frame(context$df))
  expect_true(all(c("effect", "se") %in% names(context$df)))
  # The capture stays open: the run step (or artma()'s on.exit) closes it.
  expect_equal(capture_depth(), depth_before + 1L)
})

test_that("prepare_run_context preprocesses a supplied data frame the same way", {
  withr::local_options(prepare_step_options)
  withr::local_options(list(artma.verbose = 0, artma.output.save_results = TRUE))
  output_dir <- withr::local_tempdir()
  withr::local_options(list(artma.output.dir = output_dir))

  from_file <- artma:::prepare_run_context(data = NULL, methods = "funnel_plot")
  box::use(
    artma / data / read[read_data],
    artma / libs / infrastructure / output_files[end_output_file_capture]
  )
  end_output_file_capture(from_file$capture)

  from_data <- artma:::prepare_run_context(data = read_data(), methods = "funnel_plot")
  withr::defer(end_output_file_capture(from_data$capture))

  expect_true(is.data.frame(from_data$df))
  expect_true(all(c("effect", "se") %in% names(from_data$df)))
  expect_equal(names(from_data$df), names(from_file$df))
  # The output directories are resolved and created before any data work.
  expect_equal(from_data$output_dir, output_dir)
  expect_true(dir.exists(file.path(output_dir, "tables")))
})

test_that("prepare_run_context exposes an unwinsorized variant of the prepared frame", {
  withr::local_options(prepare_step_options)
  withr::local_options(list(
    artma.verbose = 0,
    artma.output.save_results = FALSE,
    artma.data.winsorization_level = 0.1
  ))
  box::use(
    artma / data / read[read_data],
    artma / libs / infrastructure / output_files[end_output_file_capture]
  )

  from_file <- artma:::prepare_run_context(data = NULL, methods = "funnel_plot")
  end_output_file_capture(from_file$capture)
  from_data <- artma:::prepare_run_context(data = read_data(), methods = "funnel_plot")
  withr::defer(end_output_file_capture(from_data$capture))

  for (context in list(from_file, from_data)) {
    clipped <- context$df
    raw <- context$unwinsorized_df()

    expect_equal(dim(raw), dim(clipped))
    expect_equal(names(raw), names(clipped))
    expect_equal(raw$obs_id, clipped$obs_id)
    # Winsorization pulled the tails in; the unwinsorized frame keeps them,
    # and its derived columns follow the unclipped values.
    expect_true(max(raw$effect) > max(clipped$effect))
    expect_true(max(raw$se) > max(clipped$se))
    expect_equal(raw$precision, 1 / raw$se)
    # Built once, then kept for the context's lifetime.
    expect_true(identical(context$unwinsorized_df(), raw))
  }
})

test_that("prepare_run_context closes its capture when preparation fails", {
  withr::local_options(list(
    artma.verbose = 0,
    artma.output.save_results = FALSE,
    artma.data.source_path = NULL
  ))
  depth_before <- capture_depth()

  expect_error(artma:::prepare_run_context(data = NULL, methods = "funnel_plot"))

  expect_equal(capture_depth(), depth_before)
})

test_that("summarize_run prints the closing messages and returns the results invisibly", {
  context <- local_run_context(data.frame(x = 1:3))
  results <- list(method_a = list(tables = list()))
  attr(results, "run_info") <- list(
    methods_requested = "method_a",
    seed = 1L,
    output_files = list()
  )
  withr::local_options(list(artma.verbose = 3))

  messages <- capture_messages(
    returned <- withVisible(artma:::summarize_run(results, context = context))
  )

  expect_false(returned$visible)
  expect_equal(returned$value, results)
  expect_true(any(grepl("Analysis complete", messages)))
  expect_true(any(grepl("results_open", messages)))
})

test_that("summarize_run omits the results-directory hint when nothing was saved", {
  context <- local_run_context(data.frame(x = 1:3), save_results = FALSE)
  results <- list(method_a = list(tables = list()))
  attr(results, "run_info") <- list(
    methods_requested = "method_a",
    seed = 1L,
    output_files = list()
  )
  withr::local_options(list(artma.verbose = 3))

  messages <- capture_messages(artma:::summarize_run(results, context = context))

  expect_true(any(grepl("Analysis complete", messages)))
  expect_false(any(grepl("results_open", messages)))
})