local_name_repair_quiet() # vec_names() --------------------------------------------------------- test_that("vec_names() retrieves names", { expect_null(vec_names(letters)) expect_identical(vec_names(set_names(letters)), letters) expect_identical(vec_names(mtcars), row.names(mtcars)) expect_null(vec_names(unrownames(mtcars))) expect_identical(vec_names(Titanic), dimnames(Titanic)[[1]]) x <- matrix(1L, dimnames = list("row", "col")) expect_identical(vec_names(x), dimnames(x)[[1]]) }) test_that("vec_names() dispatches", { local_methods( names.vctrs_foobar = function(x) "dispatched!" ) expect_identical(vec_names(foobar()), "dispatched!") }) # vec_names2() ------------------------------------------------------------- test_that("vec_names2() repairs names", { expect_identical(vec_names2(1:2), c("", "")) expect_identical(vec_names2(1:2, repair = "unique"), c("...1", "...2")) expect_identical(vec_names2(set_names(1:2, c("_foo", "_bar")), repair = "universal"), c("._foo", "._bar")) }) test_that("vec_names2() treats data frames and arrays as vectors", { expect_identical(vec_names2(mtcars), row.names(mtcars)) expect_identical(vec_names2(as.matrix(mtcars)), row.names(mtcars)) df <- unrownames(mtcars) exp <- rep_len("", nrow(mtcars)) expect_identical(vec_names2(df), exp) expect_identical(vec_names2(as.matrix(df)), exp) }) test_that("vec_names2() accepts and checks repair function", { expect_identical(vec_names2(1:2, repair = function(nms) rep_along(nms, "foo")), c("foo", "foo")) expect_error(vec_names2(1:2, repair = function(nms) "foo"), "length 1 instead of length 2") }) test_that("vec_names2() repairs names before invoking repair function", { x <- set_names(1:2, c(NA, NA)) expect_identical(vec_names2(x, repair = identity), c("", "")) }) test_that("vec_names2() result is correct for *_quiet repair", { expect_identical(vec_names2(1:2, repair = "unique"), vec_names2(1:2, repair = "unique_quiet")) expect_identical(vec_names2(1:2, repair = "universal"), vec_names2(1:2, repair = "universal_quiet")) }) # vec_as_names() ----------------------------------------------------------- test_that("vec_as_names() requires character vector", { expect_error(vec_as_names(NULL), "`names` must be a character vector") }) test_that("vec_as_names() validates `repair`", { expect_snapshot({ (expect_error(my_vec_as_names("x", my_repair = "foo"), "can't be \"foo\"")) (expect_error(my_vec_as_names(1, my_repair = 1), "string or a function")) }) }) test_that("vec_as_names() repairs names", { expect_identical(vec_as_names(chr(NA, NA)), c("", "")) expect_identical(vec_as_names(chr(NA, NA), repair = "unique"), c("...1", "...2")) expect_identical(vec_as_names(chr("_foo", "_bar"), repair = "universal"), c("._foo", "._bar")) expect_identical(vec_as_names(chr("a", "b"), repair = "check_unique"), c("a", "b")) }) test_that("vec_as_names() checks unique names", { expect_snapshot({ (expect_error(my_vec_as_names(chr(NA), my_repair = "check_unique"))) (expect_error(my_vec_as_names(chr(""), my_repair = "check_unique"))) (expect_error(my_vec_as_names(chr("a", "a"), my_repair = "check_unique"))) (expect_error(my_vec_as_names(chr("..1"), my_repair = "check_unique"))) (expect_error(my_vec_as_names(chr("..."), my_repair = "check_unique"))) }) }) test_that("vec_as_names() result is correct for *_quiet repair", { expect_identical( vec_as_names(chr("_foo", "_bar"), repair = "unique"), vec_as_names(chr("_foo", "_bar"), repair = "unique_quiet") ) expect_identical( vec_as_names(chr("_foo", "_bar"), repair = "universal"), vec_as_names(chr("_foo", "_bar"), repair = "universal_quiet") ) }) test_that("vec_as_names() keeps the names of a named vector", { x_unnamed <- c(NA, "", "..1", "...2") x_names <- letters[1:4] x <- set_names(x_unnamed, x_names) expect_identical( set_names(vec_as_names(x_unnamed, repair = "minimal"), x_names), vec_as_names(x, repair = "minimal") ) expect_identical( set_names(vec_as_names(x_unnamed, repair = "unique"), x_names), vec_as_names(x, repair = "unique") ) expect_identical( set_names(vec_as_names(x_unnamed, repair = "universal"), x_names), vec_as_names(x, repair = "universal") ) }) test_that("vec_as_names() accepts and checks repair function", { f <- local({ local_obj <- "foo" ~ rep_along(.x, local_obj) }) expect_identical(vec_as_names(c("", ""), repair = f), c("foo", "foo")) expect_snapshot(error = TRUE, my_vec_as_names(c("", ""), my_repair = function(nms) "foo")) }) test_that("vec_as_names() repairs names before invoking repair function", { expect_identical(vec_as_names(chr(NA, NA), repair = identity), c("", "")) }) test_that("vec_as_names() is noisy by default", { local_name_repair_verbose() expect_snapshot({ # Noisy name repair vec_as_names(c("x", "x"), repair = "unique") # Quiet name repair vec_as_names(c("x", "x"), repair = "unique", quiet = TRUE) # Hint at repair argument, if known (expect_error( my_vec_as_names(c("x", "x"), my_repair = "check_unique") )) # request quiet via name repair string, don't specify `quiet` vec_as_names(c("1", "1"), repair = "unique_quiet") vec_as_names(c("1", "1"), repair = "universal_quiet") # request quiet via name repair string, specify `quiet` = TRUE vec_as_names(c("1", "1"), repair = "unique_quiet", quiet = TRUE) vec_as_names(c("1", "1"), repair = "universal_quiet", quiet = TRUE) # request quiet via name repair string, specify `quiet` = FALSE vec_as_names(c("1", "1"), repair = "unique_quiet", quiet = FALSE) vec_as_names(c("1", "1"), repair = "universal_quiet", quiet = FALSE) }) }) test_that("validate_minimal_names() checks names", { expect_snapshot({ (expect_error(validate_minimal_names(1), "must return a character vector")) (expect_error(validate_minimal_names(NULL), "can't return `NULL`")) (expect_error(validate_minimal_names(chr(NA)), "can't return `NA` values")) }) }) test_that("validate_unique() checks unique names", { expect_snapshot({ (expect_error(validate_unique(chr(NA)), "`NA`")) (expect_error(validate_unique(chr("")), class = "vctrs_error_names_cannot_be_empty")) (expect_error(validate_unique(chr("a", "a")), class = "vctrs_error_names_must_be_unique")) (expect_error(validate_unique(chr("..1")), class = "vctrs_error_names_cannot_be_dot_dot")) (expect_error(validate_unique(chr("...")), class = "vctrs_error_names_cannot_be_dot_dot")) }) }) test_that("vec_as_names_validate() validates repair arguments", { expect_identical( validate_name_repair_arg(c("unique", "check_unique")), "unique" ) expect_identical( validate_name_repair_arg(~ toupper(.))(letters), LETTERS ) }) test_that("vec_as_names() is quiet when function is supplied (#1018)", { expect_silent( vctrs::vec_as_names( c("a", "b"), repair = function(x) paste0(x, "a"), quiet = FALSE ) ) }) test_that("vec_as_names() evaluates repair_arg lazily", { expect_silent(vec_as_names(letters, repair_arg = print("oof"))) }) # vec_repair_names() ------------------------------------------------------- test_that("vec_repair_names() repairs names", { expect_identical(vec_repair_names(1:2), set_names(1:2, c("", ""))) expect_identical(vec_repair_names(1:2, "unique"), set_names(1:2, c("...1", "...2"))) expect_identical(vec_repair_names(set_names(1:2, c("_foo", "_bar")), "universal"), set_names(1:2, c("._foo", "._bar"))) }) test_that("vec_repair_names() handles data frames and arrays", { df <- data.frame(x = 1:2) expect_identical(vec_repair_names(df), df) expect_identical(row.names(vec_repair_names(as.matrix(df))), c("", "")) expect_identical(row.names(vec_repair_names(as.matrix(df), "unique")), c("...1", "...2")) }) # vec_set_names() ----------------------------------------------------------- test_that("vec_set_names() sets atomic names", { x <- 1:2 names <- c("x1", "x2") exp <- set_names(x, names) expect_equal(vec_set_names(x, names), exp) }) test_that("vec_set_names() sets matrix/array names", { x <- matrix(1:2) names <- c("x1", "x2") exp <- x rownames(exp) <- names expect_equal(vec_set_names(x, names), exp) y <- array(1:4, dim = c(2, 1, 2)) exp <- y rownames(exp) <- names expect_equal(vec_set_names(y, names), exp) }) test_that("vec_set_names() doesn't alter names", { x <- matrix(1, dimnames = list(rows = "a", cols = "x")) vec_set_names(x, "y") expect_equal(vec_names2(x), "a") expect_equal(colnames(x), "x") vec_set_names(x, NULL) expect_equal(vec_names2(x), "a") expect_equal(colnames(x), "x") y <- array(1:4, dim = c(1, 2, 2), dimnames = list(rows = "a", one = 1:2, two = 1:2)) vec_set_names(y, "y") expect_equal(vec_names2(y), "a") vec_set_names(y, NULL) expect_equal(vec_names2(y), "a") }) test_that("vec_set_names() sets row names on data frames", { expect_identical( vec_set_names(data_frame(x = 1), "foo"), new_data_frame(list(x = 1), row.names = "foo") ) expect_identical( vec_set_names(data_frame(x = 1:2), c("foo", "foo")), new_data_frame(list(x = 1:2), row.names = c("foo...1", "foo...2")) ) }) test_that("vec_set_names() correctly sets names on POSIXlt objects", { x <- as.POSIXlt(new_datetime(0)) exp <- set_names(x, "a") expect_equal(vec_set_names(x, "a"), exp) }) test_that("vec_set_names() falls back to `names<-` with proxied objects", { x <- structure(1, class = "foobar") exp <- set_names(x, "a") expect_equal(vec_set_names(x, "a"), exp) local_methods(`names<-.foobar` = function(x, value) "fallback!") expect_equal(vec_set_names(x, "a"), "fallback!") }) test_that("vec_set_names() falls back to `rownames<-` with shaped proxied objects", { x <- structure(1:2, dim = c(2L, 1L), class = "foobar") names <- c("r1", "r2") exp <- x rownames(exp) <- names expect_equal(vec_set_names(x, names), exp) # `rownames<-` is not generic, but eventually calls `dimnames<-` which is local_methods(`dimnames<-.foobar` = function(x, value) "fallback!") expect_equal(vec_set_names(x, names), "fallback!") }) test_that("vec_set_names() can set NULL names", { x <- 1:2 expect_equal(vec_set_names(x, NULL), x) x_named <- set_names(x) expect_equal(vec_set_names(x_named, NULL), x) x_mat <- as.matrix(x) expect_equal(vec_set_names(x_mat, NULL), x_mat) x_mat_named <- x_mat rownames(x_mat_named) <- c("1", "2") exp <- matrix(x_mat, dimnames = list(NULL, NULL)) expect_equal(vec_set_names(x_mat_named, NULL), exp) }) test_that("vec_set_names() errors with bad `names`", { expect_snapshot({ (expect_error(vec_set_names(1, 1), "character vector, not a double")) (expect_error(vec_set_names(1, c("x", "y")), "The size of `names`, 2")) }) }) test_that("vec_names() and vec_set_names() work with 1-dimensional arrays", { x <- array(1:2, dimnames = list(c("a", "b"))) expect_identical(vec_names(x), c("a", "b")) expect_identical(vec_names(vec_set_names(x, c("A", "B"))), c("A", "B")) }) # minimal names ------------------------------------------------------------- test_that("minimal names are made from `n` when `name = NULL`", { expect_identical(minimal_names(1:2), c("", "")) }) test_that("as_minimal_names() checks input", { expect_error(as_minimal_names(1:3), "must be a character vector") }) test_that("minimal names have '' instead of NAs", { expect_identical(as_minimal_names(c("", NA, "", NA)), c("", "", "", "")) }) test_that("repairing minimal names copes with NULL input names", { x <- 1:3 x_named <- vec_repair_names(x) expect_equal(names(x_named), rep("", 3)) }) test_that("as_minimal_names() is idempotent", { x <- c("", "", NA) expect_identical(as_minimal_names(x), as_minimal_names(as_minimal_names(x))) }) test_that("minimal_names() treats data frames and arrays as vectors", { expect_identical(minimal_names(mtcars), row.names(mtcars)) expect_identical(minimal_names(as.matrix(mtcars)), row.names(mtcars)) df <- unrownames(mtcars) exp <- rep_len("", nrow(mtcars)) expect_identical(minimal_names(df), exp) expect_identical(minimal_names(as.matrix(df)), exp) }) test_that("as_minimal_names() copies on write", { nms <- chr(NA, NA) as_minimal_names(nms) expect_identical(nms, chr(NA, NA)) nms <- c("a", "b") out <- as_minimal_names(nms) expect_true(is_reference(nms, out)) }) # unique names ------------------------------------------------------------- test_that("unique_names() handles unnamed vectors", { expect_identical(unique_names(1:3), c("...1", "...2", "...3")) }) test_that("as_unique_names() is a no-op when no repairs are needed", { x <- c("x", "y") out <- as_unique_names(x) expect_true(is_reference(out, x)) expect_identical(out, c("x", "y")) }) test_that("as_unique_names() eliminates emptiness and duplication", { x <- c("", "x", "y", "x") expect_identical(as_unique_names(x), c("...1", "x...2", "y", "x...4")) }) test_that("as_unique_names(): solo empty or NA gets suffix", { expect_identical(as_unique_names(""), "...1") expect_identical(as_unique_names(NA_character_), "...1") }) test_that("as_unique_names() treats ellipsis like empty string", { expect_identical(as_unique_names("..."), as_unique_names("")) }) test_that("two_three_dots() does its job and no more", { x <- c(".", ".1", "...1", "..1a") expect_identical(two_to_three_dots(x), x) expect_identical(two_to_three_dots(c("..1", "..22")), c("...1", "...22")) }) test_that("two dots then number treated like three dots then number", { expect_identical(as_unique_names("..2"), as_unique_names("...5")) }) test_that("as_unique_names() strips positional suffixes, re-applies as needed", { x <- c("...20", "a...1", "b", "", "a...2...34") expect_identical(as_unique_names(x), c("...1", "a...2", "b", "...4", "a...5")) expect_identical(as_unique_names("a...1"), "a") expect_identical(as_unique_names(c("a...2", "a")), c("a...1", "a...2")) expect_identical(as_unique_names(c("a...3", "a", "a")), c("a...1", "a...2", "a...3")) expect_identical(as_unique_names(c("a...2", "a", "a")), c("a...1", "a...2", "a...3")) expect_identical(as_unique_names(c("a...2", "a...2", "a...2")), c("a...1", "a...2", "a...3")) }) test_that("as_unique_names() is idempotent", { x <- c("...20", "a...1", "b", "", "a...2") expect_identical(as_unique_names(!!x), as_unique_names(as_unique_names(!!x))) }) test_that("unique-ification has an 'algebraic'-y property", { ## inspired by, but different from, this guarantee about base::make.unique() ## make.unique(c(A, B)) == make.unique(c(make.unique(A), B)) ## If A is already unique, then make.unique(c(A, B)) preserves A. ## I haven't formulated what we guarantee very well yet, but it's probably ## implicit in this test (?) x <- c("...20", "a...1", "b", "", "a...2", "d") y <- c("", "a...3", "b", "...3", "e") ## fix names on each, catenate, fix the whole z1 <- as_unique_names( c( as_unique_names(x), as_unique_names(y) ) ) ## fix names on x, catenate, fix the whole z2 <- as_unique_names( c( as_unique_names(x), y ) ) ## fix names on y, catenate, fix the whole z3 <- as_unique_names( c( x, as_unique_names(y) ) ) ## catenate, fix the whole z4 <- as_unique_names( c( x, y ) ) expect_identical(z1, z2) expect_identical(z1, z3) expect_identical(z1, z4) }) test_that("unique_names() and as_unique_names() are verbose or silent", { local_name_repair_verbose() expect_snapshot(unique_names(1:2)) expect_snapshot(as_unique_names(c("", ""))) expect_message(regexp = NA, unique_names(1:2, quiet = TRUE)) expect_message(regexp = NA, as_unique_names(c("", ""), quiet = TRUE)) }) test_that("names with only duplicates are repaired", { expect_identical(unique_names(list(x = NA, x = NA)), c("x...1", "x...2")) }) # Universal names ---------------------------------------------------------- test_that("zero-length input", { expect_equal(as_universal_names(character()), character()) }) test_that("universal names are not changed", { expect_equal(as_universal_names(letters), letters) }) test_that("as_universal_names() is idempotent", { x <- c(NA, "", "x", "x", "a1:", "_x_y}") expect_identical(as_universal_names(x), as_universal_names(as_universal_names(x))) }) test_that("dupes get a suffix", { expect_equal( as_universal_names(c("a", "b", "a", "c", "b")), c("a...1", "b...2", "a...3", "c", "b...5") ) }) test_that("as_universal_names(): solo empty or NA gets suffix", { expect_identical(as_universal_names(""), "...1") expect_identical(as_universal_names(NA_character_), "...1") }) test_that("as_universal_names() treats ellipsis like empty string", { expect_identical(as_universal_names("..."), as_universal_names("")) }) test_that("solo dot is unchanged", { expect_equal(as_universal_names("."), ".") }) test_that("dot, dot gets suffix", { expect_equal(as_universal_names(c(".", ".")), c("....1", "....2")) }) test_that("dot-dot, dot-dot gets suffix", { expect_equal(as_universal_names(c("..", "..")), c(".....1", ".....2")) }) test_that("empty, dot becomes suffix, dot", { expect_equal(as_universal_names(c("", ".")), c("...1", ".")) }) test_that("empty, empty, dot becomes suffix, suffix, dot", { expect_equal(as_universal_names(c("", "", ".")), c("...1", "...2", ".")) }) test_that("dot, dot, empty becomes suffix, suffix, suffix", { expect_equal(as_universal_names(c(".", ".", "")), c("....1", "....2", "...3")) }) test_that("dot, empty, dot becomes suffix, suffix, suffix", { expect_equal(as_universal_names(c(".", "", ".")), c("....1", "...2", "....3")) }) test_that("empty, dot, empty becomes suffix, dot, suffix", { expect_equal(as_universal_names(c("", ".", "")), c("...1", ".", "...3")) }) test_that("'...j' gets stripped then names are modified", { expect_equal(as_universal_names(c("...6", "...1...2")), c("...1", "...2")) expect_equal(as_universal_names("if...2"), ".if") }) test_that("complicated inputs", { expect_equal( as_universal_names(c("", ".", NA, "if...4", "if", "if...8", "for", "if){]1")), c("...1", ".", "...3", ".if...4", ".if...5", ".if...6", ".for", "if...1") ) }) test_that("message", { local_name_repair_verbose() expect_snapshot(as_universal_names(c("a b", "b c"))) }) test_that("quiet", { expect_message( as_universal_names("", quiet = TRUE), NA ) }) test_that("unique then universal is universal, with shuffling", { x <- c("", ".2", "..3", "...4", "....5", ".....6", "......7", "...") expect_identical(as_universal_names(as_unique_names(x)), as_universal_names(x)) x2 <- x[c(7L, 4L, 3L, 6L, 5L, 1L, 2L, 8L)] expect_identical(as_universal_names(as_unique_names(x2)), as_universal_names(x2)) x3 <- x[c(3L, 2L, 4L, 6L, 8L, 1L, 5L, 7L)] expect_identical(as_universal_names(as_unique_names(x3)), as_universal_names(x3)) }) test_that("zero-length inputs given character names", { out <- vec_repair_names(character(), "universal") expect_equal(names(out), character()) }) test_that("unnamed input gives uniquely named output", { out <- vec_repair_names(1:3, "universal") expect_equal(names(out), c("...1", "...2", "...3")) }) test_that("messages by default", { local_name_repair_verbose() expect_snapshot(vec_repair_names(set_names(1, "a:b"), "universal")) expect_snapshot(vec_repair_names(set_names(1, "a:b"), ~ make.names(.))) }) test_that("quiet = TRUE", { expect_message(vec_repair_names(set_names(1, ""), "universal", quiet = TRUE), NA) }) test_that("non-universal names", { out <- vec_repair_names(set_names(1, "a b"), "universal") expect_equal(names(out), "a.b") expect_equal(as_universal_names("a b"), "a.b") }) # make_syntactic() --------------------------------------------------------- test_that("make_syntactic(): empty or NA", { expect_syntactic( c("", NA_character_), c(".", ".") ) }) test_that("make_syntactic(): reserved words", { expect_syntactic( c("if", "TRUE", "Inf", "NA_real_", "normal"), c(".if", ".TRUE", ".Inf", ".NA_real_", "normal") ) }) test_that("make_syntactic(): underscore", { expect_syntactic( c( "_", "_1", "_a}"), c("._", "._1", "._a.") ) }) test_that("make_syntactic(): dots", { expect_syntactic( c(".", "..", "...", "...."), c(".", "..", "....", "....") ) }) test_that("make_syntactic(): number", { expect_syntactic( c( "0", "1", "22", "333"), c("...0", "...1", "...22", "...333") ) }) test_that("make_syntactic(): number then character", { expect_syntactic( c( "0a", "1b", "22c", "333d"), c("..0a", "..1b", "..22c", "..333d") ) }) test_that("make_syntactic(): number then non-character", { expect_syntactic( c( "0)", "1&", "22*", "333@"), c("..0.", "..1.", "..22.", "..333.") ) }) test_that("make_syntactic(): dot then number", { expect_syntactic( c( ".0", ".1", ".22", ".333"), c("...0", "...1", "...22", "...333") ) }) test_that("make_syntactic(): dot then number then character", { expect_syntactic( c( ".0a", ".1b", ".22c", ".333d"), c("..0a", "..1b", "..22c", "..333d") ) }) test_that("make_syntactic(): dot then number then non-character", { expect_syntactic( c( ".0)", ".1&", ".22*", ".333@"), c("..0.", "..1.", "..22.", "..333.") ) }) test_that("make_syntactic(): dot dot then number", { expect_syntactic( c( "..0", "..1", "..22", "..333"), c("...0", "...1", "...22", "...333") ) }) test_that("make_syntactic(): dot dot dot then number", { expect_syntactic( c("...0", "...1", "...22", "...333"), c("...0", "...1", "...22", "...333") ) }) test_that("make_syntactic(): dot dot dot dot then number", { expect_syntactic( c("....0", "....1", "....22", "....333"), c("....0", "....1", "....22", "....333") ) }) test_that("make_syntactic(): dot dot dot dot dot then number", { expect_syntactic( c(".....0", ".....1", ".....22", ".....333"), c(".....0", ".....1", ".....22", ".....333") ) }) test_that("make_syntactic(): dot dot then number then character", { expect_syntactic( c("..0a", "..1b", "..22c", "..333d"), c("..0a", "..1b", "..22c", "..333d") ) }) test_that("make_syntactic(): dot dot then number then non-character", { expect_syntactic( c("..0)", "..1&", "..22*", "..333@"), c("..0.", "..1.", "..22.", "..333.") ) }) # Duplication -------------------------------------------------------------- test_that("Minimal name repair duplicates if needed", { x1 <- NA_character_ x3 <- c(x1, x1) # Called to check absence of side effect vec_as_names(x3, repair = "minimal") expect_identical(x3, c(NA_character_, NA_character_)) }) test_that("Unique name repair duplicates if needed", { x1 <- "fa\u00e7ile" x3 <- c(x1, x1) # Called to check absence of side effect vec_as_names(x3, repair = "unique") expect_identical(x3, c("fa\u00e7ile", "fa\u00e7ile")) }) # Encoding ------------------------------------------------------------- test_that("Name repair works with non-UTF-8 names", { x1 <- "fa\u00e7ile" skip_if_not(Encoding(x1) == "UTF-8") x2 <- iconv(x1, from = "UTF-8", to = "latin1") skip_if_not(Encoding(x2) == "latin1") x3 <- c(x2, x2) expect_equal(vec_as_names(x3, repair = "unique"), paste0(x3, "...", 1:2)) }) # Conditions ----------------------------------------------------------- test_that("names cannot be empty", { expect_error_cnd( stop_names_cannot_be_empty(c("", "")), class = c("vctrs_error_names_cannot_be_empty", "vctrs_error_names", "vctrs_error"), message = "Names can't be empty.", names = c("", "") ) }) test_that("names cannot be dot dot", { expect_error_cnd( stop_names_cannot_be_dot_dot(c("..1", "..2")), class = c("vctrs_error_names_cannot_be_dot_dot", "vctrs_error_names", "vctrs_error"), message = "Names can't be of the form `...` or `..j`.", names = c("..1", "..2") ) }) test_that("names must be unique", { expect_error_cnd( stop_names_must_be_unique(c("x", "y", "y", "x")), class = c("vctrs_error_names_must_be_unique", "vctrs_error_names", "vctrs_error"), message = "Names must be unique.", names = c("x", "y", "y", "x") ) }) # Legacy repair -------------------------------------------------------- test_that("vec_as_names_legacy() works", { expect_identical(vec_as_names_legacy(chr()), chr()) expect_identical(vec_as_names_legacy(c("a", "a", "", "")), c("a", "a1", "V1", "V2")) expect_identical(vec_as_names_legacy(c("a", "a", "", ""), sep = "_"), c("a", "a_1", "V_1", "V_2")) expect_identical(vec_as_names_legacy(c("a", "a", "", ""), prefix = "foo"), c("a", "a1", "foo1", "foo2")) expect_identical(vec_as_names_legacy(c("a", "a", "", ""), prefix = "foo", sep = "_"), c("a", "a_1", "foo_1", "foo_2")) # From tibble expect_identical(vec_as_names_legacy(c("x", "x")), c("x", "x1")) expect_identical(vec_as_names_legacy(c("", "")), c("V1", "V2")) expect_identical(vec_as_names_legacy(c("", "V1")), c("V2", "V1")) expect_identical(vec_as_names_legacy(c("", "V", "V")), c("V2", "V", "V1")) }) # Name specification --------------------------------------------------- test_that("NULL name specs works with scalars", { expect_identical(apply_name_spec(NULL, "foo", NULL, 1L), "foo") expect_named(vec_c(foo = 1), "foo") expect_identical(apply_name_spec(NULL, "foo", chr(), 0L), chr()) expect_equal(vec_c(foo = dbl()), set_names(dbl(), "")) expect_named(vec_c(foo = set_names(dbl())), chr()) expect_named(vec_c(foo = set_names(dbl()), bar = set_names(dbl())), chr()) expect_error(apply_name_spec(NULL, "foo", c("a", "b")), "vector of length > 1") expect_error(apply_name_spec(NULL, "foo", NULL, 2L), "vector of length > 1") expect_snapshot({ (expect_error(vec_c(foo = c(a = 1, b = 2)), "vector of length > 1")) (expect_error(vec_c(foo = 1:2), "vector of length > 1")) (expect_error(vec_c(x = c(xx = 1)), "named vector")) }) }) test_that("function name spec is applied", { spec <- function(outer, inner) { sep <- if (is_character(inner)) "_" else ":" paste0(outer, sep, inner) } expect_identical(apply_name_spec(spec, "foo", NULL, 1L), "foo") expect_named(vec_c(foo = 1, .name_spec = spec), "foo") expect_identical(apply_name_spec(spec, "foo", c("a", "b")), c("foo_a", "foo_b")) expect_named(vec_c(foo = c(a = 1, b = 2), .name_spec = spec), c("foo_a", "foo_b")) expect_identical(apply_name_spec(spec, "foo", NULL, 2L), c("foo:1", "foo:2")) expect_named(vec_c(foo = 1:2, .name_spec = spec), c("foo:1", "foo:2")) }) test_that("can pass lambda formula as name spec", { expect_named(vec_c(foo = c(a = 1, b = 2), .name_spec = ~ paste(.x, .y, sep = "_")), c("foo_a", "foo_b")) expect_error(vec_c(foo = c(a = 1, b = 2), .name_spec = env()), "Can't convert `.name_spec`", fixed = TRUE) }) test_that("can pass glue string as name spec", { expect_named(vec_c(foo = c(a = 1, b = 2), .name_spec = "{outer}_{inner}"), c("foo_a", "foo_b")) expect_named(vec_c(foo = 1:2, .name_spec = "{outer}_{inner}"), c("foo_1", "foo_2")) expect_error(vec_c(foo = c(a = 1, b = 2), .name_spec = c("a", "b")), "single string") }) test_that("`outer` is recycled before name spec is invoked", { expect_identical(vec_c(outer = 1:2, .name_spec = "{outer}"), c(outer = 1L, outer = 2L)) }) test_that("apply_name_spec() recycles return value not arguments (#1099)", { out <- unstructure(apply_name_spec("foo", "outer", c("a", "b", "c"))) expect_identical(out, c("foo", "foo", "foo")) inner <- NULL outer <- NULL spec <- function(outer, inner) { inner <<- inner outer <<- outer } apply_name_spec(spec, "outer", c("a", "b", "c")) expect_identical(inner, c("a", "b", "c")) expect_identical(outer, "outer") }) test_that("r_chr_paste_prefix() works", { nms <- c("foo", "bar") expect_equal( .Call(ffi_chr_paste_prefix, nms, "baz", "."), c("baz.foo", "baz.bar") ) # Greater than `VCTRS_PASTE_BUFFER_MAX_SIZE` long_prefix <- strrep("a", 5000) expect_equal( .Call(ffi_chr_paste_prefix, nms, long_prefix, "."), paste0(long_prefix, ".", nms) ) }) test_that("vec_as_names() uses internal error if `repair_arg` is not supplied", { expect_snapshot({ (expect_error(vec_as_names("", repair = "foobar", call = quote(tilt())))) (expect_error(vec_as_names("", repair = env(), call = quote(tilt())))) }) })