test-import-selective.R
In arl: Embedded Lisp Dialect

# Tests for selective imports with :refer, :as, :rename modifiers

# Helper: create a temp module file with known exports
make_temp_module <- function(name = "testmod", exports = c("square", "cube", "helper-val"),
                             body = NULL) {
  tmp_dir <- tempfile()
  dir.create(tmp_dir, recursive = TRUE)
  if (is.null(body)) {
    body <- c(
      sprintf("(module %s", name),
      sprintf("  (export %s)", paste(exports, collapse = " ")),
      "  (define square (lambda (x) (* x x)))",
      "  (define cube (lambda (x) (* x x x)))",
      "  (define helper-val 99))"
    )
  }
  module_file <- file.path(tmp_dir, paste0(name, ".arl"))
  writeLines(body, module_file)
  list(dir = tmp_dir, file = module_file, name = name)
}

# --- No modifiers (regression) ---

thin <- make_cran_thinner()

test_that("import with no modifiers imports all exports", {
  thin()
  m <- make_temp_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 testmod :refer :all)")
  expect_equal(engine$eval_text("(square 5)"), 25L)
  expect_equal(engine$eval_text("(cube 3)"), 27L)
  expect_equal(engine$eval_text("helper-val"), 99L)
})

# --- :refer ---

test_that("import :refer imports only specified symbols", {
  thin()
  m <- make_temp_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 testmod :refer (square))")
  expect_equal(engine$eval_text("(square 5)"), 25L)
  expect_error(engine$eval_text("(cube 3)"), "not found|could not find|object .* not found")
  expect_error(engine$eval_text("helper-val"), "not found|could not find|object .* not found")
})

test_that("import :refer errors on names not in module exports", {
  thin()
  m <- make_temp_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)

  expect_error(
    engine$eval_text("(import testmod :refer (nonexistent))"),
    "does not export 'nonexistent'"
  )
})

test_that("import :refer :all imports all exports", {
  thin()
  m <- make_temp_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 testmod :refer :all)")
  expect_equal(engine$eval_text("(square 5)"), 25L)
  expect_equal(engine$eval_text("(cube 3)"), 27L)
  expect_equal(engine$eval_text("helper-val"), 99L)
})

# --- :as ---

test_that("import :as aliases the module binding", {
  thin()
  m <- make_temp_module(exports = c("square", "cube"))
  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 testmod :as m)")
  # Qualified access works via alias
  expect_equal(engine$eval_text("(m/square 5)"), 25L)
  expect_equal(engine$eval_text("(m/cube 3)"), 27L)
  # Unqualified names not imported (no :refer)
  expect_error(engine$eval_text("(square 5)"), "not found|could not find|object .* not found")
})

test_that("import :as with :refer combines correctly", {
  thin()
  m <- make_temp_module(exports = c("square", "cube"))
  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 testmod :as m :refer (square))")
  expect_equal(engine$eval_text("(square 5)"), 25L)
  expect_equal(engine$eval_text("(m/cube 3)"), 27L)
  expect_error(engine$eval_text("(cube 3)"), "not found|could not find|object .* not found")
})

# --- :rename ---

test_that("import :rename renames specified symbols", {
  thin()
  m <- make_temp_module(exports = c("square", "cube"))
  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 testmod :rename ((square sq)))")
  expect_equal(engine$eval_text("(sq 5)"), 25L)
  expect_equal(engine$eval_text("(cube 3)"), 27L)
  expect_error(engine$eval_text("(square 5)"), "not found|could not find|object .* not found")
})

test_that("import :rename errors on names not in module exports", {
  thin()
  m <- make_temp_module(exports = c("square", "cube"))
  on.exit(unlink(m$dir, recursive = TRUE), add = TRUE)

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

  expect_error(
    engine$eval_text("(import testmod :rename ((nonexistent foo)))"),
    "does not export 'nonexistent'"
  )
})

# --- Composition ---

test_that("import :refer + :rename composes correctly", {
  thin()
  m <- make_temp_module(exports = c("square", "cube"))
  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 testmod :refer (square cube) :rename ((square sq)))")
  expect_equal(engine$eval_text("(sq 5)"), 25L)
  expect_equal(engine$eval_text("(cube 3)"), 27L)
  expect_error(engine$eval_text("(square 5)"), "not found|could not find|object .* not found")
})

# --- Macros ---

test_that("import :refer works with macros", {
  thin()
  m <- make_temp_module(name = "macmod", exports = c("my-when", "my-unless"), body = c(
    "(module macmod",
    "  (export my-when my-unless)",
    "  (defmacro my-when (test . body) `(if ,test (begin ,@body) #nil))",
    "  (defmacro my-unless (test . body) `(if ,test #nil (begin ,@body))))"
  ))
  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 macmod :refer (my-when))")
  expect_equal(engine$eval_text("(my-when #t 42)"), 42L)
  # my-unless was not referred — not visible as a macro
  expect_error(engine$eval_text("(my-unless #f 42)"), "not found|could not find")
})

test_that("import :refer works with macros", {
  thin()
  m <- make_temp_module(name = "macmod2", exports = c("mw"), body = c(
    "(module macmod2",
    "  (export mw)",
    "  (defmacro mw (test . body) `(if ,test (begin ,@body) #nil)))"
  ))
  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 macmod2 :refer (mw))")
  expect_equal(engine$eval_text("(mw #t 42)"), 42L)
})

