# ---- wid_validate ---------------------------------------------------------- test_that("wid_validate returns invisibly on valid inputs", { expect_invisible(wid_validate(series_type = "s", concept = "ptinc", age = 992, pop = "j")) }) test_that("wid_validate normalises age to zero-padded 3-digit string", { out <- wid_validate(age = 992) expect_equal(out$age, "992") }) test_that("wid_validate errors on unknown series_type", { expect_error(wid_validate(series_type = "Z"), "series_type") }) test_that("wid_validate errors on unknown concept", { expect_error(wid_validate(concept = "zzzzz"), "concept") }) test_that("wid_validate errors on unknown age", { expect_error(wid_validate(age = 0), "age") }) test_that("wid_validate errors on unknown pop", { expect_error(wid_validate(pop = "z"), "pop") }) test_that("wid_validate errors on non-integer years", { expect_error(wid_validate(years = "x"), "integer") }) test_that("wid_validate warns on years outside [1800,2100]", { expect_warning(wid_validate(years = 1799L), "1800") }) test_that("wid_validate warns on malformed area codes", { expect_warning(wid_validate(areas = "lowercase"), "invalid") }) test_that("wid_validate accepts valid area codes including subregions", { expect_invisible(wid_validate(areas = c("US","US-CA","FR"))) }) test_that("wid_validate errors on invalid perc format", { expect_error(wid_validate(perc = "bad"), "percentile") }) test_that("wid_validate errors when percentile lower >= upper", { expect_error(wid_validate(perc = "p90p10"), "Lower >= upper") }) test_that("wid_validate accepts valid perc", { expect_invisible(wid_validate(perc = "p99p100")) }) test_that("wid_validate errors on non-coercible age", { expect_error(wid_validate(age = "abc"), "integer") }) # ---- wid_is_valid ---------------------------------------------------------- test_that("wid_is_valid returns TRUE for valid components", { expect_true(wid_is_valid(series_type = "s", concept = "ptinc")) }) test_that("wid_is_valid returns FALSE for invalid series_type", { expect_false(wid_is_valid(series_type = "Z")) }) test_that("wid_is_valid returns TRUE (not FALSE) for warning-level issues", { expect_true(wid_is_valid(years = 1799L)) }) # ---- wid_decode ------------------------------------------------------------ test_that("wid_decode parses full canonical code", { d <- wid_decode("sptinc992j") expect_equal(d$series_type, "s") expect_equal(d$concept, "ptinc") expect_equal(d$age, "992") expect_equal(d$pop, "j") }) test_that("wid_decode parses code without age/pop", { d <- wid_decode("mnninc") expect_equal(d$series_type, "m") expect_equal(d$concept, "nninc") expect_null(d$age) expect_null(d$pop) }) test_that("wid_decode errors on unknown series_type (strict)", { expect_error(wid_decode("Zptinc992j"), "series_type") }) test_that("wid_decode errors on code too short (strict)", { expect_error(wid_decode("bad"), "series_type|too short") }) test_that("wid_decode errors when concept not found in rest of code", { # 's' is a valid series_type; 'zzzzz' matches no concept in wid_concepts expect_error(wid_decode("szzzzz"), "No known concept") }) test_that("wid_decode errors on unexpected trailing characters (strict)", { expect_error(wid_decode("sptinc992jXX"), "trailing") }) test_that("wid_decode returns NULL and warns on bad code when strict=FALSE", { expect_warning(out <- wid_decode("bad", strict = FALSE)) expect_null(out) }) test_that("wid_decode errors on unknown age code", { expect_error(wid_decode("sptinc000j"), "age") }) test_that("wid_decode errors on unknown pop code", { expect_error(wid_decode("sptinc992z"), "pop") }) test_that("wid_decode errors when age suffix is not 3 digits", { expect_error(wid_decode("sptincXXXj"), "age suffix") }) # ---- wid_encode ------------------------------------------------------------ test_that("wid_encode builds correct code from components", { expect_equal(wid_encode("s", "ptinc", "992", "j"), "sptinc992j") }) test_that("wid_encode omits optional age and pop", { expect_equal(wid_encode("m", "nninc"), "mnninc") }) test_that("wid_encode accepts list from wid_decode", { d <- wid_decode("sptinc992j") expect_equal(wid_encode(d), "sptinc992j") }) test_that("wid_encode round-trips through wid_decode", { code <- "tptinc992j" expect_equal(wid_encode(wid_decode(code)), code) }) test_that("wid_encode errors on invalid series_type", { expect_error(wid_encode("Z", "ptinc"), "series_type") }) test_that("wid_encode errors on invalid concept", { expect_error(wid_encode("s", "zzzzz"), "concept") }) # ---- wid_search ------------------------------------------------------------ test_that("wid_search returns matches from concepts table", { out <- wid_search("pretax national income") expect_s3_class(out, "data.frame") expect_true(nrow(out) >= 1L) expect_true("ptinc" %in% out$variable) }) test_that("wid_search is case-insensitive", { out <- wid_search("PRETAX") expect_true(nrow(out) >= 1L) }) test_that("wid_search messages and returns empty frame on no match", { expect_message(out <- wid_search("zzznomatch999"), "No matches") expect_equal(nrow(out), 0L) }) test_that("wid_search errors on unknown table name", { expect_error(wid_search("x", tables = "nosuchtable"), "Unknown table") }) test_that("wid_search type= filter restricts to codes starting with that letter", { out <- wid_search("ptinc", type = "s") expect_true(all(substr(out$variable, 1L, 1L) == "s")) }) test_that("wid_search tables='all' searches across all tables", { out <- wid_search("share", tables = "all") tbls <- unique(out$table) expect_true(length(tbls) >= 1L) }) test_that("wid_search searches the series_types table when requested", { out <- wid_search("threshold", tables = "series_types") expect_true(nrow(out) >= 1L) })