tests/testthat/test-interval-index.R

In Immutables: Fast and Functional Data Structures

testthat::test_that("interval_index constructor sorts by start and preserves stable duplicate order", {
  ix <- as_interval_index(
    list("c", "a", "b", "d"),
    start = c(2, 1, 2, 2),
    end = c(5, 3, 4, 6)
  )

  testthat::expect_s3_class(ix, "interval_index")
  testthat::expect_equal(as.list(ix), list("a", "c", "b", "d"))
  testthat::expect_identical(length(ix), 4L)

  entries <- .ivx_entries(ix)
  starts <- lapply(entries, function(e) e$start)
  ends <- lapply(entries, function(e) e$end)
  testthat::expect_equal(starts, as.list(c(1, 2, 2, 2)))
  testthat::expect_equal(ends, as.list(c(3, 5, 4, 6)))
})

testthat::test_that("interval_index validates endpoints and bounds", {
  ok <- as_interval_index("p", start = 2, end = 2)
  testthat::expect_s3_class(ok, "interval_index")

  testthat::expect_error(as_interval_index("x", start = 3, end = 2), "start")
  testthat::expect_error(as_interval_index("x", start = 1, end = 2, default_query_bounds = "bad"), "bounds")
})

testthat::test_that("min_endpoint/max_endpoint expose endpoint extrema", {
  ix <- as_interval_index(list("c", "a", "b"), start = c(2, 1, 2), end = c(5, 3, 4))
  testthat::expect_identical(min_endpoint(ix), 1)
  testthat::expect_identical(max_endpoint(ix), 5)

  empty <- interval_index()
  testthat::expect_null(min_endpoint(empty))
  testthat::expect_null(max_endpoint(empty))
})

testthat::test_that("insert is persistent and appends at right edge of equal-start block", {
  ix <- as_interval_index(list("a", "b", "c"), start = c(1, 2, 2), end = c(2, 3, 4))
  ix2 <- insert(ix, "d", start = 2, end = 5)

  testthat::expect_equal(as.list(ix), list("a", "b", "c"))
  testthat::expect_equal(as.list(ix2), list("a", "b", "c", "d"))

  entries <- .ivx_entries(ix2)
  starts <- lapply(entries, function(e) e$start)
  ends <- lapply(entries, function(e) e$end)
  testthat::expect_equal(starts, as.list(c(1, 2, 2, 2)))
  testthat::expect_equal(ends, as.list(c(2, 3, 4, 5)))
})

testthat::test_that("peek_point honors boundary modes", {
  ix <- as_interval_index(
    list("A", "B", "C", "D"),
    start = c(1, 2, 3, 2),
    end = c(2, 3, 4, 2),
    default_query_bounds = "[)"
  )

  testthat::expect_equal(peek_point(ix, 2, bounds = "[)"), "B")
  testthat::expect_equal(as.list(peek_all_point(ix, 2, bounds = "[]")), list("A", "B", "D"))
  testthat::expect_null(peek_point(ix, 2, bounds = "()"))
  testthat::expect_identical(length(peek_all_point(ix, 2, bounds = "()")), 0L)
  testthat::expect_equal(as.list(peek_all_point(ix, 2, bounds = "(]")), list("A"))
})

testthat::test_that("peek overlap/contain/within queries are deterministic", {
  ix <- as_interval_index(
    list("A", "B", "C", "D"),
    start = c(1, 2, 3, 2),
    end = c(2, 3, 4, 2),
    default_query_bounds = "[)"
  )

  testthat::expect_equal(peek_overlaps(ix, 2, 3, bounds = "[)"), "B")
  testthat::expect_equal(as.list(peek_all_overlaps(ix, 2, 3, bounds = "[]")), list("A", "B", "D", "C"))

  jy <- as_interval_index(
    list("outer", "inner", "tail", "point"),
    start = c(1, 2, 2, 3),
    end = c(5, 3, 5, 3),
    default_query_bounds = "[]"
  )

  testthat::expect_equal(peek_containing(jy, 2, 3), "outer")
  testthat::expect_equal(as.list(peek_all_containing(jy, 2, 3)), list("outer", "inner", "tail"))
  testthat::expect_equal(peek_within(jy, 2, 3), "inner")
  testthat::expect_equal(as.list(peek_all_within(jy, 2, 3)), list("inner", "point"))

  testthat::expect_null(peek_overlaps(ix, 9, 10))
  miss <- peek_all_overlaps(ix, 9, 10)
  testthat::expect_s3_class(miss, "interval_index")
  testthat::expect_identical(length(miss), 0L)
})

