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