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

# Remaining edge case tests for Arl standard library
# String edge cases moved to test-stdlib-strings.R
# Math boundary conditions moved to test-stdlib-math.R

engine <- make_engine()

# Helper to create test env with stdlib
setup_env <- function() {
  env <- new.env()
  toplevel_env(engine, env) # nolint: object_usage_linter.
  env
}

# ============================================================================
# Performance Tests (Large Lists)
# ============================================================================

thin <- make_cran_thinner()

test_that("stdlib handles large lists efficiently", {
  thin()
  env <- setup_env()

  # Large list (1000 elements)
  large_list <- as.list(1:1000)

  # map should handle large lists
  result <- get("map", envir = env)(function(x) x * 2, large_list)
  expect_equal(length(result), 1000)
  expect_equal(result[[1]], 2)
  expect_equal(result[[1000]], 2000)

  # filter should handle large lists
  result <- get("filter", envir = env)(function(x) x %% 2 == 0, large_list)
  expect_equal(length(result), 500)

  # reduce should handle large lists
  result <- get("reduce", envir = env)(`+`, large_list)
  expect_equal(result, sum(1:1000))

  # reverse should handle large lists
  result <- get("reverse", envir = env)(large_list)
  expect_equal(result[[1]], 1000)
  expect_equal(result[[1000]], 1)
})

# ============================================================================
# Mixed Type Tests
# ============================================================================

test_that("stdlib handles mixed types correctly", {
  thin()
  env <- setup_env()

  # List with mixed types
  mixed <- list(1, "two", 3.0, TRUE, NULL, list(5))

  # map should work with mixed types
  result <- get("map", envir = env)(function(x) is.null(x), mixed)
  expect_equal(result[[5]], TRUE)

  # filter should work with mixed types
  result <- get("filter", envir = env)(function(x) is.numeric(x), mixed)
  expect_equal(length(result), 2)  # 1 and 3.0

  # string-concat should convert all types
  result <- get("string-concat", envir = env)(1, "two", TRUE, NULL)
  expect_true(is.character(result))
})

# ============================================================================
# Coverage: Dict edge cases
# ============================================================================

test_that("dict-set with symbol key works", {
  thin()
  env <- setup_env()

  result <- engine$eval(
    engine$read("(dict-set (dict) 'sym-key \"val\")")[[1]], env = env)
  val <- engine$eval(engine$read("(dict-get result \"sym-key\")")[[1]],
    env = local({
      e <- new.env(parent = env)
      e$result <- result
      e
    }))
  expect_equal(val, "val")
})

test_that("dict-set errors on invalid key type", {
  thin()
  env <- setup_env()

  expect_error(
    engine$eval(engine$read("(dict-set (dict) 42 \"val\")")[[1]], env = env),
    "requires a string, symbol, or keyword key")
})

test_that("dict-set errors on non-dict", {
  thin()
  env <- setup_env()

  expect_error(
    engine$eval(engine$read("(dict-set 42 \"key\" \"val\")")[[1]], env = env),
    "requires a dict")
})

test_that("dict-keys on empty dict returns empty list", {
  thin()
  env <- setup_env()

  result <- engine$eval(engine$read("(dict-keys (dict))")[[1]], env = env)
  expect_equal(length(result), 0)
})

test_that("dict-remove removes last key leaving empty dict", {
  thin()
  env <- setup_env()

  result <- engine$eval(
    engine$read('(dict-remove (dict :a 1) "a")')[[1]], env = env)
  keys <- engine$eval(engine$read("(dict-keys d)")[[1]],
    env = local({
      e <- new.env(parent = env)
      e$d <- result
      e
    }))
  expect_equal(length(keys), 0)
})

test_that("dict-has? on non-dict returns #f", {
  thin()
  env <- setup_env()

  result <- engine$eval(
    engine$read('(dict-has? 42 "key")')[[1]], env = env)
  expect_false(result)
})

# ============================================================================
# Coverage: Set edge cases
# ============================================================================

test_that("set-add errors on non-set", {
  thin()
  env <- setup_env()

  expect_error(
    engine$eval(engine$read('(set-add 42 "x")')[[1]], env = env),
    "requires a set")
})

# ============================================================================
# Coverage: Display edge cases
# ============================================================================

test_that("format-value with empty list returns parens", {
  thin()
  env <- setup_env()

  result <- engine$eval(
    engine$read("(format-value (list))")[[1]], env = env)
  expect_equal(result, "()")
})

# ============================================================================
# Coverage: Equality edge cases
# ============================================================================

test_that("eq? errors as not implementable in R", {
  thin()
  env <- setup_env()

  expect_error(
    engine$eval(engine$read("(eq? 1 1)")[[1]], env = env),
    "cannot be properly implemented")
})

test_that("eqv? errors as not implementable in R", {
  thin()
  env <- setup_env()

  expect_error(
    engine$eval(engine$read("(eqv? 1 1)")[[1]], env = env),
    "cannot be properly implemented")
})