testthat::test_that("relation query/pop contracts hold across all bounds tokens", {
  ix <- as_interval_index(
    list("A", "B", "C", "D"),
    start = c(1, 2, 3, 2),
    end = c(2, 3, 4, 2),
    default_query_bounds = "[)"
  )
  vals <- as.list(ix)
  entries <- .ivx_entries(ix)
  starts <- as.numeric(unlist(lapply(entries, function(e) e$start), use.names = FALSE))
  ends <- as.numeric(unlist(lapply(entries, function(e) e$end), use.names = FALSE))

  contains_point <- function(start, end, point, bounds) {
    include_start <- substr(bounds, 1L, 1L) == "["
    include_end <- substr(bounds, 2L, 2L) == "]"
    left_ok <- if(include_start) point >= start else point > start
    right_ok <- if(include_end) point <= end else point < end
    isTRUE(left_ok && right_ok)
  }
  overlaps <- function(a_start, a_end, b_start, b_end, bounds) {
    touching_is_overlap <- identical(bounds, "[]")
    a_before_b <- if(touching_is_overlap) a_end < b_start else a_end <= b_start
    b_before_a <- if(touching_is_overlap) b_end < a_start else b_end <= a_start
    !isTRUE(a_before_b || b_before_a)
  }
  containing <- function(start, end, q_start, q_end, bounds) {
    overlaps(start, end, q_start, q_end, bounds) && start <= q_start && end >= q_end
  }
  within <- function(start, end, q_start, q_end, bounds) {
    overlaps(start, end, q_start, q_end, bounds) && q_start <= start && q_end >= end
  }

  bounds_tokens <- c("[)", "[]", "()", "(]")
  for(bt in bounds_tokens) {
    idx_point <- which(vapply(seq_along(vals), function(i) contains_point(starts[[i]], ends[[i]], 2, bt), logical(1)))
    idx_over <- which(vapply(seq_along(vals), function(i) overlaps(starts[[i]], ends[[i]], 2, 3, bt), logical(1)))
    idx_cont <- which(vapply(seq_along(vals), function(i) containing(starts[[i]], ends[[i]], 2, 3, bt), logical(1)))
    idx_with <- which(vapply(seq_along(vals), function(i) within(starts[[i]], ends[[i]], 2, 3, bt), logical(1)))

    expect_relation <- function(peek_first, peek_all, pop_first, pop_all, idx) {
      expect_all <- vals[idx]
      expect_rest <- vals[setdiff(seq_along(vals), idx)]

      testthat::expect_equal(as.list(peek_all), expect_all)
      if(length(expect_all) == 0L) {
        testthat::expect_null(peek_first)
      } else {
        testthat::expect_equal(peek_first, expect_all[[1L]])
      }

      if(length(expect_all) == 0L) {
        testthat::expect_null(pop_first$value)
        testthat::expect_null(pop_first$start)
        testthat::expect_null(pop_first$end)
        testthat::expect_equal(as.list(pop_first$remaining), vals)
      } else {
        i <- idx[[1L]]
        testthat::expect_equal(pop_first$value, vals[[i]])
        testthat::expect_equal(pop_first$start, starts[[i]])
        testthat::expect_equal(pop_first$end, ends[[i]])
        testthat::expect_equal(as.list(pop_first$remaining), vals[-i])
      }

      testthat::expect_equal(as.list(pop_all$elements), expect_all)
      testthat::expect_equal(as.list(pop_all$remaining), expect_rest)
    }

    expect_relation(
      peek_first = peek_point(ix, 2, bounds = bt),
      peek_all = peek_all_point(ix, 2, bounds = bt),
      pop_first = pop_point(ix, 2, bounds = bt),
      pop_all = pop_all_point(ix, 2, bounds = bt),
      idx = idx_point
    )
    expect_relation(
      peek_first = peek_overlaps(ix, 2, 3, bounds = bt),
      peek_all = peek_all_overlaps(ix, 2, 3, bounds = bt),
      pop_first = pop_overlaps(ix, 2, 3, bounds = bt),
      pop_all = pop_all_overlaps(ix, 2, 3, bounds = bt),
      idx = idx_over
    )
    expect_relation(
      peek_first = peek_containing(ix, 2, 3, bounds = bt),
      peek_all = peek_all_containing(ix, 2, 3, bounds = bt),
      pop_first = pop_containing(ix, 2, 3, bounds = bt),
      pop_all = pop_all_containing(ix, 2, 3, bounds = bt),
      idx = idx_cont
    )
    expect_relation(
      peek_first = peek_within(ix, 2, 3, bounds = bt),
      peek_all = peek_all_within(ix, 2, 3, bounds = bt),
      pop_first = pop_within(ix, 2, 3, bounds = bt),
      pop_all = pop_all_within(ix, 2, 3, bounds = bt),
      idx = idx_with
    )
  }
})

