rong: Functional Input Validation

context("Predicates")

expect_pass_fail <- function(pred, pass, fail, ...) {
  expect_true(pred(pass, ...))
  expect_false(pred(fail, ...))
}

test_that("boolean predicates work", {
  expect_pass_fail(chk_true, TRUE, FALSE)
  expect_pass_fail(chk_is, TRUE, FALSE)
  expect_pass_fail(chk_false, FALSE, TRUE)
  expect_pass_fail(chk_not, FALSE, TRUE)
  expect_pass_fail(chk_all, c(TRUE, TRUE), c(FALSE, TRUE))
  expect_pass_fail(chk_all, c(TRUE, NA), c(FALSE, NA), na.rm = TRUE)
  expect_pass_fail(chk_any, c(TRUE, FALSE), c(FALSE, FALSE))
  expect_pass_fail(chk_any, c(TRUE, NA), c(FALSE, NA), na.rm = TRUE)
  expect_pass_fail(chk_none, c(FALSE, FALSE), c(FALSE, TRUE))
  expect_pass_fail(chk_none, c(FALSE, NA), c(TRUE, NA), na.rm = TRUE)
  expect_pass_fail(chk_all_map, c(FALSE, FALSE), c(TRUE, FALSE), .f = `!`)
  expect_pass_fail(chk_all_map, c(FALSE, NA), c(TRUE, NA), .f = `!`, na.rm = TRUE)
  expect_pass_fail(chk_any_map, c(FALSE, TRUE), c(TRUE, TRUE), .f = `!`)
  expect_pass_fail(chk_any_map, c(FALSE, NA), c(TRUE, NA), .f = `!`, na.rm = TRUE)
  expect_pass_fail(chk_none_map, c(TRUE, TRUE), c(FALSE, FALSE), .f = `!`)
  expect_pass_fail(chk_none_map, c(TRUE, NA), c(FALSE, NA), .f = `!`, na.rm = TRUE)
})

test_that("object predicates work", {
  expect_pass_fail(chk_call, quote(f(x)), NULL)
  expect_pass_fail(chk_factor, as.factor(letters), NULL)
  expect_pass_fail(chk_data_frame, data.frame(), NULL)
  expect_pass_fail(chk_matrix, matrix(), NULL)
  expect_pass_fail(chk_formula, x ~ y, NULL)
  expect_pass_fail(chk_function, log, NULL)
})

test_that("pattern predicates work", {
  expect_pass_fail(chk_grepl, "this...", "that",
                   pattern = "^this")
  expect_pass_fail(chk_grepl, "tHiS...", "that",
                   pattern = "^this", ignore.case = TRUE)
  expect_pass_fail(chk_grepl, "this(...", "that(",
                   pattern = "^this\\(", perl = TRUE)
  expect_pass_fail(chk_starts_with, "this...", "that...",
                   prefix = "this")
  expect_pass_fail(chk_starts_with, c("this...", NA), c("that...", NA),
                   prefix = "this", na.rm = TRUE)
  expect_pass_fail(chk_ends_with, "...this", "...that",
                   suffix = "this")
  expect_pass_fail(chk_ends_with, c("...this", NA), c("...that", NA),
                   suffix = "this", na.rm = TRUE)
})

test_that("property predicates work", {
  attrs <- function(x)
    do.call("structure", c(NA, as.list(set_names(x))))

  expect_pass_fail(chk_empty, list(), 0)
  expect_pass_fail(chk_not_empty, 0, list())
  expect_pass_fail(chk_singleton, 0, letters)
  expect_pass_fail(chk_not_na, NULL, NA)
  expect_pass_fail(chk_without_na, c(TRUE, FALSE), c(TRUE, NA))
  expect_pass_fail(chk_named, c(a = "a"), "a")
  expect_pass_fail(chk_has_name, c(a = "a", "b"), c(A = "a", "b"), nm = "a")
  expect_pass_fail(chk_has_names, set_names(letters), letters, nms = letters)
  expect_pass_fail(chk_has_length, 1, 1:2, n = 1)
  expect_pass_fail(chk_has_attr, structure(NA, a = "a"), NA, which = "a")
  expect_pass_fail(chk_has_attrs, attrs(letters), attrs("a"), which = letters)
  expect_pass_fail(chk_inherits, `class<-`(NA, "Class"), NA, what = "Class")
})

