test-assignment-edge-cases.R
In arl: Embedded Lisp Dialect

# Tests for assignment edge cases: destructuring set!, locked bindings,
# and parity between fast path (__set_impl) and slow path (Env$assign_existing).
#
# These tests lock down behavior before deduplicating the assignment code paths.

# Helper: create a temp module with locked bindings for testing
make_locked_module <- function(name = "lockmod", exports = c("a", "b", "c")) {
  tmp_dir <- tempfile()
  dir.create(tmp_dir, recursive = TRUE)
  export_clause <- paste0("(export ", paste(exports, collapse = " "), ")")
  defines <- paste0("  (define ", exports, " ", seq_along(exports), ")")
  body <- c(
    sprintf("(module %s", name),
    paste0("  ", export_clause),
    defines,
    ")"
  )
  module_file <- file.path(tmp_dir, paste0(name, ".arl"))
  writeLines(body, module_file)
  list(dir = tmp_dir, file = module_file, name = name)
}


# --- Destructuring set! (no existing coverage) ---

thin <- make_cran_thinner()

test_that("basic destructuring set! assigns multiple variables", {
  thin()
  engine <- make_engine(load_prelude = FALSE)
  engine$eval_text("(define a 0)")
  engine$eval_text("(define b 0)")
  engine$eval_text("(set! (a b) (list 1 2))")
  expect_equal(engine$eval_text("a"), 1L)
  expect_equal(engine$eval_text("b"), 2L)
})

test_that("destructuring set! with rest pattern", {
  thin()
  engine <- make_engine(load_prelude = FALSE)
  engine$eval_text("(define a 0)")
  engine$eval_text("(define b 0)")
  engine$eval_text("(define rest '())")
  engine$eval_text("(set! (a b . rest) (list 1 2 3 4))")
  expect_equal(engine$eval_text("a"), 1L)
  expect_equal(engine$eval_text("b"), 2L)
  expect_equal(engine$eval_text("rest"), list(3L, 4L))
})

test_that("destructuring set! errors on undefined variable", {
  thin()
  engine <- make_engine(load_prelude = FALSE)
  engine$eval_text("(define a 0)")
  # 'nonexistent' is not defined, so set! should error
  expect_error(
    engine$eval_text("(set! (a nonexistent) (list 1 2))"),
    "not defined"
  )
})

test_that("destructuring set! on proxy-imported binding creates local shadow", {
  thin()
  m <- make_locked_module()
  on.exit(unlink(m$dir, recursive = TRUE), add = TRUE)

  engine <- make_engine()
  old_wd <- setwd(m$dir)
  on.exit(setwd(old_wd), add = TRUE)

  engine$eval_text("(import lockmod :refer :all)")
  expect_equal(engine$eval_text("a"), 1L)
  expect_equal(engine$eval_text("b"), 2L)

  # Destructuring set! should shadow locally, not mutate the module
  engine$eval_text("(define x 0)")
  engine$eval_text("(set! (x a) (list 99 100))")
  expect_equal(engine$eval_text("x"), 99L)
  expect_equal(engine$eval_text("a"), 100L)

  # Module's original binding should be untouched
  arl_env <- arl:::Env$new(engine$get_env())
  registry <- arl_env$module_registry
  entry <- registry$get("lockmod")
  expect_equal(get("a", envir = entry$env, inherits = FALSE), 1L)
})

test_that("destructuring set! on locked binding succeeds", {
  thin()
  # This exercises the bug #2 path: destructuring set! goes through
  # Env$assign_existing which does NOT handle locked bindings.
  # After the fix, this should pass.
  engine <- make_engine(load_prelude = FALSE)

  # Create a binding and lock it at the R level
  eng_env <- engine$get_env()
  assign("locked_a", 10L, envir = eng_env)
  assign("locked_b", 20L, envir = eng_env)
  lockBinding(as.symbol("locked_a"), eng_env)
  lockBinding(as.symbol("locked_b"), eng_env)

  # Destructuring set! should unlock, assign, and re-lock
  engine$eval_text("(set! (locked_a locked_b) (list 100 200))")
  expect_equal(engine$eval_text("locked_a"), 100L)
  expect_equal(engine$eval_text("locked_b"), 200L)
})