test_that("import :rename works with macros", {
  thin()
  m <- make_temp_module(name = "macmod3", exports = c("mw3"), body = c(
    "(module macmod3",
    "  (export mw3)",
    "  (defmacro mw3 (test . body) `(if ,test (begin ,@body) #nil)))"
  ))
  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 macmod3 :rename ((mw3 my-when3)))")
  expect_equal(engine$eval_text("(my-when3 #t 42)"), 42L)
  # original name is not visible
  expect_error(engine$eval_text("(mw3 #t 42)"), "not found|could not find")
})

# --- Edge cases ---

test_that("import with empty :refer imports nothing unqualified", {
  thin()
  m <- make_temp_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 testmod :refer ())")
  expect_error(engine$eval_text("(square 5)"), "not found|could not find|object .* not found")
  expect_error(engine$eval_text("(cube 3)"), "not found|could not find|object .* not found")
  # But qualified access should work
  expect_equal(engine$eval_text("(testmod/square 5)"), 25L)
})

test_that("import with path string supports modifiers", {
  thin()
  m <- make_temp_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(sprintf('(import "%s" :refer (square))', arl_path(m$file)))
  expect_equal(engine$eval_text("(square 5)"), 25L)
  expect_error(engine$eval_text("(cube 3)"), "not found|could not find|object .* not found")
})

test_that("proxy-based imports are accessible via scoping but not in ls(env)", {
  thin()
  m <- make_temp_module(exports = c("square", "cube"))
  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 testmod :refer (square))")
  env <- engine$get_env()
  # Proxy-based imports live in parent chain, not in the env itself
  # (but the module binding "testmod" IS in env)
  expect_false("square" %in% ls(env, all.names = FALSE))
  # But they're accessible via get with inherits
  expect_equal(get("square", envir = env)(5L), 25L)
})

test_that("reference semantics: module bindings are locked", {
  thin()
  m <- make_temp_module(exports = c("square", "cube"))
  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 testmod :refer (square))")

  # Get the module env
  arl_env <- arl:::Env$new(engine$get_env())
  registry <- arl_env$module_registry
  entry <- registry$get("testmod")
  module_env <- entry$env

  # Module bindings should be locked
  expect_true(bindingIsLocked("square", module_env))
})

# --- Compile-time errors ---

test_that("import with unknown modifier errors", {
  thin()
  engine <- make_engine()
  expect_error(
    engine$eval_text("(import testmod :foobar (x))"),
    "unknown modifier"
  )
})

test_that("import :as rejects non-symbol alias", {
  thin()
  engine <- make_engine()
  # a/b is parsed as (module-ref a b), not a symbol
  expect_error(
    engine$eval_text("(import testmod :as a/b)"),
    ":as requires a symbol"
  )
})

# ============================================================================
# Qualified access via / syntax and module-ref
# ============================================================================

test_that("parser: math/inc produces (module-ref math inc)", {
  thin()
  engine <- make_engine()
  result <- engine$read("math/inc")
  expr <- result[[1]]
  expect_true(is.call(expr))
  expect_equal(as.character(expr[[1]]), "module-ref")
  expect_equal(as.character(expr[[2]]), "math")
  expect_equal(as.character(expr[[3]]), "inc")
})

test_that("parser: a/b/c produces nested module-ref", {
  thin()
  engine <- make_engine()
  result <- engine$read("a/b/c")
  expr <- result[[1]]
  # (module-ref (module-ref a b) c)
  expect_true(is.call(expr))
  expect_equal(as.character(expr[[1]]), "module-ref")
  expect_equal(as.character(expr[[3]]), "c")
  inner <- expr[[2]]
  expect_true(is.call(inner))
  expect_equal(as.character(inner[[1]]), "module-ref")
  expect_equal(as.character(inner[[2]]), "a")
  expect_equal(as.character(inner[[3]]), "b")
})

test_that("parser: bare / stays as division symbol", {
  thin()
  engine <- make_engine()
  result <- engine$read("(/ 10 2)")
  expr <- result[[1]]
  expect_true(is.call(expr))
  expect_equal(as.character(expr[[1]]), "/")
})

test_that("parser: round-trip math/inc -> write -> math/inc", {
  thin()
  engine <- make_engine()
  result <- engine$read("math/inc")
  written <- engine$write(result[[1]])
  expect_equal(written, "math/inc")
})

test_that("parser: round-trip a/b/c -> write -> a/b/c", {
  thin()
  engine <- make_engine()
  result <- engine$read("a/b/c")
  written <- engine$write(result[[1]])
  expect_equal(written, "a/b/c")
})

test_that("parser: R infix operators %/% are not split", {
  thin()
  engine <- make_engine()
  result <- engine$read("(%/% 10 3)")
  expr <- result[[1]]
  expect_true(is.call(expr))
  expect_equal(as.character(expr[[1]]), "%/%")
})

test_that("qualified access: import :refer then mod/sym resolves", {
  thin()
  engine <- make_engine()
  engine$eval_text("(import math :refer (inc))")
  result <- engine$eval_text("math/inc")
  expect_true(is.function(result))
})

test_that("qualified access: import :as then alias/sym resolves", {
  thin()
  engine <- make_engine()
  engine$eval_text("(import math :as m)")
  result <- engine$eval_text("m/inc")
  expect_true(is.function(result))
})

test_that("bare / is still division", {
  thin()
  engine <- make_engine()
  result <- engine$eval_text("(/ 10 2)")
  expect_equal(result, 5)
})