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") })