tests/testthat/test-altrep.R

In shard: Deterministic, Zero-Copy Parallel Execution for R

# Tests for ALTREP shared vectors

test_that("shared_vector creates ALTREP vectors for different types", {
    # Integer
    seg_int <- segment_create(400)
    segment_write(seg_int, 1:100, offset = 0)
    x_int <- shared_vector(seg_int, "integer", length = 100)

    expect_true(is_shared_vector(x_int))
    expect_equal(length(x_int), 100)
    expect_equal(as.integer(x_int[1]), 1L)
    expect_equal(as.integer(x_int[100]), 100L)

    # Double
    seg_dbl <- segment_create(800)
    segment_write(seg_dbl, as.double(1:100), offset = 0)
    x_dbl <- shared_vector(seg_dbl, "double", length = 100)

    expect_true(is_shared_vector(x_dbl))
    expect_equal(length(x_dbl), 100)
    expect_equal(as.double(x_dbl[1]), 1.0)
    expect_equal(as.double(x_dbl[100]), 100.0)

    # Logical
    seg_lgl <- segment_create(400)
    lgl_data <- rep(c(TRUE, FALSE), 50)
    segment_write(seg_lgl, lgl_data, offset = 0)
    x_lgl <- shared_vector(seg_lgl, "logical", length = 100)

    expect_true(is_shared_vector(x_lgl))
    expect_equal(length(x_lgl), 100)
    expect_true(as.logical(x_lgl[1]))
    expect_false(as.logical(x_lgl[2]))

    # Raw
    seg_raw <- segment_create(100)
    segment_write(seg_raw, as.raw(1:100), offset = 0)
    x_raw <- shared_vector(seg_raw, "raw", length = 100)

    expect_true(is_shared_vector(x_raw))
    expect_equal(length(x_raw), 100)
    expect_equal(as.raw(x_raw[1]), as.raw(1))
})

test_that("shared_vector respects offset parameter", {
    seg <- segment_create(800)
    segment_write(seg, 1:100, offset = 0)
    segment_write(seg, 101:200, offset = 400)  # After first 100 integers

    # Read from offset
    x <- shared_vector(seg, "integer", offset = 400, length = 100)

    expect_equal(length(x), 100)
    expect_equal(as.integer(x[1]), 101L)
    expect_equal(as.integer(x[100]), 200L)
})

test_that("contiguous subsetting returns views, not copies", {
    seg <- segment_create(400)
    segment_write(seg, 1:100, offset = 0)
    x <- shared_vector(seg, "integer", length = 100)

    # Reset diagnostics
    shared_reset_diagnostics(x)

    # Contiguous subset
    y <- x[1:10]

    # For contiguous indices, we should get a view (also ALTREP)
    # Note: R's subsetting might materialize in some cases
    expect_equal(length(y), 10)
    expect_equal(as.integer(y[1]), 1L)
    expect_equal(as.integer(y[10]), 10L)
})

test_that("shared_view creates views explicitly", {
    seg <- segment_create(400)
    segment_write(seg, 1:100, offset = 0)
    x <- shared_vector(seg, "integer", length = 100)

    # Create explicit view
    y <- shared_view(x, start = 11, length = 10)

    expect_true(is_shared_vector(y))
    expect_equal(length(y), 10)
    expect_equal(as.integer(y[1]), 11L)  # x[11]
    expect_equal(as.integer(y[10]), 20L) # x[20]
})

test_that("shared_diagnostics tracks dataptr and materialize calls", {
    seg <- segment_create(400)
    segment_write(seg, 1:100, offset = 0)
    x <- shared_vector(seg, "integer", length = 100)

    # Get initial diagnostics
    diag1 <- shared_diagnostics(x)
    expect_equal(diag1$length, 100)
    expect_equal(diag1$offset, 0)
    expect_true(diag1$readonly)
    expect_equal(diag1$type, "integer")

    # Reset and verify
    shared_reset_diagnostics(x)
    diag2 <- shared_diagnostics(x)
    expect_equal(diag2$dataptr_calls, 0)
    expect_equal(diag2$materialize_calls, 0)

    # Access data (may increment counters depending on operation)
    sum_val <- sum(x)
    expect_equal(sum_val, sum(1:100))
})

test_that("cow='deny' prevents mutation via replacement functions", {
    seg <- segment_create(400)
    segment_write(seg, 1:100, offset = 0)

    # Create readonly vector on UNPROTECTED segment
    x <- shared_vector(seg, "integer", length = 100, readonly = TRUE, cow = "deny")

    # Reading should work
    expect_equal(as.integer(x[1]), 1L)
    expect_equal(as.integer(x[50]), 50L)

    # Attempt to write should error and leave x unchanged.
    expect_error(x[1] <- 999L, "cow='deny'")
    expect_equal(as.integer(x[1]), 1L)

    # x remains a shard shared object (it may be materialized by R internals).
    expect_true(inherits(x, "shard_shared_vector"))
})

