tests/testthat/test-buffer.R

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

# Tests for buffer() - typed writable output buffers

test_that("buffer creates double buffer", {
    buf <- buffer("double", dim = 100)
    expect_s3_class(buf, "shard_buffer")
    expect_equal(buf$type, "double")
    expect_equal(buf$n, 100)
    expect_equal(length(buf), 100)

    # Check initial values are zero
    expect_equal(buf[], rep(0, 100))

    buffer_close(buf)
})

test_that("buffer creates integer buffer", {
    buf <- buffer("integer", dim = 50)
    expect_equal(buf$type, "integer")
    expect_equal(buf[], rep(0L, 50))
    buffer_close(buf)
})

test_that("buffer creates logical buffer", {
    buf <- buffer("logical", dim = 25)
    expect_equal(buf$type, "logical")
    expect_equal(buf[], rep(FALSE, 25))
    buffer_close(buf)
})

test_that("buffer creates raw buffer", {
    buf <- buffer("raw", dim = 10)
    expect_equal(buf$type, "raw")
    expect_equal(buf[], raw(10))
    buffer_close(buf)
})

test_that("buffer with custom init value", {
    buf <- buffer("double", dim = 10, init = 42)
    expect_equal(buf[], rep(42, 10))
    buffer_close(buf)
})

test_that("buffer slice assignment works", {
    buf <- buffer("double", dim = 100)

    # Write to a slice
    buf[1:10] <- 1:10
    expect_equal(buf[1:10], as.double(1:10))
    expect_equal(buf[11], 0)

    # Write to non-contiguous indices
    buf[c(20, 30, 40)] <- c(200, 300, 400)
    expect_equal(buf[c(20, 30, 40)], c(200, 300, 400))

    buffer_close(buf)
})

test_that("buffer slice reading works", {
    buf <- buffer("integer", dim = 100)
    buf[1:100] <- 1:100

    expect_equal(buf[1:10], 1L:10L)
    expect_equal(buf[50], 50L)
    expect_equal(buf[c(1, 50, 100)], c(1L, 50L, 100L))

    buffer_close(buf)
})

test_that("buffer full extraction with [] works", {
    buf <- buffer("double", dim = 10)
    buf[1:5] <- 1:5
    buf[6:10] <- 6:10

    result <- buf[]
    expect_equal(result, as.double(1:10))

    buffer_close(buf)
})

test_that("buffer matrix operations work", {
    buf <- buffer("double", dim = c(10, 5))

    expect_equal(dim(buf), c(10, 5))
    expect_equal(length(buf), 50)

    # Write a column
    buf[, 1] <- 1:10
    expect_equal(buf[, 1], as.double(1:10))

    # Write a row
    buf[1, ] <- 101:105
    expect_equal(buf[1, ], as.double(101:105))

    # Write a submatrix
    buf[2:4, 2:3] <- matrix(1:6, nrow = 3)
    expect_equal(buf[2:4, 2:3], matrix(as.double(1:6), nrow = 3))

    buffer_close(buf)
})

test_that("buffer as.* conversions work", {
    buf <- buffer("double", dim = 10)
    buf[] <- 1:10

    expect_equal(as.vector(buf), as.double(1:10))
    expect_equal(as.double(buf), as.double(1:10))
    expect_equal(as.integer(buf), 1L:10L)

    buffer_close(buf)
})

test_that("buffer matrix conversion works", {
    buf <- buffer("double", dim = c(3, 4))
    buf[] <- 1:12

    mat <- as.matrix(buf)
    expect_true(is.matrix(mat))
    expect_equal(dim(mat), c(3, 4))
    expect_equal(mat[1, 1], 1)
    expect_equal(mat[3, 4], 12)

    buffer_close(buf)
})

test_that("buffer info returns correct information", {
    buf <- buffer("double", dim = c(100, 50))

    info <- buffer_info(buf)
    expect_equal(info$type, "double")
    expect_equal(info$dim, c(100L, 50L))
    expect_equal(info$n, 5000)
    expect_equal(info$bytes, 5000 * 8)

    buffer_close(buf)
})