# --- Locked binding interactions (no existing coverage) ---

test_that("simple set! on a locked binding succeeds", {
  thin()
  engine <- make_engine(load_prelude = FALSE)

  eng_env <- engine$get_env()
  assign("locked_var", 42L, envir = eng_env)
  lockBinding(as.symbol("locked_var"), eng_env)

  # The fast path (__set_impl) handles locked bindings correctly
  engine$eval_text("(set! locked_var 999)")
  expect_equal(engine$eval_text("locked_var"), 999L)

  # Binding should still be locked after mutation
  expect_true(bindingIsLocked("locked_var", eng_env))
})

test_that("define over a locked binding replaces it", {
  thin()
  engine <- make_engine(load_prelude = FALSE)

  eng_env <- engine$get_env()
  assign("locked_def", 42L, envir = eng_env)
  lockBinding(as.symbol("locked_def"), eng_env)

  # define creates a new binding in the current env; since the binding
  # is locked but not an active binding, define should still work
  # (define goes through __assign_pattern → direct assign in env)
  engine$eval_text("(define locked_def 999)")
  expect_equal(engine$eval_text("locked_def"), 999L)
})


# --- Parity tests: fast path vs slow path ---

test_that("simple set! and destructuring set! produce identical results on regular bindings", {
  thin()
  # Fast path: simple set!
  eng1 <- make_engine(load_prelude = FALSE)
  eng1$eval_text("(define x 0)")
  eng1$eval_text("(set! x 42)")

  # Slow path: destructuring set! with single element
  eng2 <- make_engine(load_prelude = FALSE)
  eng2$eval_text("(define x 0)")
  eng2$eval_text("(set! (x) (list 42))")

  expect_equal(eng1$eval_text("x"), eng2$eval_text("x"))
})

test_that("simple set! and destructuring set! produce identical results on proxy bindings", {
  thin()
  m <- make_locked_module()
  on.exit(unlink(m$dir, recursive = TRUE), add = TRUE)

  # Fast path
  eng1 <- make_engine()
  old_wd1 <- setwd(m$dir)
  on.exit(setwd(old_wd1), add = TRUE)
  eng1$eval_text("(import lockmod :refer :all)")
  eng1$eval_text("(set! a 99)")

  # Slow path (destructuring)
  eng2 <- make_engine()
  eng2$eval_text("(import lockmod :refer :all)")
  eng2$eval_text("(set! (a) (list 99))")

  expect_equal(eng1$eval_text("a"), eng2$eval_text("a"))

  # Both should have left the module untouched
  for (eng in list(eng1, eng2)) {
    arl_env <- arl:::Env$new(eng$get_env())
    registry <- arl_env$module_registry
    entry <- registry$get("lockmod")
    expect_equal(get("a", envir = entry$env, inherits = FALSE), 1L)
  }
})

test_that("simple set! and destructuring set! produce identical results on locked bindings", {
  thin()
  # Fast path
  eng1 <- make_engine(load_prelude = FALSE)
  env1 <- eng1$get_env()
  assign("lk", 10L, envir = env1)
  lockBinding(as.symbol("lk"), env1)
  eng1$eval_text("(set! lk 99)")

  # Slow path (destructuring)
  eng2 <- make_engine(load_prelude = FALSE)
  env2 <- eng2$get_env()
  assign("lk", 10L, envir = env2)
  lockBinding(as.symbol("lk"), env2)
  eng2$eval_text("(set! (lk) (list 99))")

  expect_equal(eng1$eval_text("lk"), eng2$eval_text("lk"))
})

test_that("simple set! and destructuring set! produce identical results on squash bindings", {
  thin()
  # Fast path: set! on a prelude squash binding
  eng1 <- make_engine()
  eng1$eval_text("(set! map 123)")

  # Slow path: destructuring set! on a prelude squash binding
  eng2 <- make_engine()
  eng2$eval_text("(set! (map) (list 123))")

  expect_equal(eng1$eval_text("map"), eng2$eval_text("map"))
})