testthat::test_that("point queries honor match_at modes on a fixed fixture", {
  ix <- as_interval_index(
    list("A", "B", "C", "D"),
    start = c(1, 2, 3, 2),
    end = c(3, 4, 5, 2),
    default_query_bounds = "[)"
  )

  # match_at = "start": entries whose start == point, FIFO on ties.
  testthat::expect_equal(peek_point(ix, 2, match_at = "start"), "B")
  testthat::expect_equal(as.list(peek_all_point(ix, 2, match_at = "start")), list("B", "D"))
  testthat::expect_null(peek_point(ix, 99, match_at = "start"))

  # match_at = "end": entries whose end == point.
  testthat::expect_equal(peek_point(ix, 3, match_at = "end"), "A")
  testthat::expect_equal(as.list(peek_all_point(ix, 3, match_at = "end")), list("A"))
  testthat::expect_equal(as.list(peek_all_point(ix, 2, match_at = "end")), list("D"))
  testthat::expect_identical(length(peek_all_point(ix, 99, match_at = "end")), 0L)

  # match_at = "either": union of start/end matches, canonical order by start.
  testthat::expect_equal(as.list(peek_all_point(ix, 2, match_at = "either")), list("B", "D"))
  testthat::expect_equal(as.list(peek_all_point(ix, 3, match_at = "either")), list("A", "C"))

  # pop_* shapes match peek semantics and preserve persistence.
  before <- as.list(ix)
  popped_end <- pop_all_point(ix, 3, match_at = "end")
  testthat::expect_equal(as.list(popped_end$elements), list("A"))
  testthat::expect_equal(as.list(popped_end$remaining), list("B", "D", "C"))
  testthat::expect_equal(as.list(ix), before)

  one_start <- pop_point(ix, 2, match_at = "start")
  testthat::expect_equal(one_start$value, "B")
  testthat::expect_equal(one_start$start, 2)
  testthat::expect_equal(one_start$end, 4)
  testthat::expect_equal(as.list(one_start$remaining), list("A", "D", "C"))
  # (sanity: after popping first of B/D at start==2, D is the only remaining start==2 entry)
})

testthat::test_that("match_at = 'interval' preserves default containment semantics", {
  ix <- as_interval_index(
    list("A", "B", "C"),
    start = c(1, 2, 4),
    end = c(3, 2, 5),
    default_query_bounds = "[)"
  )
  testthat::expect_equal(peek_point(ix, 2), peek_point(ix, 2, match_at = "interval"))
  testthat::expect_equal(
    as.list(peek_all_point(ix, 2)),
    as.list(peek_all_point(ix, 2, match_at = "interval"))
  )
})

