# Unit tests for internal helper utilities

skip_on_cran()

test_that("zzz .onLoad can be invoked", {
  expect_error(quickr:::.onLoad(), NA)
})

test_that("nil-coalescing %||% returns first non-NULL", {
  expect_identical(quickr:::`%||%`(NULL, 1), 1)
  expect_identical(quickr:::`%||%`(0, 1), 0)
})

test_that("S7-style := assigns and preserves name", {
  local({
    quickr:::`:=`(f, function() 1L)
    expect_true(is.function(f))
    expect_identical(attr(f, "name"), "f")

    quickr:::`:=`(e, new.env())
    expect_true(is.environment(e))
    expect_identical(attr(e, "name"), "e")

    new_obj <- function(name) name
    quickr:::`:=`(x, new_obj())
    expect_identical(x, "x")

    expect_error(quickr:::`:=`(1, function() 1L), "left hand side")
    expect_error(quickr:::`:=`(bad, 1), "right hand side")
    expect_error(quickr:::`:=`(dup, new_obj(name = "x")), "matched by multiple")
  })
})

test_that("append helpers work for common cases", {
  expect_identical(quickr:::`append<-`(1:2, value = 3L), c(1L, 2L, 3L))
  expect_identical(
    quickr:::`append<-`(1:2, after = 1L, value = 3L),
    c(1L, 3L, 2L)
  )

  expect_identical(quickr:::`append1<-`(1:2, 3L), c(1L, 2L, 3L))
  expect_error(quickr:::`append1<-`(1:2, "x"))

  expect_identical(quickr:::`prepend<-`(1:2, 0L), c(0L, 1L, 2L))
})

test_that("map2 validates lengths and preserves names", {
  expect_error(
    quickr:::map2(1:2, 1:3, `+`),
    ".x and .y must have the same length"
  )

  x <- setNames(1:2, c("a", "b"))
  out <- quickr:::map2(x, 1L, `+`)
  expect_identical(names(out), c("a", "b"))
  expect_identical(out, list(a = 2L, b = 3L))
})

test_that("discard and drop_nulls behave as expected", {
  expect_identical(quickr:::discard(1:5, \(x) x %% 2L == 0L), c(1L, 3L, 5L))

  x <- list(a = 1, b = NULL, c = 3)
  expect_identical(names(quickr:::drop_nulls(x)), c("a", "c"))

  x <- list(a = NULL, b = NULL, c = 3)
  expect_identical(names(quickr:::drop_nulls(x, c("a", "c"))), c("b", "c"))
})

test_that("new_function and str_flatten_args are usable", {
  f <- quickr:::new_function(args = alist(x = ), body = quote(x + 1L))
  expect_identical(f(1L), 2L)

  expect_identical(
    quickr:::str_flatten_args("a", "b", multiline = FALSE),
    "a,b"
  )
  expect_true(
    grepl("\n", quickr:::str_flatten_args("a", "b", "c", multiline = TRUE))
  )
})

test_that("parent.pkg detects namespaces and set_names mutates names", {
  expect_identical(quickr:::parent.pkg(environment(quickr::quick)), "quickr")
  expect_null(quickr:::parent.pkg(new.env(parent = emptyenv())))

  x <- setNames(1:2, c("a", "b"))
  expect_identical(names(quickr:::set_names(x, toupper)), c("A", "B"))
})

test_that("zip_lists zips named lists and errors on mismatches", {
  a <- list(x = 1, y = 2)
  b <- list(x = 3, y = 4)
  expect_identical(
    quickr:::zip_lists(a, b),
    list(x = list(1, 3), y = list(2, 4))
  )

  bad_names <- structure(list(1, 2), names = c("x", "x"))
  expect_error(quickr:::zip_lists(list(bad_names)), "All names must be unique")

  expect_error(
    quickr:::zip_lists(list(x = 1, y = 2), list(x = 1, y = 2, z = 3)),
    "all elements must have the same length"
  )

  expect_error(
    quickr:::zip_lists(list(x = 1, y = 2), list(x = 1, z = 2)),
    "must match"
  )
})

test_that("defer schedules cleanup code on exit", {
  e <- new.env(parent = emptyenv())

  f <- function() {
    quickr:::defer(assign("done", TRUE, envir = e))
    invisible()
  }
  f()
  expect_true(isTRUE(e$done))
})

