tests/testthat/test-module-cache.R

# Tests for ModuleCache (R/module-cache.R): module caching system

# Default ambient macro hash for cache tests
.test_ambient_hash <- "00000000000000000000000000000000"

# Default compiler flags for cache tests (all TRUE = default compiler state)
.test_compiler_flags <- c(
  enable_tco = TRUE, enable_constant_folding = TRUE,
  enable_dead_code_elim = TRUE, enable_strength_reduction = TRUE,
  enable_identity_elim = TRUE, enable_truthiness_opt = TRUE,
  enable_begin_simplify = TRUE, enable_boolean_flatten = TRUE
)

# Cache path generation tests
thin <- make_cran_thinner()

test_that("get_paths() returns NULL for non-existent file", {
  thin()
  cache <- arl:::ModuleCache$new()
  paths <- cache$get_paths("/nonexistent/file.arl")
  expect_null(paths)
})

test_that("get_paths() returns expected structure", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  paths <- cache$get_paths(tmp_file)

  expect_type(paths, "list")
  expect_true(all(c("cache_dir", "code_cache", "code_r", "file_hash") %in% names(paths)))
  user_cache <- tools::R_user_dir("arl", "cache")
  expect_true(startsWith(normalizePath(paths$cache_dir, mustWork = FALSE, winslash = "/"),
                         normalizePath(user_cache, mustWork = FALSE, winslash = "/")))
  expect_true(grepl("\\.code\\.rds$", paths$code_cache))
  expect_true(grepl("\\.code\\.R$", paths$code_r))
  expect_true(nchar(paths$file_hash) == 32) # MD5 hash length
})

test_that("get_paths() hash changes when file content changes", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  paths1 <- cache$get_paths(tmp_file)
  hash1 <- paths1$file_hash

  # Modify file
  writeLines("(module test (export foo bar))", tmp_file)
  paths2 <- cache$get_paths(tmp_file)
  hash2 <- paths2$file_hash

  expect_false(hash1 == hash2)
})

# expr cache tests
test_that("write_code() creates cache files", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit({
    unlink(tmp_file)
    unlink(dirname(tmp_file), recursive = TRUE)
  })

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)

  result <- cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file, paths$file_hash, compiler_flags = .test_compiler_flags, ambient_macro_hash = .test_ambient_hash)

  expect_true(result)
  expect_true(file.exists(paths$code_cache))
  # .code.R only written when debug_cache is TRUE
  expect_false(file.exists(paths$code_r))
})

test_that("write_code() creates human-readable .code.R file when debug_cache is TRUE", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit({
    unlink(tmp_file)
    unlink(dirname(tmp_file), recursive = TRUE)
    options(arl.debug_cache = NULL)
  })

  compiled_body <- list(quote(foo <- 42), quote(bar <- "test"))
  paths <- cache$get_paths(tmp_file)

  options(arl.debug_cache = TRUE)
  cache$write_code("test", compiled_body, c("foo", "bar"), TRUE, FALSE, tmp_file, paths$file_hash, compiler_flags = .test_compiler_flags, ambient_macro_hash = .test_ambient_hash)

  r_code <- readLines(paths$code_r)
  expect_true(any(grepl("module: test", r_code)))
  expect_true(any(grepl("Exports:", r_code)))
  expect_true(any(grepl("Expression", r_code)))
})

test_that("write_code() includes metadata", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit({
    unlink(tmp_file)
    unlink(dirname(tmp_file), recursive = TRUE)
  })

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)

  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file, paths$file_hash, compiler_flags = .test_compiler_flags, ambient_macro_hash = .test_ambient_hash)

  cache_data <- readRDS(paths$code_cache)
  expect_equal(cache_data$version, as.character(utils::packageVersion("arl")))
  expect_equal(cache_data$file_hash, paths$file_hash)
  expect_equal(cache_data$module_name, "test")
  expect_equal(cache_data$exports, c("foo"))
  expect_equal(cache_data$export_all, FALSE)
  expect_equal(length(cache_data$compiled_body), 1)
})

