tests/testthat/test-aaa_class.R

In artoo: Lossless CDISC-Native Input and Output for Clinical Datasets

# Tests for the S7 classes and their validators.

test_that("artoo_meta accepts CDISC dataTypes and a valid key set", {
  m <- artoo:::artoo_meta_class(
    dataset = list(name = "DM", keys = "USUBJID"),
    columns = list(USUBJID = list(dataType = "string"))
  )
  expect_true(S7::S7_inherits(m, artoo:::artoo_meta_class))
})

test_that("artoo_meta rejects a non-CDISC dataType", {
  expect_error(
    artoo:::artoo_meta_class(
      columns = list(AGE = list(dataType = "widget"))
    ),
    "non-CDISC"
  )
})

test_that("artoo_meta rejects keys that name unknown columns", {
  expect_error(
    artoo:::artoo_meta_class(
      dataset = list(keys = "MISSING"),
      columns = list(AGE = list(dataType = "integer"))
    ),
    "unknown column"
  )
})

test_that("artoo_meta rejects a non-CDISC targetDataType", {
  expect_error(
    artoo:::artoo_meta_class(
      columns = list(
        AGE = list(dataType = "integer", targetDataType = "widget")
      )
    ),
    "non-CDISC targetDataType"
  )
})

test_that("artoo_meta rejects a non-integer length or keySequence", {
  expect_error(
    artoo:::artoo_meta_class(
      columns = list(AGE = list(dataType = "integer", length = "ten"))
    ),
    "non-integer length"
  )
  expect_error(
    artoo:::artoo_meta_class(
      columns = list(AGE = list(dataType = "integer", keySequence = "1"))
    ),
    "non-integer keySequence"
  )
})

test_that("artoo_meta rejects a name field that disagrees with its list key", {
  expect_error(
    artoo:::artoo_meta_class(
      columns = list(AGE = list(name = "SEX", dataType = "integer"))
    ),
    "mismatched name"
  )
})

test_that("the closed CDISC vocabularies are exactly the spec set", {
  expect_setequal(
    artoo:::.cdisc_datatypes,
    c(
      "string",
      "integer",
      "decimal",
      "float",
      "double",
      "boolean",
      "date",
      "datetime",
      "time",
      "URI"
    )
  )
  expect_setequal(artoo:::.cdisc_targettypes, c("integer", "decimal"))
})

# ---- mutation safety: @<- re-validates (pinning test) -----------------------

test_that("property mutation re-runs the validator (no silent corruption)", {
  spec <- artoo_spec(
    cdisc_sdtm_datasets,
    cdisc_sdtm_variables,
    codelists = cdisc_codelists
  )
  # A wrong property type is refused by the S7 property check.
  expect_error(spec@datasets <- "not a frame")
  # Get-modify-set of a value INSIDE a slot re-fires the cross-slot
  # validator: breaking referential integrity is impossible via @<-.
  expect_error(
    spec@datasets$dataset[1] <- "ZZZ",
    "variables reference dataset"
  )
  # The object is untouched after the failed mutations.
  expect_identical(spec@datasets$dataset, cdisc_sdtm_datasets$dataset)
})