tests/testthat/test-data-checks.R

In wjakethompson/measr: Bayesian Psychometric Measurement Using 'Stan'

test_that("check_model", {
  err <- rlang::catch_cnd(check_model("a", "measrdcm", name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "object with class measrdcm")

  err <- rlang::catch_cnd(check_model(3, "new_class", name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "object with class new_class")

  test_obj <- c(3, 4, 5)
  class(test_obj) <- "newclass"
  err <- rlang::catch_cnd(check_model(test_obj, "newclass", name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "object with class newclass")

  test_obj <- list(list(1, 2, 3), list(4, 5, 6))
  class(test_obj[[1]]) <- "newclass"
  err <- rlang::catch_cnd(check_model(test_obj, "newclass", name = "check1",
                                      list = TRUE))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "only contain objects with class newclass")

  test_obj <- list(3, 4, 5, c(6, 7, 8))
  class(test_obj) <- "newclass"
  expect_equal(check_model(test_obj, "newclass", name = "check1"), test_obj)

  test_obj <- list(list(1, 2, 3), list(4, 5, 6))
  class(test_obj[[1]]) <- "newclass"
  class(test_obj[[2]]) <- "newclass"
  expect_equal(lapply(test_obj, check_model, required_class = "newclass",
                      name = "check1", list = TRUE),
               test_obj)
})

test_that("check_data", {
  dat <- utils::combn(letters, m = 3) %>%
    as.data.frame() %>%
    tidyr::pivot_longer(cols = everything()) %>%
    dplyr::group_by(name) %>%
    dplyr::summarize(student = paste(value, collapse = "")) %>%
    dplyr::select(-name) %>%
    dplyr::mutate(item = 1) %>%
    tidyr::complete(student, item = 1:20) %>%
    dplyr::mutate(score = sample(c(0, 1), size = dplyr::n(),
                                 replace = TRUE)) %>%
    tidyr::pivot_wider(names_from = item, values_from = score)

  err <- rlang::catch_cnd(check_data("a", identifier = NULL,
                                     missing = NA, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "data frame")

  err <- rlang::catch_cnd(check_data(dat, identifier = NULL,
                                     missing = NA, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "0 or 1 for non-missing scores")

  dat2 <- dplyr::mutate(dat, `3` = sample(1:3, size = dplyr::n(),
                                          replace = TRUE))
  err <- rlang::catch_cnd(check_data(dat2, identifier = "student",
                                     missing = NA, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "only 0 or 1 for non-missing scores")

  dat_check <- dat %>%
    tidyr::pivot_longer(-student, names_to = "item_id", values_to = "score") %>%
    dplyr::mutate(resp_id = factor(student, levels = unique(student)),
                  item_id = factor(item_id, levels = 1:20),
                  score = as.integer(score)) %>%
    dplyr::select(resp_id, item_id, score)
  expect_equal(check_data(dat, identifier = "student", missing = NA,
                          name = "x"),
               dat_check)
  expect_equal(check_data(as.data.frame(dat), identifier = "student",
                          missing = NA, name = "x"),
               dat_check)

  dat_check <- dat_check %>%
    dplyr::mutate(resp_id = as.integer(resp_id),
                  resp_id = factor(resp_id, levels = unique(resp_id)))
  expect_equal(check_data(dplyr::select(dat, -student), identifier = NULL,
                          missing = NA, name = "x"),
               dat_check)

  missing_dat <- dat %>%
    dplyr::mutate(dplyr::across(dplyr::where(is.double),
                                ~sample(c(0, 1, NA_real_), size = dplyr::n(),
                                        replace = TRUE,
                                        prob = c(.45, .45, 0.1))))
  check_missing <- missing_dat %>%
    tidyr::pivot_longer(-student, names_to = "item_id", values_to = "score") %>%
    dplyr::mutate(resp_id = factor(student, levels = unique(student)),
                  item_id = factor(item_id, levels = 1:20),
                  score = as.integer(score)) %>%
    dplyr::select(resp_id, item_id, score) %>%
    dplyr::filter(!is.na(score))
  expect_equal(check_data(missing_dat, identifier = "student", missing = NA,
                          name = "x"),
               check_missing)

  missing_dat <- dat %>%
    dplyr::mutate(dplyr::across(dplyr::where(is.double),
                                ~sample(c(0, 1, "."),
                                        size = dplyr::n(),
                                        replace = TRUE,
                                        prob = c(.45, .45, 0.1))))
  check_missing <- missing_dat %>%
    tidyr::pivot_longer(-student, names_to = "item_id", values_to = "score") %>%
    dplyr::filter(!is.na(score), score != ".") %>%
    dplyr::mutate(resp_id = factor(student, levels = unique(student)),
                  item_id = factor(item_id, levels = 1:20),
                  score = as.integer(score)) %>%
    dplyr::select(resp_id, item_id, score)
  expect_equal(check_data(missing_dat, identifier = "student", missing = ".",
                          name = "x"),
               check_missing)
})

test_that("check_newdata", {
  model <- list(data = list(data = data.frame(item_id = paste0("Item_", 1:10))))
  model$data$data$item_id <- factor(model$data$data$item_id,
                                    levels = model$data$data$item_id)

  test_dat <- data.frame(resp_id = sample(mdm_data$respondent, size = 10),
                         Item_1 = sample(0:1, size = 10, replace = TRUE),
                         Item_0 = sample(0:1, size = 10, replace = TRUE),
                         Item_3 = sample(0:1, size = 10, replace = TRUE),
                         Item_5 = sample(0:1, size = 10, replace = TRUE))
  expect_error(check_newdata(test_dat, name = "check1", identifier = "resp_id",
                             model = model, missing = NA),
               regexp = "New items found in `newdata`: Item_0")

  test_dat <- data.frame(resp_id = sample(mdm_data$respondent, size = 10),
                         Item_1 = sample(0:1, size = 10, replace = TRUE),
                         Item_9 = sample(0:1, size = 10, replace = TRUE),
                         Item_3 = sample(0:1, size = 10, replace = TRUE),
                         Item_5 = sample(0:1, size = 10, replace = TRUE))
  check_dat <- test_dat %>%
    dplyr::mutate(resp_id = factor(.data$resp_id,
                                   levels = unique(test_dat$resp_id))) %>%
    tidyr::pivot_longer(cols = -"resp_id", names_to = "item_id",
                        values_to = "score") %>%
    dplyr::mutate(
      item_id = factor(.data$item_id,
                       levels = levels(model$data$data$item_id))
      ) %>%
    dplyr::arrange(.data$resp_id, .data$item_id)
  new_data <- check_newdata(test_dat, name = "check1", identifier = "resp_id",
                            model = model, missing = NA)
  expect_equal(levels(new_data$item_id), levels(model$data$data$item_id))
  expect_identical(new_data, check_dat)
})

test_that("check qmatrix", {
  err <- rlang::catch_cnd(check_qmatrix("a", identifier = NULL,
                                        item_levels = NA, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "data frame")

  test_q <- data.frame(item = paste0("I", 1:5),
                       att1 = sample(0:1, 5, replace = TRUE),
                       att2 = sample(0:1, 5, replace = TRUE))
  err <- rlang::catch_cnd(check_qmatrix(test_q, identifier = NULL,
                                        item_levels = paste0("I", 1:5),
                                        name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "only numeric columns")

  test_q <- data.frame(item = sample(0:1, 5, replace = TRUE),
                       att2 = sample(1:2, 5, replace = TRUE),
                       att3 = sample(2:3, 5, replace = TRUE))
  expect_error(check_qmatrix(test_q, "check1", identifier = NULL,
                             item_levels = c(1:5)), regexp = "only 0 or 1")

  test_q <- data.frame(item = paste0("I", 1:5),
                       att1 = sample(0:1, 5, replace = TRUE),
                       att2 = sample(0:1, 5, replace = TRUE))
  err <- rlang::catch_cnd(check_qmatrix(test_q, identifier = "item",
                                        item_levels = paste0("I", 1:6),
                                        name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "have the same number of rows as columns of items")

  test_q <- data.frame(item = paste0("I", 1:5),
                       att1 = sample(0:1, 5, replace = TRUE),
                       att2 = sample(0:1, 5, replace = TRUE))
  err <- rlang::catch_cnd(check_qmatrix(test_q, identifier = "item",
                                        item_levels = paste0("I", c(1:4, 6)),
                                        name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "Missing items: I6")

  test_q <- data.frame(item = paste0("I", 1:5),
                       att1 = sample(0:1, 5, replace = TRUE),
                       att2 = sample(0:1, 5, replace = TRUE))
  err <- rlang::catch_cnd(check_qmatrix(test_q, identifier = "item",
                                        item_levels = paste0("I", c(1:4, 4)),
                                        name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "Extra items: I5")

  test1_q <- tibble::tibble(item = paste0("I_", 1:5),
                            att1 = c(0, 1, 1, 0, 1),
                            att2 = c(1, 0, 0, 1, 0),
                            att3 = c(1, 1, 1, 0, 0))
  test2_q <- tibble::tibble(item = paste0("I_", 1:5),
                            att1 = c(0L, 1L, 1L, 0L, 1L),
                            att2 = c(1L, 0L, 0L, 1L, 0L),
                            att3 = c(1L, 1L, 1L, 0L, 0L))
  test3_q <- tibble::tibble(att1 = c(0L, 1L, 1L, 0L, 1L),
                            att2 = c(1L, 0L, 0L, 1L, 0L),
                            att3 = c(1L, 1L, 1L, 0L, 0L))
  test4_q <- data.frame(item = paste0("I_", 1:5),
                        att1 = c(0, 1, 1, 0, 1),
                        att2 = c(1, 0, 0, 1, 0),
                        att3 = c(1, 1, 1, 0, 0))
  test5_q <- data.frame(item = paste0("I_", 1:5),
                        att1 = c(0L, 1L, 1L, 0L, 1L),
                        att2 = c(1L, 0L, 0L, 1L, 0L),
                        att3 = c(1L, 1L, 1L, 0L, 0L))
  test6_q <- data.frame(att1 = c(0L, 1L, 1L, 0L, 1L),
                        att2 = c(1L, 0L, 0L, 1L, 0L),
                        att3 = c(1L, 1L, 1L, 0L, 0L))
  check_q <- tibble::tibble(item_id = factor(paste0("I_", 1:5)),
                            att1 = c(0L, 1L, 1L, 0L, 1L),
                            att2 = c(1L, 0L, 0L, 1L, 0L),
                            att3 = c(1L, 1L, 1L, 0L, 0L))
  check_q_null <- tibble::tibble(item_id = factor(paste0(1:5)),
                                 att1 = c(0L, 1L, 1L, 0L, 1L),
                                 att2 = c(1L, 0L, 0L, 1L, 0L),
                                 att3 = c(1L, 1L, 1L, 0L, 0L))
  expect_identical(check_qmatrix(test1_q, identifier = "item",
                                 item_levels = paste0("I_", 1:5),
                                 name = "check1"), check_q)
  expect_identical(check_qmatrix(test2_q, identifier = "item",
                                 item_levels = paste0("I_", 1:5),
                                 name = "check1"), check_q)
  expect_identical(check_qmatrix(test3_q, identifier = NULL,
                                 item_levels = paste0("I_", 1:5),
                                 name = "check1"), check_q)
  expect_identical(check_qmatrix(test4_q, identifier = "item",
                                 item_levels = paste0("I_", 1:5),
                                 name = "check1"), check_q)
  expect_identical(check_qmatrix(test5_q, identifier = "item",
                                 item_levels = paste0("I_", 1:5),
                                 name = "check1"), check_q)
  expect_identical(check_qmatrix(test6_q, identifier = NULL,
                                 item_levels = paste0("I_", 1:5),
                                 name = "check1"), check_q)
  expect_identical(check_qmatrix(check_q, identifier = "item_id",
                                 item_levels = paste0("I_", 1:5),
                                 name = "check1"), check_q)
  expect_identical(check_qmatrix(test1_q, identifier = "item",
                                 item_levels = NULL,
                                 name = "check1"), check_q)
  expect_identical(check_qmatrix(test4_q, identifier = "item",
                                 item_levels = NULL,
                                 name = "check1"), check_q)
  expect_identical(check_qmatrix(test3_q, identifier = NULL,
                                 item_levels = NULL,
                                 name = "check1"), check_q_null)
  expect_identical(check_qmatrix(test6_q, identifier = NULL,
                                 item_levels = NULL,
                                 name = "check1"), check_q_null)
})

test_that("check_prior", {
  err <- rlang::catch_cnd(check_prior(1L, name = "check1", type = "dina",
                                      strc = "unconstrained",
                                      qmatrix = q_matrix))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "be a measrprior")

  err <- rlang::catch_cnd(check_prior(NULL, name = "check1", type = "dina",
                                      strc = "unconstrained",
                                      qmatrix = q_matrix))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "be a measrprior")

  err <- rlang::catch_cnd(
    check_prior(prior(normal(0, 3), class = "intercept"),
                type = "dina", strc = "unconstrained", qmatrix = q_matrix[, -1],
                name = "check1")
  )
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "`intercept` is not relevant")

  err <- rlang::catch_cnd(
    check_prior(prior(normal(0, 3), class = "maineffect", coef = "l1_0"),
                type = "dina", strc = "unconstrained", qmatrix = q_matrix[, -1],
                name = "check1")
  )
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "`maineffect` is not relevant")

  err <- rlang::catch_cnd(
    check_prior(prior(normal(0, 3), class = "slip", coef = "l1_0"),
                type = "lcdm", strc = "unconstrained", qmatrix = q_matrix[, -1],
                name = "check1")
  )
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "`slip` is not relevant")

  err <- rlang::catch_cnd(
    check_prior(prior(normal(0, 3), class = "maineffect", coef = "l30_0"),
                type = "lcdm", strc = "unconstrained", qmatrix = q_matrix[, -1],
                name = "check1")
  )
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "`l30_0` with class `maineffect` is not relevant")

  err <- rlang::catch_cnd(
    check_prior(prior(normal(0, 3), class = "interaction", coef = "l1_0"),
                type = "lcdm", strc = "unconstrained", qmatrix = q_matrix[, -1],
                name = "check1")
  )
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "`l1_0` with class `interaction` is not relevant")

  err <- rlang::catch_cnd(
    check_prior(prior(beta(12, 13), class = "structural", coef = "eta[2]"),
                type = "dina", qmatrix = q_matrix[, -1],
                strc = "unconstrained", name = "check1")
  )
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message,
               "`eta\\[2\\]` with class `structural` is not relevant")

  err <- rlang::catch_cnd(
    check_prior(prior(dirichlet(rep_vector(1, C)), class = "structural",
                      coef = "Vc"),
                type = "crum", qmatrix = q_matrix[, -1],
                strc = "independent", name = "check1")
  )
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message,
               "`Vc` with class `structural` is not relevant")


  expect_s3_class(check_prior(prior(normal(0, 1)), type = "lcdm",
                              strc = "unconstrained",
                              qmatrix = q_matrix[, -1], name = "check1"),
                  "measrprior")
  expect_equal(unclass(check_prior(prior(normal(0, 1)), type = "lcdm",
                                   strc = "unconstrained",
                                   qmatrix = q_matrix[, -1], name = "check1")),
               unclass(data.frame(class = "structural", coef = NA_character_,
                                  prior_def = "normal(0, 1)")))
  expect_equal(check_prior(NULL, type = "dino", qmatrix = q_matrix[, -1],
                           strc = "unconstrained",
                           name = "check1", allow_null = TRUE),
               NULL)
})

test_that("check_file", {
  temp_file <- fs::file_temp("does-not-exist/fake-file", ext = "rds")

  err <- rlang::catch_cnd(check_file(temp_file, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "be an existing directory")

  err <- rlang::catch_cnd(check_file(temp_file, name = "check1",
                                     create_dir = TRUE))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "be an existing file")

  fs::file_touch(temp_file)

  expect_equal(check_file(NULL, allow_null = TRUE, name = "check1"), NULL)
  expect_equal(check_file(temp_file, name = "check1"), temp_file)
  expect_equal(check_file(temp_file, name = "check1", check_file = FALSE,
                          ext = "txt"),
               fs::path_ext_set(temp_file, "txt"))
})

test_that("check_logical", {
  err <- rlang::catch_cnd(check_logical(1L, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "logical scalar")
  expect_equal(err$not, "integer")

  err <- rlang::catch_cnd(check_logical(rep(TRUE, 3), name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "length 1")
  expect_equal(err$not, 3L)

  err <- rlang::catch_cnd(check_logical(NA, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "non-missing")

  expect_equal(check_logical(TRUE, name = "check1"), TRUE)
  expect_equal(check_logical(FALSE, name = "check1"), FALSE)
  expect_equal(check_logical(NA, allow_na = TRUE, name = "check1"), NA)
})

test_that("check_integer", {
  err <- rlang::catch_cnd(check_integer("a", name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "numeric scalar")
  expect_equal(err$not, "character")

  err <- rlang::catch_cnd(check_integer(1:2, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "length 1")
  expect_equal(err$not, 2L)

  err <- rlang::catch_cnd(check_integer(NA_integer_, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "non-missing")

  err <- rlang::catch_cnd(check_integer(NULL, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "numeric scalar")

  err <- rlang::catch_cnd(check_integer(-1, lb = 0L, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "greater than 0")

  err <- rlang::catch_cnd(check_integer(1, ub = 0L, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "less than 0")

  err <- rlang::catch_cnd(check_integer(4L, lb = 0L, ub = 3L, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "between 0 and 3")

  err <- rlang::catch_cnd(check_integer(0, lb = 0, inclusive = FALSE,
                                        name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "greater than 0")

  expect_equal(check_integer(5, name = "check1"), 5L)
  expect_equal(check_integer(5L, name = "check1"), 5L)
  expect_equal(check_integer(0, lb = 0, inclusive = TRUE, name = "check1"), 0L)
  expect_equal(check_integer(6, lb = 0, name = "check1"), 6L)
  expect_equal(check_integer(NULL, name = "check1", allow_null = TRUE), NULL)
})

test_that("check_double", {
  err <- rlang::catch_cnd(check_double("a", name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "numeric scalar")
  expect_equal(err$not, "character")

  err <- rlang::catch_cnd(check_double(list(c(1, 2), 3), name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "length 1")
  expect_equal(err$not, 2L)

  err <- rlang::catch_cnd(check_double(NA_real_, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "non-missing")

  err <- rlang::catch_cnd(check_double(-1, lb = 0L, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "greater than 0")

  err <- rlang::catch_cnd(check_double(1, ub = 0L, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "less than 0")

  err <- rlang::catch_cnd(check_double(4L, lb = 0L, ub = 3L, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "between 0 and 3")

  err <- rlang::catch_cnd(check_double(0, lb = 0, inclusive = FALSE,
                                        name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "greater than 0")

  expect_equal(check_double(0.98, name = "check1"), 0.98)
  expect_equal(check_double(0.1, name = "check1"), 0.1)
  expect_equal(check_double(0, lb = 0, inclusive = TRUE, name = "check1"), 0L)
  expect_equal(check_double(0.975, lb = 0, ub = 1, name = "check1"), 0.975)
})

test_that("check_character", {
  err <- rlang::catch_cnd(check_character(NULL, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "character scalar")
  expect_equal(err$not, "NULL")

  err <- rlang::catch_cnd(check_character(1L, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "character scalar")
  expect_equal(err$not, "integer")

  err <- rlang::catch_cnd(check_character(letters[1:5], name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "length 1")
  expect_equal(err$not, 5L)

  err <- rlang::catch_cnd(check_character(NA_character_, name = "check1"))
  expect_s3_class(err, "error_bad_argument")
  expect_equal(err$arg, "check1")
  expect_match(err$message, "non-missing")

  expect_equal(check_character(NULL, allow_null = TRUE, name = "check1"),
               NULL)
  expect_equal(check_character("intercept", name = "check1"), "intercept")
  expect_equal(check_character(NA, allow_na = TRUE, name = "check1"),
               NA_character_)
  expect_equal(check_character(NA_character_, allow_na = TRUE, name = "check1"),
               NA_character_)
})