test_that("read_xml", { exp <- "" got <- read_xml("", empty_tags = FALSE, pointer = FALSE) expect_equal(exp, got) exp <- "" got <- read_xml("", empty_tags = TRUE, pointer = FALSE) expect_equal(exp, got) # a pointer x <- read_xml("") exp <- "\n \n" expect_true(inherits(x, "pugi_xml")) xml <- " " got <- read_xml(xml, whitespace = TRUE, pointer = FALSE) expect_equal(xml, got) xml <- " " got <- read_xml(xml, whitespace = FALSE, pointer = FALSE) expect_equal("", got) xml <- " " got <- read_xml(xml, pointer = FALSE) expect_equal(" ", got) xml <- " " got <- paste(capture.output(read_xml(xml)), collapse = "\n") expect_equal("\n \n", got) xml <- " " got <- paste(capture.output(print(read_xml(xml), indent = "\t")), collapse = "\n") expect_equal("\n\t \n", got) # #does this even work? # expect_equal(cat(exp), print(x)) # a character y <- read_xml("", pointer = FALSE) expect_true(is.character(y)) # Errors if the import was unsuccessful expect_error(z <- read_xml("")) # characters() are imported to to avoid errors expect_equal("", read_xml(character(), pointer = FALSE)) xml <- 'A & B' # difference in escapes exp <- "A & B" expect_equal(exp, read_xml(xml, escapes = TRUE, pointer = FALSE)) exp <- "A & B" expect_equal(exp, read_xml(xml, escapes = FALSE, pointer = FALSE)) # read declaration expect_equal(xml, read_xml(xml, declaration = TRUE, pointer = FALSE)) exp <- ' ' expect_equal(exp, read_xml(exp, pointer = FALSE)) tmp <- tempfile(fileext = ".xml") write_file(body = exp, fl = tmp) exp <- " " got <- readLines(tmp, warn = FALSE) expect_equal(exp, got) xml <- '' exp <- c("", "") got <- xml_node(xml, "a") expect_equal(exp, got) exp <- c("", "") got <- xml_node(xml, "a", "b") expect_equal(exp, got) exp <- "" got <- xml_node(xml, "a", "b", "c1") expect_equal(exp, got) exp <- "" got <- xml_node(xml, "a", "b", "c2") expect_equal(exp, got) }) test_that("xml_node", { xml <- "" x <- read_xml(xml, pointer = FALSE) expect_equal(xml_node_name(x), "a") expect_equal(xml_node(x), xml) expect_equal(xml_node(x, "a"), xml) expect_error(xml_node(x, 1)) expect_equal(xml_node(x, "a", "b"), "") expect_equal(xml_node("", "a"), xml) expect_equal(xml_node("", "a", "b"), "") xml_str <- "" xml <- read_xml(xml_str) expect_equal(xml_node_name(xml_str, "a"), "b") expect_equal(xml_node_name(xml_str, "a", "b"), "c") expect_equal(xml_node_name(xml, "a"), "b") expect_equal(xml_node_name(xml, "a", "b"), "c") exp <- xml_str expect_equal(xml_node(xml, "a"), exp) exp <- "" expect_equal(xml_node(xml, "a", "b"), exp) exp <- "" expect_equal(xml_node(xml, "a", "b", "c"), exp) # bit cheating, this test returns the same, but not the actual feature of "*" expect_equal(xml_node(xml, "a", "*", "c"), exp) }) test_that("xml_attr", { x <- read_xml("1") exp <- list(c(a = "1", b = "2")) expect_equal(xml_attr(x, "a"), exp) expect_error(xml_attr(x, 1)) x <- read_xml("2") exp <- list(c(r = "1")) expect_equal(xml_attr(x, "a", "b"), exp) x <- read_xml("1") exp <- list(c(a = "1", b = "2")) expect_equal(xml_attr(x, "a"), exp) x <- read_xml("") exp <- list(c(a = "1", b = "2")) expect_equal(xml_attr(x, "b", "a"), exp) exp <- list(c(a = "1", b = "2")) expect_equal(xml_attr("1", "a"), exp) exp <- list(c(r = "1")) expect_equal(xml_attr("2", "a", "b"), exp) exp <- list(c(a = "1", b = "2")) expect_equal(xml_attr("1", "a"), exp) exp <- list(c(a = "1", b = "2")) expect_equal(xml_attr("", "b", "a"), exp) exp <- list(c(a = "1")) xml_str <- "" xml <- read_xml(xml_str) expect_equal(xml_attr(xml, "a"), exp) xml_str <- "" xml <- read_xml(xml_str) expect_equal(xml_attr(xml, "b", "a"), exp) xml_str <- "" xml <- read_xml(xml_str) expect_equal(xml_attr(xml, "c", "b", "a"), exp) }) test_that("xml_value", { x <- read_xml("1") expect_equal(xml_value(x, "a"), "1") expect_error(xml_value(x, 1)) x <- read_xml("2") expect_equal(xml_value(x, "a", "b"), "2") x <- read_xml("23") expect_equal(xml_value(x, "a", "b"), c("2", "3")) exp <- "1" xml_str <- "1" xml <- read_xml(xml_str) expect_equal(xml_value(xml, "a"), "1") xml_str <- "1" xml <- read_xml(xml_str) expect_equal(xml_value(xml, "a", "b"), "1") xml_str <- "1" xml <- read_xml(xml_str) expect_equal(xml_value(xml, "a", "b", "c"), "1") }) test_that("as_xml", { xml_str <- "1" # not the best test expect_equal(class(as_xml(xml_str)), "pugi_xml") }) test_that("print", { xml_str <- "" expect_output(print(as_xml(xml_str)), "") expect_output(print(as_xml(xml_str), raw = TRUE), "") xml_str <- '' expect_output(print(as_xml(xml_str), attr_indent = TRUE), '') }) test_that("xml_add_child", { xml_node <- "" xml_child <- "" exp <- "" expect_equal(xml_add_child(xml_node, xml_child), exp) expect_error(xml_add_child(xml_node)) expect_error(xml_add_child(xml_child = xml_child)) xml_node <- "" xml_child <- "" xml_node <- xml_add_child(xml_node, xml_child) expect_equal(xml_node, "") xml_node <- xml_add_child(xml_node, xml_child, level = c("b")) expect_equal(xml_node, "") xml_node <- xml_add_child(xml_node, "", level = c("b", "c")) expect_equal(xml_node, "") }) test_that("xml_rm_child", { rm_child <- function(which) { xml_rm_child( xml_node = "12", xml_child = "c", which = which ) } expect_equal(rm_child(which = 0), "") expect_equal(rm_child(which = 1), "2") expect_equal(rm_child(which = 2), "1") expect_equal(rm_child(which = 3), "12") xml_node <- "12" xml_child <- "c" got <- xml_rm_child(xml_node, "b", which = 1) exp <- "2" expect_equal(got, exp) xml_node <- exp got <- xml_rm_child(xml_node, xml_child, "b", which = 1) exp <- "2" expect_equal(got, exp) got <- xml_rm_child(xml_node, xml_child, level = "b", which = 2) exp <- "2" expect_equal(got, exp) got <- xml_rm_child(xml_node, xml_child, "b", which = 0) exp <- "2" expect_equal(got, exp) xml_node <- "123" got <- xml_rm_child(xml_node, xml_child, level = c("a", "b"), which = 2) exp <- "13" expect_equal(got, exp) got <- xml_rm_child(xml_node, xml_child, level = c("a", "b"), which = 0) exp <- "" expect_equal(got, exp) }) test_that("xml_attr_mod", { # add single node xml_node <- "openxlsx2" xml_attr <- c(qux = "quux") xml_exp <- "openxlsx2" xml_got <- xml_attr_mod(xml_node, xml_attr) expect_identical(xml_exp, xml_got) # update node and add node xml_node <- "openxlsx2" xml_attr <- c(foo = "baz", qux = "quux") xml_exp <- "openxlsx2" xml_got <- xml_attr_mod(xml_node, xml_attr) expect_identical(xml_exp, xml_got) # remove node and add node xml_node <- "openxlsx2" xml_attr <- c(foo = "", qux = "quux") xml_exp <- "openxlsx2" xml_got <- xml_attr_mod(xml_node, xml_attr) expect_identical(xml_exp, xml_got) # only add node xml_node <- "openxlsx2" xml_attr <- c(foo = "", qux = "quux") xml_exp <- "openxlsx2" xml_got <- xml_attr_mod(xml_node, xml_attr, remove_empty_attr = FALSE) expect_identical(xml_exp, xml_got) }) test_that("xml_node_create", { # create node xml_name <- "a" xml_exp <- "" xml_got <- xml_node_create(xml_name) expect_identical(xml_exp, xml_got) # add child xml_child <- "openxlsx" xml_exp <- "openxlsx" xml_got <- xml_node_create(xml_name, xml_children = xml_child) expect_identical(xml_exp, xml_got) # add attributes xml_attr <- c(foo = "baz", qux = "quux") xml_exp <- "" xml_got <- xml_node_create(xml_name, xml_attributes = xml_attr) expect_identical(xml_exp, xml_got) # add child and attributes xml_exp <- "openxlsx" xml_got <- xml_node_create(xml_name, xml_children = xml_child, xml_attributes = xml_attr) expect_identical(xml_exp, xml_got) xml_exp <- "" xml_got <- xml_node_create("a", xml_children = c("")) expect_identical(xml_exp, xml_got) }) test_that("works with x namespace", { # create artificial xml file that will trigger x namespace removal tmp <- tempfile(fileext = ".xml") xml <- '' writeLines(xml, tmp) exp <- "" got <- read_xml(tmp, pointer = FALSE) expect_equal(exp, got) op <- options("openxlsx2.namespace_xml" = "x") on.exit(options(op), add = TRUE) exp <- "" got <- read_xml(tmp, pointer = FALSE) expect_equal(exp, got) })