test_that("load_code() returns NULL for non-existent cache", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  result <- cache$load_code("/nonexistent/cache.code.rds", tmp_file)

  expect_null(result)
})

test_that("load_code() loads cache data", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit({
    unlink(tmp_file)
    unlink(dirname(tmp_file), recursive = TRUE)
  })

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)

  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file, paths$file_hash, compiler_flags = .test_compiler_flags, ambient_macro_hash = .test_ambient_hash)

  loaded <- cache$load_code(paths$code_cache, tmp_file, ambient_macro_hash = .test_ambient_hash)

  expect_false(is.null(loaded))
  expect_equal(loaded$module_name, "test")
  expect_equal(loaded$exports, c("foo"))
  expect_equal(loaded$export_all, FALSE)
  expect_equal(length(loaded$compiled_body), 1)
})

test_that("load_code() returns NULL for version mismatch", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)

  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)
  on.exit(unlink(paths$cache_dir, recursive = TRUE), add = TRUE)

  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file, paths$file_hash, compiler_flags = .test_compiler_flags, ambient_macro_hash = .test_ambient_hash)

  # Modify version in cache
  cache_data <- readRDS(paths$code_cache)
  cache_data$version <- "0.0.0.9999"
  saveRDS(cache_data, paths$code_cache)

  result <- cache$load_code(paths$code_cache, tmp_file)

  expect_null(result)
})

test_that("load_code() returns NULL for coverage mismatch", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)

  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)
  on.exit(unlink(paths$cache_dir, recursive = TRUE), add = TRUE)

  # Write cache with coverage = TRUE
  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file, paths$file_hash, coverage = TRUE, compiler_flags = .test_compiler_flags, ambient_macro_hash = .test_ambient_hash)

  # Loading without coverage should reject it
  result <- cache$load_code(paths$code_cache, tmp_file, coverage = FALSE)
  expect_null(result)
})

test_that("load_code() returns NULL for missing coverage field (pre-upgrade cache)", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)

  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)
  on.exit(unlink(paths$cache_dir, recursive = TRUE), add = TRUE)

  # Write a cache, then strip the coverage field to simulate old format
  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file, paths$file_hash, compiler_flags = .test_compiler_flags, ambient_macro_hash = .test_ambient_hash)
  cache_data <- readRDS(paths$code_cache)
  cache_data$coverage <- NULL
  saveRDS(cache_data, paths$code_cache)

  result <- cache$load_code(paths$code_cache, tmp_file)
  expect_null(result)
})

test_that("load_code() returns NULL for hash mismatch", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)

  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths1 <- cache$get_paths(tmp_file)
  on.exit(unlink(paths1$cache_dir, recursive = TRUE), add = TRUE)

  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file, paths1$file_hash, compiler_flags = .test_compiler_flags, ambient_macro_hash = .test_ambient_hash)

  # Modify file content - changes hash
  writeLines("(module test (export foo bar))", tmp_file)
  paths2 <- cache$get_paths(tmp_file)

  # Old cache with old hash should be invalid
  result <- cache$load_code(paths1$code_cache, tmp_file)

  expect_null(result)
})