test_that("iterable helpers cover edge cases", {
  expect_null(quickr:::r2f_iterable_context(NULL))
  expect_null(quickr:::r2f_iterable_context(character()))
  expect_null(quickr:::r2f_iterable_context("seq"))
  expect_null(quickr:::r2f_iterable_context(c("foo", "seq")))
  expect_identical(quickr:::r2f_iterable_context(c("[", "seq")), "[")
  expect_identical(quickr:::r2f_iterable_context(c("for", "seq")), "for")

  var_na <- quickr:::Variable("double", list(NA_integer_))
  expect_identical(quickr:::value_length_expr(var_na), NA_integer_)

  expect_identical(quickr:::seq_like_length_expr(NULL, 1L), NA_integer_)
  expect_identical(quickr:::seq_like_length_expr(1L, 1), 1L)
  expect_error(
    quickr:::seq_like_length_expr(1L, 2L, 0L),
    "invalid '\\(to - from\\)/by'"
  )

  scope <- new.env(parent = emptyenv())
  expect_error(
    quickr:::seq_like_parse(
      "seq",
      list(from = quote(expr = ), to = 5L),
      scope
    ),
    "seq\\(\\) requires both `from` and `to`"
  )
  expect_error(
    quickr:::seq_like_parse(
      "seq",
      list(from = 5L, to = quote(expr = )),
      scope
    ),
    "seq\\(\\) requires both `from` and `to`"
  )
  out <- quickr:::seq_like_parse(
    "seq",
    list(from = 1L, to = 3L, by = quote(expr = )),
    scope
  )
  expect_null(out$by)
  expect_error(
    quickr:::seq_like_parse("banana", list(), scope),
    "unsupported iterable"
  )

  expect_false(quickr:::iterable_is_singleton_one(1L, scope))
  expect_false(quickr:::iterable_is_singleton_one(quote(foo(1L)), scope))
  expect_false(quickr:::iterable_is_singleton_one(quote(seq(1L)), scope))
  expect_false(
    quickr:::iterable_is_singleton_one(quote(seq_along(x)), scope)
  )

  scope2 <- quickr:::new_scope(function() NULL)
  expect_error(
    quickr:::r2f_for_iterable(quote(x), scope2),
    "unsupported iterable in for\\(\\)"
  )
})

test_that("iterable_is_singleton_one handles unknown iterable kinds", {
  scope <- new.env(parent = emptyenv())
  local_mocked_bindings(
    seq_like_parse = function(...) list(kind = "bogus"),
    .package = "quickr"
  )

  expect_false(quickr:::iterable_is_singleton_one(quote(seq_len(1L)), scope))
})

test_that("quickr_r_cmd adds .exe extension on Windows when needed", {
  result <- quickr:::quickr_r_cmd(
    os_type = "windows",
    r_home = function(sub) "/path/to/R",
    file_exists = function(x) FALSE
  )
  expect_equal(result, "/path/to/R.exe")
})

test_that("set_names handles list argument", {
  x <- 1:2
  names(x) <- c("a", "b")
  result <- quickr:::set_names(x, "c", "d")
  expect_equal(names(result), c("c", "d"))
})

test_that("zip_lists reorders elements when names match but different order", {
  a <- list(x = 1, y = 2)
  b <- list(y = 4, x = 3)
  result <- quickr:::zip_lists(a, b)
  expect_equal(result$x, list(1, 3))
  expect_equal(result$y, list(2, 4))
})

test_that("is_scalar returns correct values", {
  expect_true(quickr:::is_scalar(1))
  expect_true(quickr:::is_scalar("a"))
  expect_false(quickr:::is_scalar(1:2))
  expect_false(quickr:::is_scalar(character()))
})

test_that("quickr_ordered_env detects untracked names", {
  env <- quickr:::new_ordered_env()
  # Directly assign without going through [[<-
  base::assign("sneaky", 1, envir = env)
  expect_error(
    suppressWarnings(names(env)),
    "untracked name"
  )
})

test_that("print.quickr_ordered_env outputs bindings", {
  env <- quickr:::new_ordered_env()
  env[["x"]] <- 1
  env[["y"]] <- 2
  out <- capture.output(print(env))
  expect_true(any(grepl("x", out)))
  expect_true(any(grepl("with bindings", out)))
})

test_that("check_assignment_compatible handles NULL value", {
  target <- quickr:::Variable("double", list(1L))
  expect_silent(quickr:::check_assignment_compatible(target, NULL))
})
