it("expects valid input: relation_schemas is a relation_schema", {
it("expects valid input: unique schema names", {
"^relation schema names must be unique: duplicated a$"
it("expects valid input: non-empty schema names", {
"^relation schema names must be non-empty"
database_schema(rs, list(list("r3", "b", "r4", "b"))),
"^reference relation names must be within relation schema names: absent r4$"
database_schema(rs, list(list("r4", "b", "r3", "b"))),
it("expects valid input: reference attributes are within referrer's attributes, make one of referee's keys", {
# must exactly match a key, not just be contained in one
relation_schema(list(a = list(c("a", "b"), list("a"))), c("a", "b")),
it("returns the relation_schema, with the additional attributes unmodified", {
with_args(do.call, what = database_schema) %>>% subschemas
gen.database_schema(letters[1:6], 0, 8, same_attr_name = san)
gen.sample_resampleable(c(FALSE, TRUE), of = length(lst[[2]]))
tryCatch(ds[[ineg]], error = function(e) e$message),
tryCatch(ds[[ints[[ineg]]]], error = function(e) e$message)
preserves_attributes_when_subsetting <- function(ds, indices, op) {
gen.database_schema(letters[1:6], 0, 8, same_attr_name = FALSE) |>
indices = gen.sample_resampleable(seq_along(ds), from = 0, to = length(ds))
gen.database_schema(letters[1:6], 1, 8, same_attr_name = FALSE) |>
keeps_relevant_references <- function(ds, indices, op) {
indices = gen.sample(seq_along(ds), replace = FALSE)
indices = gen.sample_resampleable(seq_along(ds), from = 2, to = 2*length(ds))
if (!anyDuplicated(indices) || length(references(ds)) == 0)
expected <- subset_refs(orig, indices, names(ds), names(ds_new))
it("expects a database_schema value for subset re-assignment", {
expect_error(ds[1] <- 1L, "^value must also be a database_schema object$")
expect_error(ds[[1]] <- 1L, "^value must also be a database_schema object$")
expect_error(ds$X <- 1L, "^value must also be a database_schema object$")
gen.ds_reassignment_indices_format <- function(ds, subseq) {
weights <- rep(1L, 3L + (length(subseq) < length(ds)))
expect_ds_subset_reassignment_success <- function(ds, indices, value) {
gen.ds_single_reassignment_indices_format <- function(ds, subseq) {
2L + (length(ds) == 2) + (length(ds) == 1)
gen.sample(seq_along(ds), 2, replace = FALSE),
if (length(ds) > 1) list(gen.ds_single_reassignment_failure_multiint(ds))
weights <- c(70, 15, if (length(ds) > 1) 15)
expect_ds_subset_single_reassignment_success <- function(ds, ind, value) {
expect_ds_subset_single_exact_reassignment_success <- function(ds, ind, value) {
eval(parse(text = paste0("ds$", ind, " <- value"))),
it("is made unique to a valid database schema", {
unique(ds) |> is_valid_database_schema(unique = TRUE, same_attr_name = san)
gen.database_schema(letters[1:3], 0, 8, same_attr_name = FALSE) |>
it("concatenates to a valid database schema", {
gen.database_schema(letters[1:6], 0, 8, same_attr_name = san) |>
\(san, dss) do.call(c, dss) |> is_valid_database_schema(same_attr_name = san),
it("can have empty-key schemas merged", {
if (sum(vapply(keys(ds), identical, logical(1), list(character()))) <= 1)
it("is composed of its attrs(), keys(), names(), attrs_order(), and references()", {
gen.database_schema(letters[1:6], 0, 8, same_attr_name = FALSE),
it("is composed of its subschemas() and references()", {
gen.database_schema(letters[1:6], 0, 8, sek, san, skp)
"database schema with 0 relation schemas",
"database schema with 2 relation schemas",
"schema b: b, c\\n  key 1: b\\n  key 2: c",
expect_no_error(tb <- data.frame(id = 1:2, schema = ds))