# Integration test: cache hit path excludes _-prefixed names from export-all
test_that("cache hit path excludes _-prefixed names from export-all exports", {
  thin()
  tmp_dir <- tempfile("cache_underscore_test")
  dir.create(tmp_dir, recursive = TRUE)
  on.exit(unlink(tmp_dir, recursive = TRUE), add = TRUE)

  module_file <- file.path(tmp_dir, "undermod.arl")
  writeLines(c(
    "(module undermod",
    "  (export-all)",
    "  (define public-fn (lambda () 1))",
    "  (define _private-helper (lambda () 2))",
    "  (define __also-private (lambda () 3)))"
  ), module_file)

  eng <- make_engine()

  # First load — populates cache and module registry
  eng$load_file_in_env(module_file)
  entry1 <- engine_field(eng, "env")$module_registry$get("undermod")
  expect_true("public-fn" %in% entry1$exports)
  expect_false("_private-helper" %in% entry1$exports)
  expect_false("__also-private" %in% entry1$exports)

  # Second load with a fresh engine — should hit cache
  eng2 <- make_engine()
  eng2$load_file_in_env(module_file)
  entry2 <- engine_field(eng2, "env")$module_registry$get("undermod")
  expect_true("public-fn" %in% entry2$exports)
  expect_false("_private-helper" %in% entry2$exports,
               info = "cache hit path must exclude _-prefixed names")
  expect_false("__also-private" %in% entry2$exports,
               info = "cache hit path must exclude .__-prefixed names")
})

# --- compiler_flags tests ---

test_that("write_code() stores compiler_flags in cache data", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)
  on.exit(unlink(paths$cache_dir, recursive = TRUE), add = TRUE)
  flags <- c(enable_tco = TRUE, enable_constant_folding = FALSE,
             enable_dead_code_elim = TRUE, enable_strength_reduction = TRUE,
             enable_identity_elim = TRUE, enable_truthiness_opt = TRUE,
             enable_begin_simplify = TRUE, enable_boolean_flatten = TRUE)

  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file,
                   paths$file_hash, compiler_flags = flags)

  cache_data <- readRDS(paths$code_cache)
  expect_equal(cache_data$compiler_flags, flags)
})

test_that("load_code() rejects cache with mismatched compiler_flags", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)
  on.exit(unlink(paths$cache_dir, recursive = TRUE), add = TRUE)
  flags1 <- c(enable_tco = TRUE, enable_constant_folding = TRUE,
              enable_dead_code_elim = TRUE, enable_strength_reduction = TRUE,
              enable_identity_elim = TRUE, enable_truthiness_opt = TRUE,
              enable_begin_simplify = TRUE, enable_boolean_flatten = TRUE)
  flags2 <- c(enable_tco = FALSE, enable_constant_folding = TRUE,
              enable_dead_code_elim = TRUE, enable_strength_reduction = TRUE,
              enable_identity_elim = TRUE, enable_truthiness_opt = TRUE,
              enable_begin_simplify = TRUE, enable_boolean_flatten = TRUE)

  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file,
                   paths$file_hash, compiler_flags = flags1,
                   ambient_macro_hash = .test_ambient_hash)

  # Load with same flags — should succeed
  result_same <- cache$load_code(paths$code_cache, tmp_file, file_hash = paths$file_hash,
                                 compiler_flags = flags1,
                                 ambient_macro_hash = .test_ambient_hash)
  expect_false(is.null(result_same))

  # Load with different flags — should reject (and deletes cache file)
  result_diff <- cache$load_code(paths$code_cache, tmp_file, file_hash = paths$file_hash,
                                 compiler_flags = flags2)
  expect_null(result_diff)
})

test_that("load_code() rejects cache with NULL compiler_flags (pre-upgrade)", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)
  on.exit(unlink(paths$cache_dir, recursive = TRUE), add = TRUE)
  flags <- c(enable_tco = TRUE, enable_constant_folding = TRUE,
             enable_dead_code_elim = TRUE, enable_strength_reduction = TRUE,
             enable_identity_elim = TRUE, enable_truthiness_opt = TRUE,
             enable_begin_simplify = TRUE, enable_boolean_flatten = TRUE)

  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file,
                   paths$file_hash, compiler_flags = flags,
                   ambient_macro_hash = .test_ambient_hash)

  # Strip compiler_flags to simulate old cache format
  cache_data <- readRDS(paths$code_cache)
  cache_data$compiler_flags <- NULL
  saveRDS(cache_data, paths$code_cache)

  result <- cache$load_code(paths$code_cache, tmp_file, file_hash = paths$file_hash,
                            compiler_flags = flags)
  expect_null(result)
})

