Nothing
context("transactions")
test_that("methods", {
expect_object_docs(R6_mdb_txn)
})
test_that("begin/abort", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
expect_is(txn, "mdb_txn")
expect_equal(mode(txn$.ptr), "externalptr")
expect_identical(txn$.env, env)
expect_identical(txn$.db, env$.db)
expect_identical(env$.deps$get(), list(env$.db, txn))
expect_identical(env$.write_txn, txn$.ptr)
expect_true(txn$.write)
expect_identical(txn$.db$id(), 1L)
expect_identical(txn$id(), 1L)
expect_identical(txn$stat(), env$stat())
ptr <- txn$.ptr
txn$abort()
rm(txn)
gc()
expect_true(is_null_pointer(ptr))
expect_identical(env$.deps$get(), list(env$.db))
expect_null(env$.write_txn)
env$close()
})
test_that("basic use", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
expect_null(txn$put("foo", "bar"))
expect_identical(txn$get("foo"), "bar")
txn$commit()
expect_identical(env$.deps$get(), list(env$.db))
expect_null(env$.write_txn)
txn <- env$begin(write = FALSE)
expect_identical(txn$get("foo"), "bar")
txn$abort()
})
test_that("concurent read", {
env <- mdb_env(tempfile())
w1 <- env$begin(write = TRUE)
expect_null(w1$put("foo", "bar"))
expect_identical(w1$get("foo"), "bar")
w1$commit()
r1 <- env$begin(write = FALSE)
expect_identical(r1$get("foo"), "bar")
w2 <- env$begin(write = TRUE)
expect_identical(r1$get("foo"), "bar")
expect_null(w2$put("foo", "xyx"))
expect_identical(w2$get("foo"), "xyx")
expect_identical(r1$get("foo"), "bar")
r2 <- env$begin(write = FALSE)
expect_identical(r2$get("foo"), "bar")
w2$commit()
expect_identical(r1$get("foo"), "bar")
expect_identical(r2$get("foo"), "bar")
r3 <- env$begin(write = FALSE)
expect_identical(r3$get("foo"), "xyx")
env$close()
})
test_that("get: missing", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
expect_null(txn$get("foo", FALSE))
expect_error(txn$get("foo", TRUE),
"Key 'foo' not found in database")
expect_null(txn$put("foo", "bar"))
expect_identical(txn$get("foo", FALSE), "bar")
expect_identical(txn$get("foo", TRUE), "bar")
env$close()
})
test_that("get: string raw handling", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
txn$put("foo", "bar")
expect_identical(txn$get("foo", as_raw = NULL), "bar")
expect_identical(txn$get("foo", as_raw = FALSE), "bar")
expect_identical(txn$get("foo", as_raw = TRUE), charToRaw("bar"))
})
test_that("get: raw raw handling", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
bytes <- as.raw(c(1, 51, 0, 242))
txn$put("foo", bytes)
expect_identical(txn$get("foo", as_raw = NULL), bytes)
expect_identical(txn$get("foo", as_raw = TRUE), bytes)
expect_error(txn$get("foo", as_raw = FALSE),
"value contains embedded nul bytes; cannot return string")
p <- txn$get("foo", as_proxy = TRUE)
expect_identical(p$data(as_raw = NULL), bytes)
expect_identical(p$data(as_raw = NULL), bytes)
})
test_that("get: raw key", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
key <- as.raw(c(1, 51, 0, 242))
value <- "hello world"
expect_error(txn$get(key), "Key not found in database")
expect_null(txn$get(key, FALSE))
p <- txn$get(key, missing_is_error = FALSE, as_proxy = TRUE)
expect_is(p, "mdb_val_proxy")
expect_null(p$data())
expect_identical(p$size(), 0L)
txn$put(key, value)
expect_false(p$is_valid())
expect_error(p$data(),
"mdb_val_proxy is invalid: transaction has modified database")
expect_error(p$size(),
"mdb_val_proxy is invalid: transaction has modified database")
p <- txn$get(key, as_proxy = TRUE)
expect_is(p, "mdb_val_proxy")
expect_identical(p$data(), value)
expect_identical(p$size(), nchar(value))
## These are all done twice to stamp out possible corner cases:
expect_identical(p$data(FALSE), value)
expect_identical(p$data(FALSE), value)
expect_identical(p$data(NULL), value)
expect_identical(p$data(NULL), value)
expect_identical(p$data(TRUE), charToRaw(value))
expect_identical(p$data(TRUE), charToRaw(value))
## And again, but with different values first, to deal with how this
## is constructed.
p <- txn$get(key, as_proxy = TRUE)
expect_identical(p$data(TRUE), charToRaw(value))
expect_identical(p$data(TRUE), charToRaw(value))
expect_identical(p$data(FALSE), value)
expect_identical(p$data(NULL), value)
txn$put(key, key)
expect_false(p$is_valid())
expect_error(p$data(),
"mdb_val_proxy is invalid: transaction has modified database")
expect_error(p$size(),
"mdb_val_proxy is invalid: transaction has modified database")
p <- txn$get(key, as_proxy = TRUE)
expect_error(p$data(FALSE),
"value contains embedded nul bytes; cannot return string")
expect_identical(p$size(), length(key))
expect_identical(p$data(), key)
expect_identical(p$data(TRUE), key)
})
test_that("get: proxy", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
value <- "bar"
expect_null(txn$put("foo", value))
p1 <- txn$get("foo", as_proxy = TRUE)
expect_is(p1, "mdb_val_proxy")
expect_identical(p1$size(), 3L)
expect_identical(p1$data(), value)
expect_identical(p1$data(TRUE), charToRaw(value))
expect_true(p1$is_valid())
## Let's do an update which should invalidate the proxy:
txn$put("another", "key")
expect_false(p1$is_valid())
expect_error(p1$data(),
"mdb_val_proxy is invalid: transaction has modified database")
## Then again:
p2 <- txn$get("another", as_proxy = TRUE)
expect_identical(p2$data(), "key")
## But this time we invalidate the transaction:
txn$commit()
expect_false(p2$is_valid())
expect_error(p2$data(),
"mdb_val_proxy is invalid: transaction has been closed")
})
test_that("transaction caching", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
for (i in letters) {
txn$put(i, toupper(i))
}
txn$commit()
expect_identical(env$.spare_txns$get(), list())
txn <- env$begin(write = FALSE)
txn_ptr <- txn$.ptr
expect_equal(txn$get("g"), "G")
txn$abort()
expect_identical(env$.spare_txns$get(), list(txn_ptr))
expect_null(txn$.ptr)
expect_error(txn$get("a"), "txn has been cleaned up")
txn2 <- env$begin(write = FALSE)
expect_identical(env$.spare_txns$get(), list())
expect_identical(txn2$.ptr, txn_ptr)
expect_equal(txn2$get("g"), "G")
txn2$abort(FALSE)
expect_identical(env$.spare_txns$get(), list())
expect_true(is_null_pointer(txn_ptr))
})
test_that("del", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
for (i in letters) {
txn$put(i, toupper(i))
}
expect_true(txn$del("a"))
expect_false(txn$del("a"))
env$close()
})
test_that("exists", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
for (i in letters) {
txn$put(i, toupper(i))
}
expect_true(txn$exists("a"))
expect_false(txn$exists("A"))
expect_identical(txn$exists(character(0)), logical(0))
expect_identical(txn$exists(letters), rep(TRUE, length(letters)))
env$close()
})
test_that("replace", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
for (i in letters) {
txn$put(i, toupper(i))
}
expect_equal(txn$replace("g", "giraffe"), "G")
expect_equal(txn$get("g"), "giraffe")
})
test_that("pop", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
for (i in letters) {
txn$put(i, toupper(i))
}
expect_equal(txn$pop("g"), "G")
expect_null(txn$pop("g"))
})
test_that("cmp", {
env <- mdb_env(tempfile())
txn <- env$begin(write = FALSE)
expect_identical(txn$cmp("a", "b"), -1L)
expect_identical(txn$cmp("b", "a"), 1L)
expect_identical(txn$cmp("a", "a"), 0L)
})
test_that("drop; invalidate as we go", {
env <- mdb_env(tempfile(), maxdbs = 10)
db2 <- env$open_database("foo")
expect_identical(db2$id(), 2L)
txn <- env$begin(db = db2, write = TRUE)
for (i in letters) {
txn$put(i, toupper(i))
}
txn$commit()
txn_read <- env$begin(db = db2)
expect_identical(txn_read$get("a"), "A")
cur <- txn_read$cursor()
cur$move_to("g")
p <- cur$value(as_proxy = TRUE)
env$drop_database(db2)
expect_false(p$is_valid())
expect_null(cur$.ptr)
expect_null(txn_read$.ptr)
expect_null(db2$.ptr)
expect_error(cur$first(), "cursor has been cleaned up; can't use!")
expect_error(txn_read$cursor(), "txn has been cleaned up; can't use!")
expect_error(db2$id(), "dbi has been cleaned up; can't use")
expect_identical(env$.deps$get(), list(env$.db))
expect_null(txn_read$.deps)
expect_error(env$open_database("foo", create = FALSE),
"MDB_NOTFOUND")
})
test_that("drop but no delete", {
env <- mdb_env(tempfile(), maxdbs = 10)
db2 <- env$open_database("foo")
expect_identical(db2$id(), 2L)
txn <- env$begin(db = db2, write = TRUE)
for (i in letters) {
txn$put(i, toupper(i))
}
txn$commit()
txn_read <- env$begin(db = db2)
expect_identical(txn_read$get("a"), "A")
cur <- txn_read$cursor()
cur$move_to("g")
p <- cur$value(as_proxy = TRUE)
env$drop_database(db2, FALSE)
expect_false(p$is_valid())
expect_null(cur$.ptr)
expect_null(txn_read$.ptr)
expect_null(db2$.ptr)
expect_error(cur$first(), "cursor has been cleaned up; can't use!")
expect_error(txn_read$cursor(), "txn has been cleaned up; can't use!")
expect_error(db2$id(), "dbi has been cleaned up; can't use")
db3 <- env$open_database("foo", create = FALSE)
txn_read2 <- env$begin(db = db3)
expect_null(txn_read2$get("a", FALSE))
})
test_that("drop; root database", {
env <- mdb_env(tempfile(), maxdbs = 10)
db <- env$open_database()
expect_error(env$drop_database(db), "Can't delete root database")
})
test_that("drop; other environment's database", {
env1 <- mdb_env(tempfile(), maxdbs = 10)
env2 <- mdb_env(tempfile(), maxdbs = 10)
db1 <- env1$open_database("foo")
db2 <- env2$open_database("foo")
expect_error(env2$drop_database(db1),
"this is not our database")
})
test_that("serialisation does not crash", {
env <- mdb_env(tempfile())
txn <- env$begin()
expect_false(is_null_pointer(txn$.ptr))
txn2 <- unserialize(serialize(txn, NULL))
expect_true(is_null_pointer(txn2$.ptr))
expect_error(txn2$id(), "txn has been freed; can't use")
})
test_that("with_new_txn", {
env <- mdb_env(tempfile())
expect_error(with_new_txn(env, TRUE, function(t) stop("banana")), "banana")
expect_null(env$.write_txn)
txn <- env$begin(write = TRUE)
expect_error(with_new_txn(env, TRUE, function(t) 1),
"Write transaction is already active for this environment")
txn$put("a", "apple")
txn$commit()
txn <- env$begin(write = TRUE)
db_ptr <- env$.db$.ptr
expect_equal(with_new_txn(env, FALSE, function(t)
mdb_get(t, db_ptr, "a", FALSE, FALSE, FALSE)), "apple")
expect_error(with_new_txn(env, FALSE, function(t) stop("banana")), "banana")
})
test_that("list", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
cur <- txn$cursor()
expect_identical(thor_list(cur$.ptr, NULL, FALSE, 10L), character(0))
for (i in letters) {
txn$put(i, toupper(i))
}
expect_identical(txn$list(as_raw = FALSE), letters)
expect_identical(txn$list(as_raw = TRUE), lapply(letters, charToRaw))
expect_identical(txn$list(as_raw = NULL), as.list(letters))
txn$abort()
## Then with some raw bytes:
v <- as.list(letters)
v[[15]] <- c(charToRaw(v[[15]]), as.raw(c(0, 255, 6)))
txn <- env$begin(write = TRUE)
for (i in v) {
txn$put(i, i)
}
cur <- txn$cursor()
vv <- lapply(v, function(x) if (is.raw(x)) x else charToRaw(x))
expect_identical(txn$list(as_raw = TRUE), vv)
expect_identical(txn$list(as_raw = NULL), v)
expect_error(txn$list(),
"value contains embedded nul bytes; cannot return string")
})
test_that("list & filter", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
cur <- txn$cursor()
txn$put("apple", "1")
txn$put("ape", "1")
txn$put("avocado", "1")
txn$put("banana", "1")
txn$put("pear", "1")
expect_identical(txn$list("a"), c("ape", "apple", "avocado"))
expect_identical(txn$list("ap"), c("ape", "apple"))
expect_identical(txn$list("app"), "apple")
expect_identical(txn$list("b"), "banana")
expect_identical(txn$list("c"), character(0))
expect_identical(txn$list(""), c("ape", "apple", "avocado", "banana", "pear"))
## More esoteric options:
expect_identical(txn$list("a", size = 1L), c("ape", "apple", "avocado"))
expect_identical(txn$list("a", size = 10L), c("ape", "apple", "avocado"))
expect_identical(txn$list("a", as_raw = TRUE, size = 1L),
lapply(c("ape", "apple", "avocado"), charToRaw))
expect_identical(txn$list("a", as_raw = TRUE, size = 10L),
lapply(c("ape", "apple", "avocado"), charToRaw))
expect_identical(txn$list("a", as_raw = NULL, size = 1L),
as.list(c("ape", "apple", "avocado")))
expect_identical(txn$list("a", as_raw = NULL, size = 10L),
as.list(c("ape", "apple", "avocado")))
})
test_that("mget", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
for (i in letters) {
txn$put(i, toupper(i))
}
txn$commit()
txn <- env$begin(write = FALSE)
## as_raw = NULL
expect_identical(txn$mget(character(0)), list())
expect_identical(txn$mget("a"), list("A"))
expect_identical(txn$mget(c("a", "b")), list("A", "B"))
expect_identical(txn$mget(c("a", "xyz", "b")), list("A", NULL, "B"))
## as_raw = FALSE
expect_identical(txn$mget(character(0), as_raw = FALSE), character(0))
expect_identical(txn$mget("a", as_raw = FALSE), "A")
expect_identical(txn$mget(c("a", "b"), as_raw = FALSE), c("A", "B"))
expect_identical(txn$mget(c("a", "xyz", "b"), as_raw = FALSE), c("A", "", "B"))
## TODO: decide if "" or NA is better to return in this case.
## as_proxy = TRUE
expect_identical(txn$mget(character(0), as_proxy = TRUE), list())
p <- txn$mget("a", as_proxy = TRUE)
expect_is(p, "list")
expect_equal(lapply(p, function(el) el$data()), list("A"))
p <- txn$mget(c("a", "b"), as_proxy = TRUE)
expect_is(p, "list")
expect_equal(lapply(p, function(el) el$data()), list("A", "B"))
p <- txn$mget(c("a", "xyz", "b"), as_proxy = TRUE)
expect_is(p, "list")
expect_equal(lapply(p, function(el) el$data()), list("A", NULL, "B"))
})
test_that("mget: raw keys", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
for (i in letters) {
txn$put(i, toupper(i))
}
txn$commit()
txn <- env$begin(write = FALSE)
expect_equal(txn$mget(charToRaw("a")), list("A"))
expect_equal(txn$mget(charToRaw("abc")), list(NULL))
expect_equal(txn$mget(as.list(charToRaw("abc"))), list("A", "B", "C"))
})
test_that("mget: invalid input", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
expect_error(txn$mget(1), "Invalid type; expected a character or raw vector")
})
test_that("mput: basic", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
expect_null(txn$mput(character(0), character(0)))
expect_null(txn$mput(letters, LETTERS))
expect_identical(txn$mget(letters, as_raw = FALSE), LETTERS)
})
test_that("mput: lengths", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
expect_error(txn$mput("a", letters),
"Expected 1 values but recieved 26")
expect_error(txn$mput("a", as.list(letters)),
"Expected 1 values but recieved 26")
expect_error(txn$mput(list("a"), letters),
"Expected 1 values but recieved 26")
expect_error(txn$mput(list(charToRaw("a")), letters),
"Expected 1 values but recieved 26")
expect_error(txn$mput(charToRaw(paste(letters, collapse = "")), letters),
"Expected 1 values but recieved 26")
})
test_that("mput: atomicity", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
## Test that a failure part way along the extraction causes the
## entire insertion to fail atomically.
v1 <- letters[1:5]
v2 <- c(letters[c(6:10, 4, 11:20)])
txn$mput(v1, toupper(v1))
expect_error(txn$mput(v2, v2, overwrite = FALSE), "MDB_KEYEXIST")
expect_identical(txn$mget(v1, as_raw = FALSE), toupper(v1))
cmp <- txn$mget(v2, as_raw = FALSE)
expect_identical(cmp, ifelse(v2 %in% v1, toupper(v2), ""))
})
test_that("mdel", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
txn$mput(letters, LETTERS)
expect_identical(txn$mdel(letters), rep(TRUE, length(letters)))
expect_identical(txn$mdel(letters), rep(FALSE, length(letters)))
expect_identical(txn$mdel(character(0)), logical(0))
expect_identical(txn$mdel(list()), logical(0))
v <- sample(letters, 12)
txn$mput(v, toupper(v))
expect_identical(txn$mdel(letters), letters %in% v)
})
test_that("mdel: atomic", {
env <- mdb_env(tempfile())
txn <- env$begin(write = TRUE)
txn$mput(letters, LETTERS)
v <- c(letters[1:5], "", letters[6:10])
expect_error(txn$mdel(v), "MDB_BAD_VALSIZE")
expect_identical(txn$mget(letters, as_raw = FALSE), LETTERS)
})
test_that("format", {
env <- mdb_env(tempfile())
txn <- env$begin()
str <- format(txn)
expect_false(grepl("initialze", str))
expect_true(grepl("<mdb_txn>", str, fixed = TRUE))
expect_true(grepl("cursor", str, fixed = TRUE))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.