tests/testthat/test-deep-share.R

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

# Tests for deep sharing with memoization, alias preservation, and cycle detection

test_that("deep share preserves aliases - same object creates one segment", {
    # Create a large matrix and reference it twice in a list
    big_mat <- matrix(rnorm(10000), nrow = 100)  # ~80KB

    lst <- list(a = big_mat, b = big_mat)

    # Share with deep=TRUE and low threshold to trigger sharing
    shared <- share(lst, deep = TRUE, min_bytes = 1000)

    expect_s3_class(shared, "shard_deep_shared")

    # Should have exactly 1 shared segment (the matrix)
    # and 1 alias (the second reference to the same matrix)
    expect_equal(shared$summary$shared_count, 1)
    expect_equal(shared$summary$alias_count, 1)

    # Fetch and verify data is correct
    recovered <- fetch(shared)
    expect_identical(recovered$a, big_mat)
    expect_identical(recovered$b, big_mat)

    # Both should be the same object reference in the original
    # (after fetch they may be copies, but should have identical values)
    expect_identical(recovered$a, recovered$b)

    close(shared)
})

test_that("deep share handles lists with shareable and non-shareable components", {
    big_vec <- rnorm(10000)  # Large, shareable
    small_vec <- 1:10        # Small, kept
    char_vec <- letters      # Character, not shareable as atomic

    lst <- list(big = big_vec, small = small_vec, chars = char_vec)

    shared <- share(lst, deep = TRUE, min_bytes = 1000)

    expect_s3_class(shared, "shard_deep_shared")

    # Only big_vec should be shared
    expect_equal(shared$summary$shared_count, 1)
    expect_equal(shared$summary$kept_count, 2)  # small + chars

    recovered <- fetch(shared)
    expect_equal(recovered$big, big_vec)
    expect_identical(recovered$small, small_vec)
    expect_identical(recovered$chars, char_vec)

    close(shared)
})

test_that("deep share detects cycles with environments and errors by default", {
    # R lists copy on assignment, so we need environments for true cycles
    env <- new.env()
    env$data <- 1:10
    env$self <- env  # True self-reference in environment
    expect_error(
        share(env, deep = TRUE, min_bytes = 100, cycle = "error"),
        "Cycle detected"
    )
})

test_that("deep share with cycle='skip' - list self-assignment creates copy not cycle", {
    # In R, lst$self <- lst creates a COPY, not a true cycle
    # So this actually creates an alias scenario, not a cycle
    lst <- list(a = 1:10)
    lst$self <- lst  # This creates a copy of lst at this point

    # This should work because there's no actual cycle
    shared <- share(lst, deep = TRUE, min_bytes = 100, cycle = "skip")

    expect_s3_class(shared, "shard_deep_shared")

    # No cycles should be detected (R lists don't create true cycles)
    expect_equal(shared$summary$cycle_count, 0)

    recovered <- fetch(shared)
    expect_identical(recovered$a, 1:10)
    # self contains the original structure (not a true cycle)
    expect_true(is.list(recovered$self))
    expect_identical(recovered$self$a, 1:10)

    close(shared)
})

test_that("deep share works with data.frames", {
    # Create a data.frame with large numeric columns
    df <- data.frame(
        x = rnorm(10000),
        y = rnorm(10000),
        z = letters[sample(26, 10000, replace = TRUE)]
    )

    shared <- share(df, deep = TRUE, min_bytes = 1000)

    expect_s3_class(shared, "shard_deep_shared")

    # x and y should be shared (numeric, large enough)
    # z should be kept (character)
    expect_equal(shared$summary$shared_count, 2)

    recovered <- fetch(shared)
    expect_equal(recovered, df)
    expect_s3_class(recovered, "data.frame")

    close(shared)
})

test_that("deep share tracks total bytes correctly", {
    big_vec <- rnorm(10000)  # ~80KB (10000 * 8 bytes)

    lst <- list(a = big_vec)

    shared <- share(lst, deep = TRUE, min_bytes = 1000)

    # Total shared bytes should be approximately the size of big_vec
    expect_true(shared$summary$total_shared_bytes > 70000)
    expect_true(shared$summary$total_shared_bytes < 100000)

    close(shared)
})

test_that("deep share with aliased data.frame column", {
    # Same vector used as two columns
    shared_col <- rnorm(10000)
    df <- data.frame(a = shared_col, b = shared_col)

    shared <- share(df, deep = TRUE, min_bytes = 1000)

    # Should detect alias
    expect_equal(shared$summary$shared_count, 1)
    expect_equal(shared$summary$alias_count, 1)

    recovered <- fetch(shared)
    expect_equal(recovered$a, shared_col)
    expect_equal(recovered$b, shared_col)

    close(shared)
})

test_that("fetch and close work correctly for deep shared", {
    lst <- list(x = rnorm(10000))

    shared <- share(lst, deep = TRUE, min_bytes = 1000)

    # Multiple fetches should work
    r1 <- fetch(shared)
    r2 <- fetch(shared)
    expect_identical(r1, r2)

    # Close should not error
    expect_silent(close(shared))
})

test_that("print method works for deep shared", {
    lst <- list(x = rnorm(10000))

    shared <- share(lst, deep = TRUE, min_bytes = 1000)

    expect_output(print(shared), "shard_deep_shared")
    expect_output(print(shared), "Shared segments:")

    close(shared)
})

test_that("is_shared recognizes deep shared objects", {
    lst <- list(x = rnorm(10000))
    shared <- share(lst, deep = TRUE, min_bytes = 1000)

    expect_true(is_shared(shared))

    close(shared)
})

test_that("deep share respects min_bytes threshold", {
    small_vec <- 1:100  # Small
    medium_vec <- rnorm(1000)  # Medium
    large_vec <- rnorm(10000)  # Large

    # With high threshold, only large should be shared
    shared_high <- share(
        list(small = small_vec, medium = medium_vec, large = large_vec),
        deep = TRUE,
        min_bytes = 50000  # ~50KB threshold
    )
    expect_equal(shared_high$summary$shared_count, 1)
    close(shared_high)

    # With low threshold, medium and large should be shared
    shared_low <- share(
        list(small = small_vec, medium = medium_vec, large = large_vec),
        deep = TRUE,
        min_bytes = 5000  # ~5KB threshold
    )
    expect_equal(shared_low$summary$shared_count, 2)
    close(shared_low)
})

test_that("deep share preserves list names", {
    lst <- list(alpha = rnorm(10000), beta = rnorm(5000), gamma = 1:10)

    shared <- share(lst, deep = TRUE, min_bytes = 1000)
    recovered <- fetch(shared)

    expect_identical(names(recovered), names(lst))

    close(shared)
})

test_that("deep share preserves nested list structure", {
    nested <- list(
        level1 = list(
            a = rnorm(10000),
            b = 1:10
        ),
        top = rnorm(10000)
    )

    shared <- share(nested, deep = TRUE, min_bytes = 1000)
    recovered <- fetch(shared)

    expect_identical(names(recovered), c("level1", "top"))
    expect_identical(names(recovered$level1), c("a", "b"))
    expect_equal(recovered$level1$a, nested$level1$a)
    expect_identical(recovered$level1$b, nested$level1$b)
    expect_equal(recovered$top, nested$top)

    close(shared)
})

test_that("non-deep share ignores deep parameters", {
    x <- 1:100
    shared <- share(x, deep = FALSE)

    expect_true(is_shared_vector(shared) || inherits(shared, "shard_shared"))
    expect_false(inherits(shared, "shard_deep_shared"))

    close(shared)
})