test_that("missing attributes returned as NA by default", {
x <- read_xml("")
expect_equal(xml_attr(x, "id"), NA_character_)
})
test_that("missing attributes returned as NA", {
x <- read_xml("")
expect_equal(xml_attr(x, "id", default = 1), "1")
})
test_that("attributes are correctly found", {
x <- read_xml("")
expect_true(xml_has_attr(x, "id"))
expect_false(xml_has_attr(x, "id2"))
})
test_that("returning an attribute node prints properly", {
x <- read_xml("")
t1 <- xml_find_first(x, "//@c")
expect_equal(format(t1), "")
})
# Namespaces -------------------------------------------------------------------
# Default namespace doesn't apply to attributes
test_that("qualified names returned when ns given", {
x <- read_xml(test_path("ns-multiple.xml"))
ns <- xml_ns(x)
bars <- xml_children(xml_children(x))
attr <- xml_attrs(bars, ns)
expect_equal(names(attr[[1]]), "f:id")
expect_equal(names(attr[[2]]), "g:id")
})
x <- read_xml('
')
doc <- xml_children(x)[[1]]
docs <- xml_find_all(x, "//doc")
ns <- xml_ns(x)
test_that("qualified attributes get own values", {
expect_equal(xml_attrs(doc, ns), c("b:id" = "b", "f:id" = "f", "id" = ""))
})
test_that("unqualified name gets unnamespace attribute", {
expect_equal(xml_attr(doc, "id", ns), "")
})
test_that("namespace names gets namespaced attribute", {
expect_equal(xml_attr(doc, "b:id", ns), "b")
expect_equal(xml_attr(doc, "f:id", ns), "f")
})
test_that("xml_attr<- modifies properties", {
xml_attr(doc, "id", ns) <- "test"
expect_equal(xml_attr(doc, "id", ns), "test")
xml_attr(doc, "b:id", ns) <- "b_test"
expect_equal(xml_attr(doc, "b:id", ns), "b_test")
xml_attr(doc, "f:id", ns) <- "f_test"
expect_equal(xml_attr(doc, "f:id", ns), "f_test")
xml_attr(docs, "f:id", ns) <- "f_test2"
expect_equal(xml_attr(docs, "f:id", ns), c("f_test2", "f_test2"))
xml_attr(docs, "f:id", ns) <- NULL
expect_equal(xml_attr(docs, "f:id", ns), c(NA_character_, NA_character_))
})
test_that("xml_attr<- recycles values", {
x <- read_xml("")
a <- xml_find_all(x, "a")
xml_attr(a, "b") <- c("e", "f")
expect_equal(xml_attr(a, "b"), c("e", "f"))
})
test_that("xml_attrs<- modifies all attributes", {
expect_error(xml_attrs(doc) <- 1, "`value` must be a named character vector or `NULL`")
expect_error(xml_attrs(doc) <- "test", "`value` must be a named character vector or `NULL`")
xml_attrs(doc, ns) <- c("b:id" = "b", "f:id" = "f", "id" = "test")
expect_equal(xml_attrs(doc, ns), c("b:id" = "b", "id" = "test", "f:id" = "f"))
xml_attrs(doc, ns) <- c("b:id" = "b", "f:id" = "f")
expect_equal(xml_attrs(doc, ns), c("b:id" = "b", "f:id" = "f"))
xml_attrs(doc, ns) <- c("b:id" = "b", "id" = "test")
expect_equal(xml_attrs(doc, ns), c("b:id" = "b", "id" = "test"))
expect_snapshot_error(xml_attrs(docs) <- "test")
xml_attrs(docs, ns) <- c("b:id" = "b", "id" = "test")
expect_equal(
xml_attrs(docs, ns),
list(
c("b:id" = "b", "id" = "test"),
c("b:id" = "b", "id" = "test")
)
)
xml_attrs(docs, ns) <- NULL
expect_equal(xml_attrs(docs, ns), list(setNames(character(0), character()), setNames(character(0), character())))
})
test_that("xml_attr<- accepts non-character values", {
x <- read_xml("")
svg <- xml_root(x)
xml_attr(svg, "width") <- 8L
expect_equal(xml_attr(svg, "width"), "8")
xml_attr(svg, "height") <- 12.5
expect_equal(xml_attr(svg, "height"), "12.5")
expect_equal(xml_attrs(svg), c(width = "8", height = "12.5"))
xml_attrs(svg) <- c(width = 14L, height = 23.45)
expect_equal(xml_attrs(svg), c(width = "14", height = "23.45"))
})
test_that("xml_attr<- can set empty strings, and removes attributes with NULL", {
x <- read_xml("")
xml_attr(x, "test") <- ""
expect_equal(xml_attr(x, "test"), "")
xml_attr(x, "test") <- NULL
expect_equal(xml_attr(x, "test"), NA_character_)
})
test_that("xml_attr<- removes namespaces if desired", {
xml_attr(x, "xmlns:b") <- NULL
expect_equal(xml_attrs(x), c("xmlns:f" = "http://foo.com"))
})
test_that("xml_attr<- removes namespaces if desired", {
x <- read_xml("")
# cannot find //b with a default namespace
expect_equal(length(xml_find_all(x, "//b")), 0)
# unless we specify it explicitly
expect_equal(length(xml_find_all(x, "//b")), 0)
expect_equal(length(xml_find_all(x, "//d1:b", xml_ns(x))), 1)
# but can find it once we remove the namespace
xml_attr(x, "xmlns") <- NULL
expect_equal(length(xml_find_all(x, "//b")), 1)
# and add the old namespace back
xml_attr(x, "xmlns") <- "tag:foo"
expect_equal(xml_attr(x, "xmlns"), "tag:foo")
expect_equal(length(xml_find_all(x, "//b")), 0)
expect_equal(length(xml_find_all(x, "//d1:b", xml_ns(x))), 1)
expect_equal(xml_attr(x, "xmlns"), "tag:foo")
})
test_that("xml_attr<- removes prefixed namespaces if desired", {
x <- read_xml("")
# cannot find //b with a prefixed namespace
expect_equal(length(xml_find_all(x, "//b")), 0)
# unless we specify it explicitly
expect_equal(length(xml_find_all(x, "//b")), 0)
expect_equal(length(xml_find_all(x, "//pre:b", xml_ns(x))), 1)
# but can find it once we remove the namespace
xml_attr(x, "xmlns:pre") <- NULL
expect_equal(length(xml_find_all(x, "//b")), 1)
# and add the old namespace back
xml_attr(x, "xmlns:pre") <- "tag:foo"
xml_set_namespace(xml_children(x)[[1]], "pre")
expect_equal(xml_attr(x, "xmlns:pre"), "tag:foo")
expect_equal(length(xml_find_all(x, "//b")), 0)
expect_equal(length(xml_find_all(x, "//pre:b", xml_ns(x))), 1)
expect_equal(xml_attr(x, "xmlns:pre"), "tag:foo")
})
test_that("xml_set_attr works identically to xml_attr<-", {
content <- ""
x <- read_xml(content)
y <- read_xml(content)
xml_attr(x, "a") <- "test"
xml_set_attr(y, "a", "test")
expect_equal(as.character(x), as.character(y))
bx <- xml_find_all(x, "//b")
by <- xml_find_all(y, "//b")
xml_attr(bx, "b") <- "test2"
xml_set_attr(by, "b", "test2")
expect_equal(as.character(x), as.character(y))
# No errors for xml_missing
mss <- xml_find_first(bx, "./c")
expect_error(xml_attr(mss[[2]], "b") <- "blah", NA)
expect_error(xml_set_attr(mss[[2]], "b", "blah"), NA)
})
test_that("xml_set_attrs works identically to xml_attrs<-", {
content <- ""
x <- read_xml(content)
y <- read_xml(content)
xml_attrs(x) <- c(a = "test")
xml_set_attrs(y, c(a = "test"))
expect_equal(as.character(x), as.character(y))
bx <- xml_find_all(x, "//b")
by <- xml_find_all(y, "//b")
xml_attrs(bx) <- c(b = "test2")
xml_set_attrs(by, c(b = "test2"))
expect_equal(as.character(x), as.character(y))
# No errors for xml_missing
mss <- xml_find_first(bx, "./c")
expect_error(xml_attrs(mss[[2]]) <- c("b" = "blah"), NA)
expect_error(xml_set_attrs(mss[[2]], c("b" = "blah")), NA)
})
test_that("xml_set_attr can set the same namespace multiple times", {
doc <- xml_new_root("foo")
xml_set_attr(doc, "xmlns:bar", "http://a/namespace")
xml_set_attr(doc, "xmlns:bar", "http://b/namespace")
expect_equal(xml_attr(doc, "xmlns:bar"), "http://b/namespace")
})