testthat::test_that("coordinate-equality match_at modes ignore bounds", {
  ix <- as_interval_index(
    list("A", "B", "C"),
    start = c(1, 2, 3),
    end = c(3, 4, 5),
    default_query_bounds = "[)"
  )
  # With match_at = "end", endpoint is a structural coordinate — bounds override
  # has no effect.
  expected <- as.list(peek_all_point(ix, 3, match_at = "end"))
  for(bt in c("[)", "[]", "()", "(]")) {
    testthat::expect_equal(
      as.list(peek_all_point(ix, 3, match_at = "end", bounds = bt)),
      expected
    )
  }
})

testthat::test_that("match_at on empty indices is non-throwing and empty", {
  empty_ix <- interval_index()
  for(m in c("start", "end", "either")) {
    testthat::expect_null(peek_point(empty_ix, 1, match_at = m))
    testthat::expect_identical(length(peek_all_point(empty_ix, 1, match_at = m)), 0L)
    r <- pop_point(empty_ix, 1, match_at = m)
    testthat::expect_null(r$value)
    testthat::expect_null(r$start)
    testthat::expect_null(r$end)
    testthat::expect_identical(length(r$remaining), 0L)
    ra <- pop_all_point(empty_ix, 1, match_at = m)
    testthat::expect_identical(length(ra$elements), 0L)
    testthat::expect_identical(length(ra$remaining), 0L)
  }
})

testthat::test_that("match_at point queries match a pure-R oracle across bounds tokens", {
  ix <- as_interval_index(
    list("A", "B", "C", "D", "E"),
    start = c(1, 2, 3, 2, 4),
    end = c(3, 4, 5, 2, 4),
    default_query_bounds = "[)"
  )
  vals <- as.list(ix)
  entries <- .ivx_entries(ix)
  starts <- as.numeric(unlist(lapply(entries, function(e) e$start), use.names = FALSE))
  ends <- as.numeric(unlist(lapply(entries, function(e) e$end), use.names = FALSE))

  for(p in c(1, 2, 3, 4, 5, 99)) {
    # start mode
    idx <- which(starts == p)
    testthat::expect_equal(as.list(peek_all_point(ix, p, match_at = "start")), vals[idx])
    # end mode
    idx <- which(ends == p)
    testthat::expect_equal(as.list(peek_all_point(ix, p, match_at = "end")), vals[idx])
    # either mode — canonical start order
    idx <- which(starts == p | ends == p)
    testthat::expect_equal(as.list(peek_all_point(ix, p, match_at = "either")), vals[idx])
  }
})

testthat::test_that("pop helpers follow first/all contracts and preserve persistence", {
  ix <- as_interval_index(
    list("A", "B", "C", "D"),
    start = c(1, 2, 3, 2),
    end = c(2, 3, 4, 2),
    default_query_bounds = "[]"
  )

  first <- pop_overlaps(ix, 2, 3)
  testthat::expect_equal(first$value, "A")
  testthat::expect_equal(first$start, 1)
  testthat::expect_equal(first$end, 2)
  testthat::expect_s3_class(first$remaining, "interval_index")

  all <- pop_all_overlaps(ix, 2, 3)
  testthat::expect_s3_class(all$elements, "interval_index")
  testthat::expect_equal(as.list(all$elements), list("A", "B", "D", "C"))
  testthat::expect_identical(length(all$remaining), 0L)

  point_first <- pop_point(ix, 2)
  testthat::expect_equal(point_first$value, "A")
  testthat::expect_equal(point_first$start, 1)
  testthat::expect_equal(point_first$end, 2)
  testthat::expect_equal(as.list(point_first$remaining), list("B", "D", "C"))

  point_all <- pop_all_point(ix, 2)
  testthat::expect_s3_class(point_all$elements, "interval_index")
  testthat::expect_equal(as.list(point_all$elements), list("A", "B", "D"))
  testthat::expect_equal(as.list(point_all$remaining), list("C"))

  miss_first <- pop_within(ix, 9, 10)
  testthat::expect_null(miss_first$value)
  testthat::expect_null(miss_first$start)
  testthat::expect_null(miss_first$end)
  testthat::expect_equal(as.list(miss_first$remaining), as.list(ix))

  miss_all <- pop_all_containing(ix, 9, 10)
  testthat::expect_s3_class(miss_all$elements, "interval_index")
  testthat::expect_identical(length(miss_all$elements), 0L)
  testthat::expect_equal(as.list(miss_all$remaining), as.list(ix))

  miss_point_first <- pop_point(ix, 9)
  testthat::expect_null(miss_point_first$value)
  testthat::expect_null(miss_point_first$start)
  testthat::expect_null(miss_point_first$end)
  testthat::expect_equal(as.list(miss_point_first$remaining), as.list(ix))

  miss_point_all <- pop_all_point(ix, 9)
  testthat::expect_s3_class(miss_point_all$elements, "interval_index")
  testthat::expect_identical(length(miss_point_all$elements), 0L)
  testthat::expect_equal(as.list(miss_point_all$remaining), as.list(ix))
})

