tests/testthat/test-libs-cache.R

In artma: Automatic Replication Tools for Meta-Analysis

box::use(
  testthat[
    test_that, expect_s3_class, expect_equal, expect_length,
    expect_identical, expect_match, expect_no_match, expect_true
  ]
)

# The fixtures and other package modules must be loaded here separately to avoid linter issues
box::use(testing / fixtures / index[FIXTURES])

test_that("new_artifact constructs the correct S3 object", {
  box::use(artma / libs / infrastructure / cache[new_artifact])

  a <- new_artifact(1:3, list(pkg = "demo"))
  expect_s3_class(a, "cached_artifact")
  expect_equal(a$value, 1:3)
  expect_equal(a$meta$pkg, "demo")
})

test_that("print.cached_artifact produces a human-readable summary", {
  FIXTURES$local_cli_silence()

  box::use(artma / libs / infrastructure / cache[new_artifact, print.cached_artifact])

  art <- new_artifact(99, list(note = "demo"))
  out <- testthat::capture_messages(print.cached_artifact(art))

  expect_true(any(grepl("Artifact", out, fixed = TRUE)))
  expect_true(any(grepl("Value:", out, fixed = TRUE)))
  expect_true(any(grepl("Meta:", out, fixed = TRUE)))
})

test_that("cache_cli reruns on a miss and reuses the value on a hit", {
  box::use(artma / libs / infrastructure / cache[cache_cli, get_artifact])

  FIXTURES$local_cli_silence()

  # unset the TTL option so the artifact records the sourced default (3600)
  withr::local_options(list(artma.cache.max_age = NULL))

  # use an *ephemeral* cache so tests are self-contained
  tmp_cache <- memoise::cache_filesystem(withr::local_tempdir())

  fake_modeller <- FIXTURES$make_fake_modeller()
  cached_modeller <- cache_cli(fake_modeller$modeller, cache = tmp_cache)

  ## --- 1st call: cold ------------------------------------------------------
  first <- testthat::capture_messages(v1 <- cached_modeller(10))
  expect_equal(v1, 20)
  expect_equal(fake_modeller$calls(), 1L)
  expect_match(paste(first, collapse = ""), "Running model", fixed = TRUE)

  # cache should now contain exactly one key
  expect_length(tmp_cache$keys(), 1L)

  ## --- 2nd call: warm ------------------------------------------------------
  testthat::capture_messages(v2 <- cached_modeller(10))
  expect_equal(v2, 20)

  # the implementation must not run again on a cache hit
  expect_equal(fake_modeller$calls(), 1L)

  # still only one artifact stored
  expect_length(tmp_cache$keys(), 1L)

  ## --- inspect the artifact -----------------------------------------------
  key <- tmp_cache$keys()[[1]]
  art <- get_artifact(tmp_cache, key)
  expect_s3_class(art, "cached_artifact")
  expect_equal(art$value, 20)
  expect_equal(art$meta$cache$max_age, 3600)
})

test_that("a cache hit prints a notice instead of replaying original output", {
  box::use(artma / libs / infrastructure / cache[cache_cli])

  FIXTURES$local_cli_silence()

  withr::local_options(list(artma.verbose = 3, artma.cache.max_age = 3600))

  tmp_cache <- memoise::cache_filesystem(withr::local_tempdir())

  fake_modeller <- FIXTURES$make_fake_modeller()
  cached_modeller <- cache_cli(
    fake_modeller$modeller,
    extra_keys = list(stage = "demo"),
    cache = tmp_cache
  )

  # cold run: the implementation's own chatter is emitted
  cold <- paste(testthat::capture_messages(cached_modeller(10)), collapse = "")
  expect_match(cold, "Running model", fixed = TRUE)

  # warm run: a single notice, and none of the original output replayed
  hit <- paste(testthat::capture_messages(cached_modeller(10)), collapse = "")
  expect_match(hit, "Using cached results for demo", fixed = TRUE)
  expect_no_match(hit, "Running model", fixed = TRUE)
})