# --- default_packages NULL rejection ---

test_that("load_code() rejects cache with NULL default_packages (pre-upgrade)", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)
  on.exit(unlink(paths$cache_dir, recursive = TRUE), add = TRUE)

  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file,
                   paths$file_hash, compiler_flags = .test_compiler_flags, ambient_macro_hash = .test_ambient_hash)

  # Set default_packages to NULL to simulate old cache format
  cache_data <- readRDS(paths$code_cache)
  cache_data$default_packages <- NULL
  saveRDS(cache_data, paths$code_cache)

  result <- cache$load_code(paths$code_cache, tmp_file, file_hash = paths$file_hash)
  expect_null(result)
})

# --- stale cache cleanup ---

test_that("write_code() cleans up old cache files for same source", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  # Write cache for hash H1 (with debug_cache to test .code.R cleanup)
  options(arl.debug_cache = TRUE)
  on.exit(options(arl.debug_cache = NULL), add = TRUE)
  paths1 <- cache$get_paths(tmp_file)
  on.exit(unlink(paths1$cache_dir, recursive = TRUE), add = TRUE)
  cache$write_code("test", list(quote(foo <- 42)), c("foo"), FALSE, FALSE,
                   tmp_file, paths1$file_hash)
  expect_true(file.exists(paths1$code_cache))
  expect_true(file.exists(paths1$code_r))

  # Change file, write cache for hash H2
  writeLines("(module test (export foo bar))", tmp_file)
  paths2 <- cache$get_paths(tmp_file)
  cache$write_code("test", list(quote(foo <- 42), quote(bar <- 1)), c("foo", "bar"),
                   FALSE, FALSE, tmp_file, paths2$file_hash)

  # H1 files should be gone, H2 files should exist
  expect_false(file.exists(paths1$code_cache))
  expect_false(file.exists(paths1$code_r))
  expect_true(file.exists(paths2$code_cache))
  expect_true(file.exists(paths2$code_r))
})

# --- TOCTOU: write_code uses provided cache_paths, not fresh get_paths ---

test_that("write_code() uses provided cache_paths instead of recomputing", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("content version 1", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  # Get paths for the original content
  paths_v1 <- cache$get_paths(tmp_file)
  on.exit(unlink(paths_v1$cache_dir, recursive = TRUE), add = TRUE)

  # Change file content (simulates TOCTOU: file changed between read and cache write)
  writeLines("content version 2", tmp_file)

  # Write cache with explicitly provided cache_paths from V1
  # This should write to V1's filename, not recompute a V2 hash
  result <- cache$write_code("test", list(quote(x <- 1)), c("x"), FALSE, FALSE,
                             tmp_file, paths_v1$file_hash, cache_paths = paths_v1)

  expect_true(result)
  expect_true(file.exists(paths_v1$code_cache),
              info = "cache file should be at V1 path (provided cache_paths)")

  # The V2 hash file should NOT exist (we didn't recompute)
  paths_v2 <- cache$get_paths(tmp_file)
  expect_false(file.exists(paths_v2$code_cache),
               info = "no cache file should exist at V2 path")
})

# ============================================================================
# Cache write/read options
# ============================================================================

test_that("code cache is written for loaded modules", {
  thin()
  # Setup: temporary module file
  temp_dir <- withr::local_tempdir()
  module_file <- file.path(temp_dir, "test-module.arl")
  writeLines(c(
    "(module test-module",
    "  (export x)",
    "  (define x 42))"
  ), module_file)

  engine <- Engine$new()

  # Load module (should write code cache)
  engine$load_file_in_env(module_file)

  # Verify: .code.rds written under R_user_dir
  cache <- arl:::ModuleCache$new()
  paths <- cache$get_paths(module_file)
  expect_true(dir.exists(paths$cache_dir))

  cache_files <- list.files(paths$cache_dir, pattern = "\\.rds$", full.names = FALSE)
  code_cache_exists <- any(grepl("\\.code\\.rds$", cache_files))

  expect_true(code_cache_exists, "expr cache (.code.rds) should be written")
})