testthat::test_that("ordered key APIs are blocked on interval_index", {
  ix <- as_interval_index(list("a", "b"), start = c(1, 2), end = c(2, 3))

  testthat::expect_error(lower_bound(ix, 2), "not supported for interval_index")
  testthat::expect_error(upper_bound(ix, 2), "not supported for interval_index")
  testthat::expect_error(peek_key(ix, 2), "not supported for interval_index")
  testthat::expect_error(pop_key(ix, 2), "not supported for interval_index")
  testthat::expect_error(elements_between(ix, 1, 2), "not supported for interval_index")
  testthat::expect_error(count_key(ix, 2), "not supported for interval_index")
  testthat::expect_error(count_between(ix, 1, 2), "not supported for interval_index")
})

testthat::test_that("interval_index indexing preserves class and blocks replacement", {
  ix <- as_interval_index(
    setNames(as.list(c("xa", "xb", "xc")), c("a", "b", "c")),
    start = c(1, 2, 3),
    end = c(2, 3, 4)
  )

  sub <- ix[c(1, 3)]
  testthat::expect_s3_class(sub, "interval_index")
  testthat::expect_equal(as.list(sub), list(a = "xa", c = "xc"))
  testthat::expect_identical(names(as.list(sub)), c("a", "c"))

  testthat::expect_equal(ix[[2]], "xb")
  testthat::expect_equal(ix[["c"]], "xc")
  testthat::expect_equal(ix$b, "xb")

  reordered <- NULL
  testthat::expect_warning(
    { reordered <- ix[c(3, 1)] },
    "canonicalizes selector order"
  )
  testthat::expect_equal(as.list(reordered), list(a = "xa", c = "xc"))

  reordered_name <- NULL
  testthat::expect_warning(
    { reordered_name <- ix[c("b", "a")] },
    "canonicalizes selector order"
  )
  testthat::expect_equal(as.list(reordered_name), list(a = "xa", b = "xb"))

  testthat::expect_error(ix[c(2, 2)], "duplicate indices")
  testthat::expect_error(ix[c("a", "a")], "duplicate indices")

  testthat::expect_error({ ix[[1]] <- "qq" }, "not supported")
  testthat::expect_error({ ix[1] <- list("qq") }, "not supported")
  testthat::expect_error({ ix$b <- "qq" }, "not supported")
})

testthat::test_that("front/back/at peek/pop helpers are blocked on interval_index", {
  ix <- as_interval_index("a", start = 1, end = 2)

  testthat::expect_error(peek_front(ix), "not supported for interval_index")
  testthat::expect_error(peek_back(ix), "not supported for interval_index")
  testthat::expect_error(peek_at(ix, 1), "not supported for interval_index")
  testthat::expect_error(pop_front(ix), "not supported for interval_index")
  testthat::expect_error(pop_back(ix), "not supported for interval_index")
  testthat::expect_error(pop_at(ix, 1), "not supported for interval_index")
})