test_that("a cache hit stays silent below info verbosity", {
  box::use(artma / libs / infrastructure / cache[cache_cli])

  FIXTURES$local_cli_silence()

  withr::local_options(list(artma.verbose = 2, artma.cache.max_age = 3600))

  tmp_cache <- memoise::cache_filesystem(withr::local_tempdir())

  fake_modeller <- FIXTURES$make_fake_modeller()
  cached_modeller <- cache_cli(
    fake_modeller$modeller,
    extra_keys = list(stage = "demo"),
    cache = tmp_cache
  )

  testthat::capture_messages(cached_modeller(10))
  hit <- paste(testthat::capture_messages(cached_modeller(10)), collapse = "")
  expect_no_match(hit, "Using cached results", fixed = TRUE)
})

test_that("invalidate_fun forces recomputation for selected arguments", {
  box::use(artma / libs / infrastructure / cache[cache_cli])

  FIXTURES$local_cli_silence()

  tmp_cache <- memoise::cache_filesystem(withr::local_tempdir())

  hits <- 0L
  counted_modeller <- function(x) {
    hits <<- hits + 1L
    cli::cli_alert("count {hits}")
    x * 2
  }

  invalidate_when_neg <- function(x) x < 0

  cached_modeller <- cache_cli(counted_modeller,
    invalidate_fun = invalidate_when_neg,
    cache = tmp_cache
  )

  testthat::capture_messages(cached_modeller(1))
  expect_equal(hits, 1L)
  expect_length(tmp_cache$keys(), 1L)

  testthat::capture_messages(cached_modeller(1))
  expect_equal(hits, 1L)

  testthat::capture_messages(cached_modeller(-1))
  expect_equal(hits, 2L)
  expect_length(tmp_cache$keys(), 1L)
})

test_that("cache_cli honours max_age to refresh stale artifacts", {
  box::use(artma / libs / infrastructure / cache[cache_cli])

  FIXTURES$local_cli_silence()

  tmp_cache <- memoise::cache_filesystem(withr::local_tempdir())

  hits <- 0L
  tracked <- function(x) {
    hits <<- hits + 1L
    cli::cli_alert_success("call {hits}")
    x + hits
  }

  cached <- cache_cli(tracked, cache = tmp_cache, max_age = 0)

  testthat::capture_messages(cached(5))
  expect_equal(hits, 1L)
  expect_length(tmp_cache$keys(), 1L)

  # a zero TTL makes every stored artifact stale on read, forcing a recompute
  testthat::capture_messages(cached(5))
  expect_equal(hits, 2L)
})

test_that("cache_cli sources max_age from the artma.cache.max_age option", {
  box::use(artma / libs / infrastructure / cache[cache_cli, get_artifact])

  FIXTURES$local_cli_silence()

  # an expired TTL from the options namespace forces recomputation
  withr::local_options(list(artma.cache.max_age = 0))

  tmp_cache <- memoise::cache_filesystem(withr::local_tempdir())

  hits <- 0L
  tracked <- function(x) {
    hits <<- hits + 1L
    cli::cli_alert_success("call {hits}")
    x
  }

  cached <- cache_cli(tracked, cache = tmp_cache)

  testthat::capture_messages(cached(1))
  expect_equal(hits, 1L)

  testthat::capture_messages(cached(1))
  expect_equal(hits, 2L)

  key <- tmp_cache$keys()[[1]]
  art <- get_artifact(tmp_cache, key)
  expect_equal(art$meta$cache$max_age, 0)

  # a generous TTL from the options namespace keeps the cached value
  withr::local_options(list(artma.cache.max_age = 3600))

  fresh_cache <- memoise::cache_filesystem(withr::local_tempdir())
  fresh_hits <- 0L
  fresh_tracked <- function(x) {
    fresh_hits <<- fresh_hits + 1L
    cli::cli_alert_success("fresh call {fresh_hits}")
    x
  }

  fresh_cached <- cache_cli(fresh_tracked, cache = fresh_cache)

  testthat::capture_messages(fresh_cached(1))
  testthat::capture_messages(fresh_cached(1))
  expect_equal(fresh_hits, 1L)
})

test_that("cache_cli bypasses caching when disabled via option", {
  box::use(artma / libs / infrastructure / cache[cache_cli])

  FIXTURES$local_cli_silence()

  tmp_cache <- memoise::cache_filesystem(withr::local_tempdir())

  hits <- 0L
  tracked <- function(x) {
    hits <<- hits + 1L
    cli::cli_alert_warning("run {hits}")
    x
  }

  withr::with_options(list(artma.cache.use_cache = FALSE), {
    cached <- cache_cli(tracked, cache = tmp_cache)
    testthat::capture_messages(cached(3))
    testthat::capture_messages(cached(3))
  })

  expect_equal(hits, 2L)
  expect_length(tmp_cache$keys(), 0L)
})