test_that("code cache is safe with file changes", {
  thin()
  # The expr cache (compiled expressions) is the safe default.
  # It verifies that changes to module files are properly detected through cache invalidation.
  temp_dir <- withr::local_tempdir()

  # Create a simple file (not a module, to avoid import complexity)
  test_file <- file.path(temp_dir, "changing-file.arl")
  writeLines("(define test-value 42)", test_file)

  # Load
  engine1 <- Engine$new()
  engine1$eval_text(sprintf('(load "%s")', arl_path(test_file)))

  # Verify initial value
  expect_equal(engine1$eval_text("test-value"), 42)

  # Change the file
  writeLines("(define test-value 100)", test_file)

  # Reload in new engine (simulating fresh session)
  engine2 <- Engine$new()
  engine2$eval_text(sprintf('(load "%s")', arl_path(test_file)))

  # Verify the change is picked up (cache was invalidated by content hash)
  expect_equal(engine2$eval_text("test-value"), 100)
})

test_that("code cache reused across engine instances", {
  thin()
  temp_dir <- withr::local_tempdir()
  module_file <- file.path(temp_dir, "test-module.arl")
  writeLines(c(
    "(module test-module",
    "  (export x)",
    "  (define x 42))"
  ), module_file)

  # First engine creates the cache
  engine1 <- Engine$new()
  engine1$load_file_in_env(module_file)

  # Second engine should find and use the cache
  engine2 <- Engine$new()
  engine2$load_file_in_env(module_file)

  # Both should have access to the module's export
  arl_env2 <- arl:::Env$new(engine2$get_env())
  registry2 <- arl_env2$module_registry
  expect_true(registry2$exists("test-module"))
})

# --- library-tree redirect ---

test_that("get_paths() always uses R_user_dir for cache", {
  thin()
  cache <- arl:::ModuleCache$new()

  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module tmp-test (export x) (define x 1))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  paths <- cache$get_paths(tmp_file)
  expect_false(is.null(paths))

  # Cache dir should always be under R_user_dir
  user_cache <- tools::R_user_dir("arl", "cache")
  expect_true(startsWith(normalizePath(paths$cache_dir, mustWork = FALSE, winslash = "/"),
                         normalizePath(user_cache, mustWork = FALSE, winslash = "/")),
              info = "cache_dir should be under R_user_dir")
  expect_true(grepl("/modules/", paths$cache_dir),
              info = "cache_dir should contain /modules/ subdirectory")
})

# ============================================================================
# Macro phase guard tests
# ============================================================================

test_that("macro transformer errors when called at runtime (phase guard)", {
  thin()
  eng <- make_engine()
  # Define a macro via eval_text

  eng$eval_text("(defmacro test-phase-guard (x) x)")

  # Get the macro function directly from the macro registry
  eng_env <- eng$get_env()
  macro_reg <- get(".__macros", envir = eng_env, inherits = TRUE)
  macro_fn <- get("test-phase-guard", envir = macro_reg, inherits = FALSE)

  # Calling it directly (without .arl_phase = "expand") should error

  expect_error(
    macro_fn(quote(42)),
    "called as a function at runtime"
  )

  # Calling it with .arl_phase = "expand" should work (as macroexpand does)
  result <- do.call(macro_fn, c(list(quote(42)), list(.arl_phase = "expand")))
  expect_equal(result, 42)
})

test_that("macro phase guard fires when macro is called as regular function", {
  thin()
  # Simulate what happens when compiled code calls a macro at runtime:
  # the macro_fn receives evaluated arguments (not syntax) and .arl_phase
  # defaults to "eval", triggering the guard.
  eng <- make_engine()

  eng$eval_text("(defmacro phase-guard-test (x) x)")

  # Retrieve the macro and call it as a regular R function (simulating
  # runtime dispatch through the env chain)
  macro_fn <- eng$eval_text("phase-guard-test")
  expect_error(
    macro_fn(42),
    "called as a function at runtime"
  )
})