testthat::test_that("fapply for interval_index updates payload only and keeps interval metadata immutable", {
  ix <- as_interval_index(
    setNames(as.list(c("a", "b", "c")), c("ka", "kb", "kc")),
    start = c(3, 1, 2),
    end = c(4, 2, 3),
    default_query_bounds = "[]"
  )
  b0 <- lapply(.ivx_entries(ix), function(e) list(start = e$start, end = e$end))

  ix2 <- fapply(ix, function(value, start, end, name) {
    toupper(value)
  })
  ix2_noname <- fapply(ix, function(value, start, end) {
    paste0(value, "@", start, "-", end)
  })

  testthat::expect_s3_class(ix2, "interval_index")
  testthat::expect_equal(unname(as.list(ix2)), list("B", "C", "A"))
  testthat::expect_equal(ix2[["kb"]], "B")
  testthat::expect_equal(ix2_noname[["kb"]], "b@1-2")

  b2 <- lapply(.ivx_entries(ix2), function(e) list(start = e$start, end = e$end))
  testthat::expect_equal(unname(lapply(b2, function(e) e$start)), unname(lapply(b0, function(e) e$start)))
  testthat::expect_equal(unname(lapply(b2, function(e) e$end)), unname(lapply(b0, function(e) e$end)))

  testthat::expect_error(fapply(ix, 1), "`FUN` must be a function")

  ix3 <- fapply(ix, function(value, start, end, name) {
    list(old = value, at = c(start, end), nm = name)
  })
  testthat::expect_type(ix3[[1]], "list")
  testthat::expect_named(ix3[[1]], c("old", "at", "nm"))
  b3 <- lapply(.ivx_entries(ix3), function(e) list(start = e$start, end = e$end))
  testthat::expect_equal(unname(lapply(b3, function(e) e$start)), unname(lapply(b0, function(e) e$start)))
  testthat::expect_equal(unname(lapply(b3, function(e) e$end)), unname(lapply(b0, function(e) e$end)))
  testthat::expect_error(fapply(ix, identity, preserve_custom_monoids = NA), "`preserve_custom_monoids` must be TRUE or FALSE")
})

testthat::test_that("interval_index recomputes user monoids across insert, fapply, and slices", {
  sum_item <- measure_monoid(function(a, b) a + b, 0, function(entry) as.numeric(entry$value))
  width_sum <- measure_monoid(function(a, b) a + b, 0, function(entry) as.numeric(entry$end - entry$start))

  ix <- add_monoids(as_interval_index(
    as.list(c(10, 20, 30)),
    start = c(1, 2, 4),
    end = c(3, 5, 6)
  ), list(sum_item = sum_item, width_sum = width_sum))
  testthat::expect_equal(node_measure(ix, "sum_item"), 60)
  testthat::expect_equal(node_measure(ix, "width_sum"), 7)

  ix2 <- insert(ix, 40, start = 3, end = 4)
  testthat::expect_equal(node_measure(ix2, "sum_item"), 100)
  testthat::expect_equal(node_measure(ix2, "width_sum"), 8)

  ix3 <- fapply(ix2, function(value, start, end, name) value + 1)
  testthat::expect_equal(node_measure(ix3, "sum_item"), 104)
  testthat::expect_equal(node_measure(ix3, "width_sum"), 8)

  overlaps <- peek_all_overlaps(ix3, 2, 3, bounds = "[)")
  testthat::expect_s3_class(overlaps, "interval_index")
  testthat::expect_equal(as.list(overlaps), as.list(c(11, 21)))
  testthat::expect_equal(node_measure(overlaps, "sum_item"), 32)
  testthat::expect_equal(node_measure(overlaps, "width_sum"), 5)

  popped <- pop_all_overlaps(ix3, 2, 3, bounds = "[)")
  testthat::expect_s3_class(popped$elements, "interval_index")
  testthat::expect_s3_class(popped$remaining, "interval_index")
  testthat::expect_equal(node_measure(popped$elements, "sum_item"), 32)
  testthat::expect_equal(node_measure(popped$remaining, "sum_item"), 72)
  testthat::expect_equal(node_measure(popped$elements, "width_sum"), 5)
  testthat::expect_equal(node_measure(popped$remaining, "width_sum"), 3)
})