test_that("buffer path returns path", {
    buf <- buffer("double", dim = 100)
    path <- buffer_path(buf)
    expect_true(!is.null(path))
    expect_true(is.character(path))
    buffer_close(buf)
})

test_that("buffer print works", {
    buf <- buffer("double", dim = c(100, 50))
    expect_output(print(buf), "shard_buffer")
    expect_output(print(buf), "double")
    expect_output(print(buf), "100 x 50")
    buffer_close(buf)
})

test_that("buffer rejects invalid dimensions", {
    expect_error(buffer("double", dim = 0))
    expect_error(buffer("double", dim = -1))
    expect_error(buffer("double", dim = c(10, 0)))
})

test_that("buffer rejects out of bounds indices", {
    buf <- buffer("double", dim = 10)
    expect_error(buf[0])
    expect_error(buf[11])
    expect_error(buf[1:11])
    expect_error(buf[-1] <- 1)
    buffer_close(buf)
})

test_that("buffer works with mmap backing", {
    buf <- buffer("double", dim = 100, backing = "mmap")
    buf[1:50] <- 1:50
    expect_equal(buf[1:50], as.double(1:50))
    buffer_close(buf)
})

test_that("buffer_open attaches to existing buffer", {
    # Create original buffer
    buf1 <- buffer("double", dim = 100)
    buf1[1:10] <- 1:10
    path <- buffer_path(buf1)
    info <- buffer_info(buf1)

    # Open from another "process" (same process but tests API)
    buf2 <- buffer_open(path, type = "double", dim = 100,
                        backing = info$backing)

    # Read what buf1 wrote
    expect_equal(buf2[1:10], as.double(1:10))

    # Write from buf2
    buf2[50:60] <- 50:60

    # Read from buf1
    expect_equal(buf1[50:60], as.double(50:60))

    buffer_close(buf1)
    buffer_close(buf2, unlink = FALSE)  # Don't unlink since buf1 owns it
})

test_that("buffer value recycling works", {
    buf <- buffer("double", dim = 10)

    # Single value recycled to fill indices
    buf[1:5] <- 42
    expect_equal(buf[1:5], rep(42, 5))

    buffer_close(buf)
})

test_that("buffer integer type preserves values", {
    buf <- buffer("integer", dim = 100)
    buf[1:10] <- c(-5L, -4L, -3L, -2L, -1L, 0L, 1L, 2L, 3L, 4L)
    expect_equal(buf[1:10], c(-5L, -4L, -3L, -2L, -1L, 0L, 1L, 2L, 3L, 4L))
    buffer_close(buf)
})

test_that("buffer logical type works", {
    buf <- buffer("logical", dim = 10)
    buf[c(1, 3, 5, 7, 9)] <- TRUE
    expect_equal(buf[c(1, 3, 5, 7, 9)], rep(TRUE, 5))
    expect_equal(buf[c(2, 4, 6, 8, 10)], rep(FALSE, 5))
    buffer_close(buf)
})

test_that("buffer handles single-element dimension", {
    # Single-element double buffer
    buf <- buffer("double", dim = 1)
    expect_equal(buf$n, 1)
    expect_equal(length(buf), 1)
    expect_equal(buf[], 0)

    buf[1] <- 42
    expect_equal(buf[1], 42)
    expect_equal(buf[], 42)
    buffer_close(buf)

    # Single-element integer buffer
    buf <- buffer("integer", dim = 1)
    buf[1] <- 99L
    expect_equal(buf[1], 99L)
    buffer_close(buf)

    # Single-element logical buffer
    buf <- buffer("logical", dim = 1)
    expect_equal(buf[1], FALSE)
    buf[1] <- TRUE
    expect_equal(buf[1], TRUE)
    buffer_close(buf)
})

test_that("buffer handles 1x1 matrix dimension", {
    buf <- buffer("double", dim = c(1, 1))
    expect_equal(dim(buf), c(1, 1))
    expect_equal(length(buf), 1)

    buf[1, 1] <- 42
    expect_equal(buf[1, 1], 42)
    expect_equal(buf[], matrix(42, 1, 1))

    buffer_close(buf)
})