tests/testthat/test-spec_validate.R

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

# Tests for the S7 validators (.validate_slot, .spec_validate) reached
# directly and via the bare class, to exercise the last-line-of-defence
# branches the friendly constructor normally short-circuits.

# A complete-schema one-row variables table, for bare-class construction.
full_var <- function(
  dataset = "DM",
  data_type = "string",
  target_data_type = NA_character_,
  codelist_id = NA_character_
) {
  data.frame(
    dataset = dataset,
    variable = "X",
    itemoid = NA_character_,
    label = "X",
    data_type = data_type,
    target_data_type = target_data_type,
    length = NA_integer_,
    display_format = NA_character_,
    key_sequence = NA_integer_,
    order = NA_integer_,
    codelist_id = codelist_id,
    mandatory = NA,
    significant_digits = NA_integer_,
    origin = NA_character_,
    stringsAsFactors = FALSE
  )
}

test_that(".validate_slot skips an uninitialised slot", {
  expect_identical(
    artoo:::.validate_slot(
      data.frame(),
      artoo:::.spec_cols_datasets,
      "dataset",
      "datasets"
    ),
    character(0)
  )
})

test_that(".validate_slot flags a missing required column", {
  out <- artoo:::.validate_slot(
    data.frame(x = 1),
    artoo:::.spec_cols_datasets,
    "dataset",
    "datasets"
  )
  expect_match(out, "missing required column", all = FALSE)
})

test_that(".validate_slot flags a wrong-type column", {
  out <- artoo:::.validate_slot(
    data.frame(dataset = "DM", label = 1L),
    artoo:::.spec_cols_datasets,
    "dataset",
    "datasets"
  )
  expect_match(out, "must be character", all = FALSE)
})

test_that("the S7 validator rejects a non-CDISC data_type (bare class)", {
  expect_error(
    artoo:::artoo_spec_class(
      datasets = data.frame(dataset = "DM", stringsAsFactors = FALSE),
      variables = full_var(data_type = "widget")
    ),
    "non-CDISC"
  )
})

test_that("the S7 validator rejects a bad target_data_type (bare class)", {
  expect_error(
    artoo:::artoo_spec_class(
      datasets = data.frame(dataset = "DM", stringsAsFactors = FALSE),
      variables = full_var(target_data_type = "bogus")
    ),
    "target_data_type"
  )
})

test_that("the S7 validator rejects an orphan dataset reference (bare class)", {
  expect_error(
    artoo:::artoo_spec_class(
      datasets = data.frame(dataset = "OTHER", stringsAsFactors = FALSE),
      variables = full_var(dataset = "DM")
    ),
    "not in"
  )
})

test_that("the S7 validator rejects an unresolved codelist (bare class)", {
  expect_error(
    artoo:::artoo_spec_class(
      datasets = data.frame(dataset = "DM", stringsAsFactors = FALSE),
      variables = full_var(codelist_id = "C9")
    ),
    "unresolved codelist"
  )
})

test_that("the S7 validator rejects duplicate (dataset, variable) rows directly", {
  # Last line of defence behind the friendly constructor: building the S7
  # class directly with duplicates must still fail.
  vars <- data.frame(
    dataset = c("DM", "DM"),
    variable = c("SEX", "SEX"),
    data_type = c("string", "string"),
    stringsAsFactors = FALSE
  )
  expect_error(
    artoo:::artoo_spec_class(
      study = data.frame(),
      datasets = data.frame(dataset = "DM", stringsAsFactors = FALSE),
      variables = vars,
      codelists = data.frame(),
      methods = data.frame(),
      comments = data.frame(),
      documents = data.frame(),
      values = NULL
    ),
    regexp = "duplicate"
  )
})

test_that("the meta validator rejects an unnamed columns list", {
  expect_error(
    artoo:::artoo_meta_class(
      dataset = list(itemGroupOID = "IG.X", name = "X"),
      columns = list(list(name = "A", dataType = "string"))
    ),
    regexp = "named list"
  )
})