test_that("is_shared_vector correctly identifies ALTREP vectors", {
    seg <- segment_create(400)
    segment_write(seg, 1:100, offset = 0)
    x <- shared_vector(seg, "integer", length = 100)

    expect_true(is_shared_vector(x))
    expect_false(is_shared_vector(1:100))
    expect_false(is_shared_vector(c(1.0, 2.0)))
    expect_false(is_shared_vector("hello"))
    expect_false(is_shared_vector(list(a = 1)))
})

test_that("as_shared converts standard vectors to shared", {
    # Integer
    x_int <- as_shared(1:100)
    expect_true(is_shared_vector(x_int))
    expect_equal(length(x_int), 100)
    expect_equal(as.integer(x_int[50]), 50L)

    # Double
    x_dbl <- as_shared(as.double(1:100))
    expect_true(is_shared_vector(x_dbl))
    expect_equal(as.double(x_dbl[50]), 50.0)

    # Logical
    x_lgl <- as_shared(c(TRUE, FALSE, TRUE))
    expect_true(is_shared_vector(x_lgl))
    expect_true(as.logical(x_lgl[1]))
    expect_false(as.logical(x_lgl[2]))

    # Raw
    x_raw <- as_shared(as.raw(1:10))
    expect_true(is_shared_vector(x_raw))
    expect_equal(as.raw(x_raw[5]), as.raw(5))
})

test_that("shared_segment returns the underlying segment", {
    seg <- segment_create(400)
    segment_write(seg, 1:100, offset = 0)
    x <- shared_vector(seg, "integer", length = 100)

    seg <- shared_segment(x)
    expect_true(inherits(seg, "shard_segment"))
    expect_true(inherits(seg$ptr, "externalptr"))
})

test_that("vector operations work on shared vectors", {
    x <- as_shared(1:100)

    # Sum
    expect_equal(sum(x), sum(1:100))

    # Mean
    expect_equal(mean(x), mean(1:100))

    # Range
    expect_equal(as.integer(range(x)), c(1L, 100L))

    # Comparison
    expect_equal(sum(x > 50), 50)
})

test_that("shared vectors work with double precision", {
    vals <- seq(0.1, 10.0, by = 0.1)
    x <- as_shared(vals)

    expect_true(is_shared_vector(x))
    expect_equal(length(x), 100)
    expect_equal(as.double(x[1]), 0.1)
    expect_equal(sum(x), sum(vals))
})

test_that("views share the same underlying memory", {
    seg <- segment_create(400)
    segment_write(seg, 1:100, offset = 0)

    x <- shared_vector(seg, "integer", length = 100)
    y <- shared_view(x, start = 1, length = 50)
    z <- shared_view(x, start = 51, length = 50)

    # Views should have same segment
    expect_equal(shared_segment(x), shared_segment(y))
    expect_equal(shared_segment(x), shared_segment(z))

    # Data should match
    expect_equal(as.integer(y[1]), 1L)
    expect_equal(as.integer(z[1]), 51L)
})

test_that("writing through a view triggers private copy at the correct offset", {
    seg <- segment_create(400)
    segment_write(seg, 1:100, offset = 0)

    # Allow copy-on-write so we can verify the "view write" path is correct.
    x <- shared_vector(seg, "integer", length = 100, readonly = TRUE, cow = "allow")
    v <- shared_view(x, start = 11, length = 10)  # maps x[11:20]

    # Write should materialize v privately, and must not mutate the shared segment.
    v[1] <- 999L

    expect_equal(as.integer(v[1]), 999L)
    expect_equal(as.integer(x[11]), 11L)
    expect_equal(as.integer(x[1]), 1L)

    # A fresh view of the same segment sees the original data.
    y <- shared_vector(seg, "integer", length = 100, readonly = TRUE, cow = "allow")
    expect_equal(as.integer(y[11]), 11L)
})

test_that("multiple views can be created", {
    x <- as_shared(1:1000)

    # Create multiple overlapping views
    v1 <- shared_view(x, start = 1, length = 100)
    v2 <- shared_view(x, start = 50, length = 100)
    v3 <- shared_view(x, start = 100, length = 100)

    expect_equal(length(v1), 100)
    expect_equal(length(v2), 100)
    expect_equal(length(v3), 100)

    # Overlapping region should have same values
    expect_equal(v1[50:99], v2[1:50])
    expect_equal(v2[51:100], v3[1:50])
})

test_that("error handling for invalid inputs", {
    seg <- segment_create(400)
    segment_write(seg, 1:100, offset = 0)
    x <- shared_vector(seg, "integer", length = 100)

    # View start out of bounds
    expect_error(shared_view(x, start = 101, length = 10))

    # View extends beyond bounds
    expect_error(shared_view(x, start = 95, length = 10))

    # Non-ALTREP input
    expect_error(shared_view(1:100, start = 1, length = 10))
    expect_error(shared_diagnostics(1:100))
    expect_error(shared_segment(1:100))
})