test_that("relational predicates work", {
  expect_pass_fail(chk_identical, 0L, 0.0, to = 0L)
  expect_pass_fail(chk_not_identical, 0.0, 0L, to = 0L)
  expect_pass_fail(chk_equal, 0, 1, to = 0)
  expect_pass_fail(chk_not_equal, 1, 0, to = 0)
  expect_pass_fail(chk_equivalent, structure(0, a = "a"), 1, to = 0)
  expect_pass_fail(chk_not_equivalent, 1, structure(0, a = "a"), to = 0)
  expect_pass_fail(chk_gt, 1, -1, lwr = 0)
  expect_pass_fail(chk_gt, c(1, NA), c(-1, NA), lwr = 0, na.rm = TRUE)
  expect_pass_fail(chk_lt, -1, 1, upr = 0)
  expect_pass_fail(chk_lt, c(-1, NA), c(1, NA), upr = 0, na.rm = TRUE)
  expect_pass_fail(chk_gte, 0, -1, lwr = 0)
  expect_pass_fail(chk_gte, c(0, NA), c(-1, NA), lwr = 0, na.rm = TRUE)
  expect_pass_fail(chk_lte, c(0, NA), c(1, NA), upr = 0, na.rm = TRUE)
})

test_that("set predicates work", {
  expect_pass_fail(chk_in, "a", "A", set = letters)
  expect_pass_fail(chk_not_in, "A", "a", set = letters)
  expect_pass_fail(chk_include, letters, letters[-1], set = "a")
  expect_pass_fail(chk_exclude, letters[-1], letters, set = "a")
  expect_pass_fail(chk_within, c("a", "b"), c("a", "b", "C"), set = letters)
  expect_pass_fail(chk_intersect, c("a", "b"), c("A", "B"), set = letters)
  expect_pass_fail(chk_avoid, letters[-1], letters, set = "a")
  expect_pass_fail(chk_setequal, rev(letters), letters[-1], set = letters)
})

test_that("type predicates work", {
  expect_pass_fail(chk_null, NULL, 0)
  expect_pass_fail(chk_not_null, 0, NULL)
  expect_pass_fail(chk_symbol, as.symbol("x"), "x")
  expect_pass_fail(chk_pairlist, formals(function(x = 0) NULL), list(x = 0))
  expect_pass_fail(chk_closure, function(x) NULL, .Primitive)
  expect_pass_fail(chk_environment, emptyenv(), list())
  expect_pass_fail(chk_language, quote(f(x)), NULL)
  expect_pass_fail(chk_atomic, 1:2, as.list(1:2))
  expect_pass_fail(chk_atomic, 1, 1:2, n = 1)
  expect_pass_fail(chk_vector, vector(), NULL)
  expect_pass_fail(chk_vector, vector(length = 1), vector(length = 2), n = 1)
  expect_pass_fail(chk_logical, logical(), NULL)
  expect_pass_fail(chk_logical, logical(1), logical(2), n = 1)
  expect_pass_fail(chk_boolean, TRUE, NA)
  expect_pass_fail(chk_numerical, numeric(), NULL)
  expect_pass_fail(chk_numerical, numeric(1), numeric(2), n = 1)
  expect_pass_fail(chk_number, numeric(1), NA_real_)
  expect_pass_fail(chk_integer, integer(), NULL)
  expect_pass_fail(chk_integer, integer(1), integer(2), n = 1)
  expect_pass_fail(chk_integerish, c(1.0, 2.0), 0.000001)
  expect_pass_fail(chk_integerish, 1.0, c(1.0, 2.0), n = 1)
  expect_pass_fail(chk_double, double(), NULL)
  expect_pass_fail(chk_double, double(1), double(2), n = 1)
  expect_pass_fail(chk_complex, complex(), NULL)
  expect_pass_fail(chk_complex, complex(1), complex(2), n = 1)
  expect_pass_fail(chk_character, character(), NULL)
  expect_pass_fail(chk_character, character(1), character(2), n = 1)
  expect_pass_fail(chk_string, character(1), NA_character_)
  expect_pass_fail(chk_list, list(), NULL)
  expect_pass_fail(chk_list, vector("list", 1), vector("list", 2), n = 1)
  expect_pass_fail(chk_raw, raw(), NULL)
  expect_pass_fail(chk_raw, raw(1), raw(2), n = 1)
})