tests/testthat/test-names.R

In vctrs: Vector Helpers

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()))))
  })
})