testthat::test_that("interval_index custom monoids accept entry measure arguments", {
  ix <- add_monoids(
    as_interval_index(as.list(c(10, 20)), start = c(1, 3), end = c(2, 5)),
    list(
      by_width = measure_monoid(`+`, 0, function(entry) as.numeric(entry$end - entry$start))
    )
  )
  testthat::expect_equal(node_measure(ix, "by_width"), 3)
})

testthat::test_that("fapply can drop custom monoids for interval_index", {
  sum_item <- measure_monoid(`+`, 0, function(entry) as.numeric(entry$value))
  ix <- add_monoids(as_interval_index(as.list(c(10, 20)), start = c(1, 3), end = c(2, 5)), list(sum_item = sum_item))
  ix2 <- fapply(ix, function(value, start, end, name) value + 1, preserve_custom_monoids = FALSE)

  ms <- attr(ix2, "monoids", exact = TRUE)
  testthat::expect_true(!is.null(ms[[".size"]]))
  testthat::expect_true(!is.null(ms[[".named_count"]]))
  testthat::expect_true(!is.null(ms[[".ivx_max_start"]]))
  testthat::expect_true(!is.null(ms[[".ivx_max_end"]]))
  testthat::expect_true(!is.null(ms[[".ivx_min_end"]]))
  testthat::expect_true(is.null(ms[["sum_item"]]))
  testthat::expect_error(node_measure(ix2, "sum_item"), "Missing cached measure")
  testthat::expect_equal(as.list(ix2), as.list(c(11, 21)))
})

testthat::test_that("interval_index casts down to flexseq explicitly", {
  width_sum <- measure_monoid(`+`, 0, function(entry) as.numeric(entry$end - entry$start))
  ix <- add_monoids(as_interval_index(
    setNames(list("x", "y"), c("ix", "iy")),
    start = c(1, 3),
    end = c(2, 5)
  ), list(width_sum = width_sum))

  fx <- as_flexseq(ix)
  testthat::expect_s3_class(fx, "flexseq")
  testthat::expect_false(inherits(fx, "interval_index"))
  testthat::expect_equal(fx[["ix"]], "x")
  testthat::expect_equal(fx[["iy"]], "y")

  ms <- names(attr(fx, "monoids", exact = TRUE))
  testthat::expect_true(all(c(".size", ".named_count") %in% ms))
  testthat::expect_false("width_sum" %in% ms)
  testthat::expect_error(node_measure(fx, "width_sum"), "Missing cached measure")
  testthat::expect_false(".ivx_max_start" %in% ms)
  testthat::expect_false(".ivx_max_end" %in% ms)
  testthat::expect_false(".ivx_min_end" %in% ms)
  testthat::expect_false(".oms_max_key" %in% ms)
})

testthat::test_that("interval_index rejects non-empty start when no elements are supplied", {
  testthat::expect_error(
    interval_index(start = c(1, 2)),
    "`start` must be empty when no elements are supplied"
  )
  testthat::expect_error(
    as_interval_index(list(), start = c(1, 2), end = c(2, 3)),
    "`start` must be empty when no elements are supplied"
  )
})

testthat::test_that("interval_index rejects non-empty end when no elements are supplied", {
  testthat::expect_error(
    interval_index(end = c(1, 2)),
    "`end` must be empty when no elements are supplied"
  )
})

testthat::test_that("interval_index requires start and end when elements are supplied", {
  testthat::expect_error(
    interval_index("a", end = c(2)),
    "`start` is required when elements are supplied"
  )
  testthat::expect_error(
    interval_index("a", start = c(1)),
    "`end` is required when elements are supplied"
  )
})

testthat::test_that("interval_index enforces start/end length matches elements length", {
  testthat::expect_error(
    interval_index("a", "b", start = c(1), end = c(2, 3)),
    "`start` length must match elements length"
  )
  testthat::expect_error(
    interval_index("a", "b", start = c(1, 2), end = c(3)),
    "`end` length must match elements length"
  )
})