test_that("equal? list vs non-list returns #f", {
  thin()
  env <- setup_env()

  result <- engine$eval(
    engine$read("(equal? (list 1) 42)")[[1]], env = env)
  expect_false(result)
})

# ============================================================================
# Coverage: Types edge cases
# ============================================================================

test_that("empty? works on lists", {
  thin()
  env <- setup_env()

  expect_true(engine$eval(engine$read("(empty? (list))")[[1]], env = env))
  expect_false(engine$eval(engine$read("(empty? (list 1))")[[1]], env = env))
})

# ============================================================================
# Coverage: Dict non-dict fallbacks
# ============================================================================

test_that("dict-keys on non-dict returns empty list", {
  thin()
  env <- setup_env()

  result <- engine$eval(engine$read("(dict-keys 42)")[[1]], env = env)
  expect_equal(length(result), 0)
})

test_that("dict-values on non-dict returns empty list", {
  thin()
  env <- setup_env()

  result <- engine$eval(engine$read("(dict-values 42)")[[1]], env = env)
  expect_equal(length(result), 0)
})

# ============================================================================
# Coverage: Set non-set fallback
# ============================================================================

test_that("set-contains? on non-set returns #f", {
  thin()
  env <- setup_env()

  result <- engine$eval(engine$read('(set-contains? 42 "x")')[[1]], env = env)
  expect_false(result)
})

# ============================================================================
# Coverage: Equality type mismatch paths
# ============================================================================

test_that("equal? on environment vs non-environment returns #f", {
  thin()
  env <- setup_env()

  result <- engine$eval(
    engine$read("(equal? (r-call \"new.env\" (list)) 42)")[[1]], env = env)
  expect_false(result)
})

# ============================================================================
# Coverage: Math predicate non-matching types
# ============================================================================

test_that("integer? on non-numeric returns #f", {
  thin()
  env <- setup_env()

  expect_false(engine$eval(engine$read('(integer? "hi")')[[1]], env = env))
})

test_that("natural? on non-integer returns #f", {
  thin()
  env <- setup_env()

  expect_false(engine$eval(engine$read('(natural? "hi")')[[1]], env = env))
})

test_that("rational? on non-real returns #f", {
  thin()
  env <- setup_env()

  expect_false(engine$eval(engine$read('(rational? "hi")')[[1]], env = env))
})

test_that("max with arguments works", {
  thin()
  env <- setup_env()

  expect_equal(engine$eval(engine$read("(max 1 5 3)")[[1]], env = env), 5)
})

# ============================================================================
# Coverage: string->list on empty string, char-at negative index
# ============================================================================

test_that("string->list on empty string returns empty list", {
  thin()
  env <- setup_env()

  result <- engine$eval(
    engine$read('(string->list "")')[[1]], env = env)
  expect_equal(result, list())
})

test_that("char-at errors on negative index", {
  thin()
  env <- setup_env()

  expect_error(
    engine$eval(engine$read('(char-at "hello" -1)')[[1]], env = env),
    "out of bounds")
})

# ============================================================================
# Coverage: functional foldl/foldr with init value, repeatedly
# ============================================================================

test_that("foldl and foldr with init value from Arl", {
  thin()
  env <- new.env()
  toplevel_env(engine, env = env)
  import_stdlib_modules(engine, c("functional"), env = env)

  result <- engine$eval(
    engine$read("(foldl + (list 1 2 3) 10)")[[1]], env = env)
  expect_equal(result, 16)

  result <- engine$eval(
    engine$read("(foldr + (list 1 2 3) 10)")[[1]], env = env)
  expect_equal(result, 16)
})

test_that("repeatedly from Arl code (sequences version, n fn order)", {
  thin()
  env <- new.env()
  toplevel_env(engine, env = env)

  engine$eval(engine$read("(define counter 0)")[[1]], env = env)
  result <- engine$eval(
    engine$read("(repeatedly 3 (lambda () (set! counter (+ counter 1)) counter))")[[1]], env = env)
  expect_equal(result, list(1, 2, 3))
})

# ============================================================================
# Coverage: display/println
# ============================================================================

test_that("display outputs formatted value", {
  thin()
  env <- setup_env()

  # Make sure ARL_QUIET is not set
  old <- Sys.getenv("ARL_QUIET")
  Sys.unsetenv("ARL_QUIET")
  on.exit(if (nzchar(old)) Sys.setenv(ARL_QUIET = old) else Sys.unsetenv("ARL_QUIET"))

  output <- capture.output(
    engine$eval(engine$read("(display 42)")[[1]], env = env))
  expect_true(any(grepl("42", output)))
})

test_that("println outputs formatted value", {
  thin()
  env <- setup_env()

  old <- Sys.getenv("ARL_QUIET")
  Sys.unsetenv("ARL_QUIET")
  on.exit(if (nzchar(old)) Sys.setenv(ARL_QUIET = old) else Sys.unsetenv("ARL_QUIET"))

  output <- capture.output(
    engine$eval(engine$read("(println 42)")[[1]], env = env))
  expect_true(any(grepl("42", output)))
})