context("record-index")
test_that("rename fields", {
x <- record(a = 7, b = 12, c = "hello")
expect_equal(x[c(z = 1, y = 2)], record(z = 7, y = 12))
})
#test_that("rename invalid", {
# x <- record(a = 7, b = 12, c = "hello")
# nm <- "fa\xE7ile"
# Encoding(nm) <- "UTF-8"
# i <- 2
# names(i) <- nm
# expect_error(x[i]) #, "^encoding error: replacement name entry 1")
#})
test_that("rank-3 array", {
x <- record(a = 7, b = 12, c = "hello")
expect_error(x[array(1, c(1, 1, 1))],
"subscript is a rank-3 array")
})
test_that("numeric object", {
x <- c.record(1:10, a = "aaa")
i <- as.hexmode(10)
expect_equal(x[[i]], x[[10]])
expect_equal(x[i], x[10])
})
test_that("numeric NA", {
x <- record(1)
expect_error(x[NA_real_], "numeric subscript contains an NA value")
})
test_that("mixed sign", {
x <- record(1)
expect_error(x[c(0, -1, 1)],
"numeric subscript contains both positive and negative values")
expect_error(x[c(1, -1, 0)],
"numeric subscript contains both positive and negative values")
})
test_that("out-of-bounds", {
x <- record(1)
#expect_equal(x[2], as.record(structure(list(NULL), names = "")))
expect_error(x[2], "bounds error: index is 2, maximum is 1")
})
test_that("wrong length logical mask", {
x <- record(1, 2, 3, 4)
i <- c(TRUE, FALSE)
expect_error(x[i], "mismatch: logical subscript length is 2, should be 4")
})
test_that("unknown name", {
x <- record(aa = 1)
#expect_equal(x["a"], record(a = NULL))
expect_error(x["a"], "unknown name \"a\"")
})
test_that("factor index", {
x <- record(a = 5, b = 4, c = 3)
i <- factor("b")
expect_equal(x[i], record(b = 4))
})
test_that("$", {
x <- record(a = 1, b = 13, cc = 10)
expect_equal(x$b, 13)
})
test_that("$<- existing", {
x <- record(a = 1, b = 13, cc = 10)
x$b <- "foo"
expect_equal(x, record(a = 1, b = "foo", cc = 10))
})
test_that("$<- new", {
x <- record(a = 1, b = 13, cc = 10)
x$c <- "foo"
expect_equal(x, record(a = 1, b = 13, cc = 10, c = "foo"))
})
test_that("NULL, missing index", {
x <- record(a = 1, b = 17)
expect_equal(x[NULL], x)
expect_equal(x[], x[NULL])
})
test_that("negative idnex", {
x <- record(a = 1, b = 17, c = 2, d = 19)
expect_equal(x[c(-9, -2, -3, -2)], x[c(1, 4)])
})
test_that("logical index", {
x <- record(a = 1, b = 17, c = 2, d = 19)
expect_equal(x[c(TRUE, TRUE, FALSE, FALSE)], x[c(1, 2)])
})
test_that("logical object", {
x <- record(a = 1, b = 17, c = 2, d = 19)
i <- structure(c(foo = TRUE, FALSE, bar = TRUE, FALSE), class = "foo")
expect_equal(x[i], x[c(foo = 1, bar = 3)])
})
test_that("nested assign", {
x <- record(a = 1, b = list("foo", "bar", "baz"), c = 18, d = -9)
x[[c(2, 3)]] <- "!!"
y <- record(a = 1, b = list("foo", "bar", "!!"), c = 18, d = -9)
expect_equal(x, y)
})
test_that("list assign", {
x <- record(a = 1, b = 2)
x[[1]] <- list(1, 2, 3)
expect_equal(x, record(a = list(1, 2, 3), b = 2))
})
test_that("field assign NULL", {
x <- record(a = 1, b = 2, c = 3)
x[[2]] <- NULL
expect_equal(x, record(a = 1, b = NULL, c = 3))
})
test_that("nested delete", {
x <- record(a = 1, b = list("foo", "bar", "baz"), c = 18, d = -9)
x[[c(2, 3)]] <- NULL
y <- record(a = 1, b = list("foo", "bar"), c = 18, d = -9)
expect_equal(x, y)
})
test_that("delete all", {
x <- record(a = 1, b = 77, c = "foo")
y <- x
x[NULL] <- NULL
y[] <- NULL
r <- record(); names(r) <- character()
expect_equal(x, r)
expect_equal(y, x)
})
test_that("set NULL by name", {
x <- record(a = 1, b = 77, c = "foo")
x[c("a", "b")] <- NULL
expect_equal(x, record(c = "foo"))
})
test_that("replace wrong number", {
x <- record(a = 1, b = 2, c = 3, d = 4)
expect_error(x[NULL] <- c(100, 101),
"mismatch: replacement has 2 entries, should have 4")
})
test_that("replace with 0", {
x <- record(a = 1, b = 2, c = 3, d = 4)
x[c(0, 0, 1)] <- 300
expect_equal(x, record(a = 300, b = 2, c = 3, d = 4))
})
test_that("rename replace", {
x <- record(a = 1)
x[c(b = 1)] <- 2
expect_equal(x, record(b = 2))
})
test_that("rename repeat replace", {
x <- record(a = 1)
x[c(b = 1, c = 1)] <- c(2, 3)
expect_equal(x, record(c = 3))
})
test_that("rename implicit replace", {
x <- record(a = 1)
x[c(b = 1, 1)] <- c(2, 3)
expect_equal(x, record(b = 3))
})
test_that("replace empty names", {
x <- record(a = 1)
i <- c(1, 1)
names(i) <- c("", "")
x[i] <- c(2, 3)
expect_equal(x, record(a = 3))
})
test_that("select, rename one", {
x <- record(a = 10, b = 2)
y <- x[c("z" = 1, 1)]
expect_equal(y, record(z = 10, a = 10))
})
test_that("repeated new name", {
x <- record(a = 1)
x[c("b", "b")] <- c(10, 20)
expect_equal(x, record(a = 1, b = 20))
})
#test_that("invalid name", {
# x <- record(a = 2)
# i <- "fa\xE7ile"; Encoding(i) <- "UTF-8"
# expect_error(x[[i]] <- 2) #, "^encoding error: index entry 1")
#})
test_that("rename by character", {
x <- record(a = 1, b = 2, c = 3)
expect_equal(x[c("x" = "a", "b", "y" = "b")],
record(x = 1, b = 2, y = 2))
})
test_that("extend", {
x <- record(a = 1)
x[[2]] <- 7
y <- as.record(list(a = 1, 7))
expect_equal(x, y)
})
test_that("unknown NA", {
x <- record(a = 1)
expect_error(x[NA_character_], "unknown name <NA>")
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.