testthat::test_that("interval_index falls back to internal merge-sort when `c()` on endpoints fails", {
  # Mirrors the ordered_sequence fallback case: for exotic endpoint classes
  # without a `c()` method, the default `order(do.call(c, starts), idx)` path
  # fails and .ivx_build_from_items delegates to .ivx_merge_sort_indices.
  # `mk_comp` is defined in tests/testthat/helper-mk-comp.R.
  testthat::expect_true(
    inherits(tryCatch(order(do.call(c, list(mk_comp(1), mk_comp(2))), 1:2),
                      error = function(e) e),
             "error")
  )

  vals <- letters[1:7]
  starts <- lapply(c(4, 1, 6, 3, 7, 2, 5), mk_comp)
  ends <- lapply(c(5, 2, 7, 4, 8, 3, 6), mk_comp)
  ix <- as_interval_index(vals, start = starts, end = ends)
  testthat::expect_identical(length(ix), 7L)
  # Sorted by start val ascending: 1,2,3,4,5,6,7 -> b,f,d,a,g,c,e
  testthat::expect_identical(unlist(as.list(ix)), c("b", "f", "d", "a", "g", "c", "e"))
})

testthat::test_that(".ivx_parse_entry validates entry records (direct internal call)", {
  # .ivx_parse_entry is a documented internal validator for serialized entry
  # records during subclass restore, but no current caller path exercises it.
  # These tests pin its behavior via `:::` so the validator cannot silently rot
  # if a future restore hook begins relying on it.
  parse <- Immutables:::.ivx_parse_entry

  # Happy path, with and without explicit `key`.
  out <- parse(list(value = "v", start = 1, end = 2))
  testthat::expect_identical(out$entry$value, "v")
  testthat::expect_identical(out$entry$start, 1)
  testthat::expect_identical(out$entry$end, 2)
  testthat::expect_identical(out$endpoint_type, "numeric")

  out_key <- parse(list(value = "v", start = 1, end = 2, key = 1))
  testthat::expect_identical(out_key$entry$start, 1)

  # Error branches.
  testthat::expect_error(parse(1L),                                     "must be named lists")
  testthat::expect_error(parse(list(1, 2, 3)),                           "must be named lists")
  testthat::expect_error(parse(setNames(list(1, 2, 3), c("a", NA, "c"))),"must be named lists")
  testthat::expect_error(parse(list(value = 1, value = 2, start = 1, end = 2)),
                         "entry fields must be unique")
  testthat::expect_error(parse(list(value = 1, start = 1, end = 2, bogus = 9)),
                         "unsupported field")
  testthat::expect_error(parse(list(value = 1, start = 1)),
                         "must include")
  testthat::expect_error(parse(list(value = "v", start = 1, end = 2, key = 7)),
                         "`key` must equal `start`")
})

testthat::test_that("interval_index supports ordered-factor endpoints (exotic-endpoint slow path)", {
  # Ordered factors aren't in the fast-domain set, so queries route through the
  # pure-R leaf_match predicates .ivx_contains_point / .ivx_overlaps_interval /
  # .ivx_contains_interval instead of the inline fast-path closures.
  lvls <- letters[1:5]
  f <- factor(lvls, levels = lvls, ordered = TRUE)

  # Default bounds are [start, end).
  ix <- interval_index("x", "y", start = c(f[1], f[3]), end = c(f[3], f[5]))
  testthat::expect_identical(length(ix), 2L)

  # Point query: `b` falls inside [a,c) only.
  testthat::expect_identical(peek_point(ix, f[2]), "x")

  # Overlaps query: [c,d) overlaps [c,e) only (not [a,c) because end is exclusive).
  testthat::expect_identical(peek_overlaps(ix, start = f[3], end = f[4]), "y")

  # Containing query: entries whose interval contains [b,c) — only [a,c).
  testthat::expect_identical(peek_containing(ix, start = f[2], end = f[3]), "x")

  # Within query: entries whose interval is within [a,e) — only [a,c).
  testthat::expect_identical(peek_within(ix, start = f[1], end = f[5]), "x")
})