test_that("cache_cli_runner injects reusable cache signature metadata", {
  box::use(artma / libs / infrastructure / cache[cache_cli_runner, get_artifact])

  FIXTURES$local_cli_silence()

  tmp_cache <- memoise::cache_memory()
  hits <- 0L
  last_signature <- NULL

  counted <- function(cache_signature = NULL, data) {
    hits <<- hits + 1L
    last_signature <<- cache_signature
    data
  }

  builder <- function(data) list(rows = nrow(data))

  cached <- cache_cli_runner(
    counted,
    stage = "runner_test",
    key_builder = builder,
    cache = tmp_cache
  )

  sample_data <- head(iris)

  cached(sample_data)
  expect_equal(hits, 1L)
  expect_identical(
    last_signature,
    list(stage = "runner_test", rows = nrow(sample_data))
  )
  expect_length(tmp_cache$keys(), 1L)

  cached(sample_data)
  expect_equal(hits, 1L)

  key <- tmp_cache$keys()[[1]]
  art <- get_artifact(tmp_cache, key)
  expect_identical(art$meta$extra$stage, "runner_test")
})

test_that("cache_cli_runner works with implementations that ignore cache_signature", {
  box::use(artma / libs / infrastructure / cache[cache_cli_runner])

  FIXTURES$local_cli_silence()

  tmp_cache <- memoise::cache_memory()
  hits <- 0L

  counted <- function(x) {
    hits <<- hits + 1L
    x * 2
  }

  cached <- cache_cli_runner(
    counted,
    stage = "no_sig",
    key_builder = function(x) list(value = x),
    cache = tmp_cache
  )

  cached(2)
  expect_equal(hits, 1L)
  cached(2)
  expect_equal(hits, 1L)
})

test_that("cache_cli_runner isolates caches across stages", {
  box::use(artma / libs / infrastructure / cache[cache_cli_runner])

  FIXTURES$local_cli_silence()

  shared_cache <- memoise::cache_memory()
  counts <- new.env(parent = emptyenv())
  counts$first <- 0L
  counts$second <- 0L

  make_impl <- function(name) {
    function(df) {
      counts[[name]] <- counts[[name]] + 1L
      sprintf("%s_result", name)
    }
  }

  key_builder <- function(df) list(rows = nrow(df))

  first_runner <- cache_cli_runner(
    make_impl("first"),
    stage = "stage_one",
    key_builder = key_builder,
    cache = shared_cache
  )

  second_runner <- cache_cli_runner(
    make_impl("second"),
    stage = "stage_two",
    key_builder = key_builder,
    cache = shared_cache
  )

  sample_df <- data.frame(x = 1)

  expect_identical(first_runner(sample_df), "first_result")
  expect_identical(second_runner(sample_df), "second_result")
  expect_equal(counts$first, 1L)
  expect_equal(counts$second, 1L)

  # cache hits should not trigger additional executions
  expect_identical(first_runner(sample_df), "first_result")
  expect_identical(second_runner(sample_df), "second_result")
  expect_equal(counts$first, 1L)
  expect_equal(counts$second, 1L)
})

test_that("a cache hit replays the recorded output files into the enclosing capture", {
  box::use(
    artma / libs / infrastructure / cache[cache_cli],
    artma / libs / infrastructure / output_files[
      begin_output_file_capture, end_output_file_capture, record_output_file
    ]
  )

  FIXTURES$local_cli_silence()

  work <- withr::local_tempdir()
  plot_path <- file.path(work, "plot.png")

  impl <- function(df) {
    file.create(plot_path)
    record_output_file(plot_path)
    "done"
  }

  cached <- cache_cli(impl, cache = memoise::cache_memory())
  sample_df <- data.frame(x = 1)

  capture_files <- function() {
    id <- begin_output_file_capture()
    cached(sample_df)
    end_output_file_capture(id)
  }

  # The run that wrote the file and the run that reused its result must both
  # tell the caller about it: the run manifest, and through it the report's
  # plot index, is built from what the capture saw.
  expect_equal(basename(capture_files()), "plot.png")
  expect_equal(basename(capture_files()), "plot.png")
})