# ============================================================================
# Ambient macro hash tests
# ============================================================================

test_that("compute_ambient_macro_hash returns consistent hash for same env", {
  thin()
  eng <- make_engine()
  ctx <- engine_field(eng, "compiled_runtime")$context
  module_parent <- ctx$prelude_env
  registry <- ctx$env$module_registry

  hash1 <- arl:::compute_ambient_macro_hash(module_parent, registry)
  hash2 <- arl:::compute_ambient_macro_hash(module_parent, registry)

  expect_equal(hash1, hash2)
  expect_true(nchar(hash1) == 32)  # MD5 length
})

test_that("compute_ambient_macro_hash differs with/without prelude macros", {
  thin()
  # Engine with prelude (has macros like cond, when, etc.)
  eng_prelude <- make_engine()
  ctx_prelude <- engine_field(eng_prelude, "compiled_runtime")$context
  hash_prelude <- arl:::compute_ambient_macro_hash(
    ctx_prelude$prelude_env, ctx_prelude$env$module_registry
  )

  # Engine without prelude (no macros in parent chain)
  eng_bare <- make_engine(load_prelude = FALSE)
  ctx_bare <- engine_field(eng_bare, "compiled_runtime")$context
  parent_bare <- ctx_bare$builtins_env
  hash_bare <- arl:::compute_ambient_macro_hash(
    parent_bare, ctx_bare$env$module_registry
  )

  expect_false(identical(hash_prelude, hash_bare),
               info = "prelude and bare engines should have different ambient macro hashes")
})

test_that("load_code() rejects cache with mismatched ambient_macro_hash", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)
  on.exit(unlink(paths$cache_dir, recursive = TRUE), add = TRUE)

  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file,
                   paths$file_hash, compiler_flags = .test_compiler_flags,
                   ambient_macro_hash = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")

  # Same hash — should succeed
  result_same <- cache$load_code(paths$code_cache, tmp_file,
                                 file_hash = paths$file_hash,
                                 compiler_flags = .test_compiler_flags,
                                 ambient_macro_hash = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
  expect_false(is.null(result_same))

  # Different hash — should reject
  result_diff <- cache$load_code(paths$code_cache, tmp_file,
                                 file_hash = paths$file_hash,
                                 compiler_flags = .test_compiler_flags,
                                 ambient_macro_hash = "bbbbbbbbbbbbbbbbbbbbbbbbbbbbbbbb")
  expect_null(result_diff)
})

test_that("load_code() rejects cache with NULL ambient_macro_hash (pre-upgrade)", {
  thin()
  cache <- arl:::ModuleCache$new()
  tmp_file <- tempfile(fileext = ".arl")
  writeLines("(module test (export foo))", tmp_file)
  on.exit(unlink(tmp_file), add = TRUE)

  compiled_body <- list(quote(foo <- 42))
  paths <- cache$get_paths(tmp_file)
  on.exit(unlink(paths$cache_dir, recursive = TRUE), add = TRUE)

  # Write cache with ambient_macro_hash
  cache$write_code("test", compiled_body, c("foo"), FALSE, FALSE, tmp_file,
                   paths$file_hash, compiler_flags = .test_compiler_flags,
                   ambient_macro_hash = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")

  # Strip ambient_macro_hash to simulate pre-upgrade cache
  cache_data <- readRDS(paths$code_cache)
  cache_data$ambient_macro_hash <- NULL
  saveRDS(cache_data, paths$code_cache)

  result <- cache$load_code(paths$code_cache, tmp_file,
                            file_hash = paths$file_hash,
                            compiler_flags = .test_compiler_flags,
                            ambient_macro_hash = "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa")
  expect_null(result)
})

Try the arl package in your browser

Any scripts or data that you put into this service are public.

arl documentation built on March 19, 2026, 5:09 p.m.