Nothing
# library(XiMpLe)
# library(testthat)
context("XML generation")
test_that("generate empty XML node", {
sampleXMLStandard <- dget("sample_XML_node_empty_dput.txt")
expect_that(
XMLNode("empty"),
equals(sampleXMLStandard)
)
})
test_that("generate closed XML node", {
sampleXMLStandard <- dget("sample_XML_node_closed_dput.txt")
expect_that(
XMLNode("empty", ""),
equals(sampleXMLStandard)
)
})
test_that("generate closed XML node with attributes", {
# re-create object sampleXMLnode.attrs
load("sample_XML_node_attrs.RData")
# three ways to the same result
expect_that(
XMLNode("empty", "test", attrs=list(foo="bar")),
equals(sampleXMLnode.attrs)
)
expect_that(
XMLNode("empty", "test", foo="bar"),
equals(sampleXMLnode.attrs)
)
expect_that(
XMLNode("empty", .children=list("test", foo="bar")),
equals(sampleXMLnode.attrs)
)
})
test_that("generate generator functions", {
# for this test, we'll put generated functions to their own environment
my_functions <- new.env()
gen_tag_functions(c("x","y","abc"), envir=my_functions)
my_func_list <- as.list(my_functions)
expect_that(
sort(c("x_","y_","abc_")),
equals(sort(names(my_func_list)))
)
expect_true(all(sapply(my_func_list, is.function)))
XML_node_x <- my_func_list[["x_"]]("foo")
expect_that(
XML_node_x,
equals(XMLNode("x", "foo"))
)
})
test_that("generate nested XML tag tree", {
# re-create object sampleXMLTree
load("sample_XML_tree.RData")
sampleXMLnode.empty <- XMLNode("empty")
sampleXMLnode.closed <- XMLNode("empty", "")
sampleXMLnode.attrs <- XMLNode("empty", "test", attrs=list(foo="bar"))
sampleXMLTree.test <- XMLTree(
XMLNode("tree",
sampleXMLnode.empty,
sampleXMLnode.closed,
sampleXMLnode.attrs
)
)
expect_that(
sampleXMLTree.test,
equals(sampleXMLTree)
)
})
context("XML parsing")
test_that("parse XML file", {
# re-create object sampleRSSparsed
load("sample_RSS_parsed.RData")
sampleRSSFile <- normalizePath("koRpus_RSS_sample.xml")
XMLtoParse <- file(sampleRSSFile, encoding="UTF-8")
sampleRSSparsed.test <- parseXMLTree(XMLtoParse)
close(XMLtoParse)
expect_that(
sampleRSSparsed.test,
equals(sampleRSSparsed))
})
context("extracting nodes")
test_that("extract node from parsed XML tree", {
# re-create object sampleRSSparsed
load("sample_RSS_parsed.RData")
# re-create object sampleXMLnode.extracted
load("sample_XML_node_extracted.RData")
sampleXMLnode.test <- node(sampleRSSparsed, node=list("rss","channel","atom:link"))
expect_that(
sampleXMLnode.test,
equals(sampleXMLnode.extracted))
})
context("changing node values")
test_that("change attribute values in XML node", {
# re-create object sampleRSSparsed
load("sample_RSS_parsed.RData")
# re-create object sampleRSSparsed.changed
load("sample_RSS_changed.RData")
# replace URL
node(sampleRSSparsed,
node=list("rss","channel","atom:link"),
what="attributes", element="href") <- "http://example.com"
# remove "rel" attribute
node(sampleRSSparsed,
node=list("rss","channel","atom:link"),
what="attributes", element="rel") <- NULL
expect_that(
sampleRSSparsed,
equals(sampleRSSparsed.changed))
})
test_that("change nested text value in XML node", {
# re-create object sampleRSSparsed
load("sample_RSS_parsed.RData")
# re-create object sampleXMLnode.extracted
load("sample_RSS_changed_value.RData")
# change text
node(sampleRSSparsed,
node=list("rss","channel","item","title"),
what="value",
cond.value="Changes in koRpus version 0.04-30") <- "this value was changed!"
expect_that(
sampleRSSparsed,
equals(sampleRSSparsed.changed.value))
})
context("getter/setter methods")
test_that("set and get XML node name", {
sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
# set node name
XMLName(sampleXMLnode) <- "changed"
sampleXMLnode.name <- XMLName(sampleXMLnode)
expect_that(
sampleXMLnode.name,
equals("changed"))
})
test_that("set and get XML node attributes", {
sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
# set node attributes
XMLAttrs(sampleXMLnode) <- list()
sampleXMLnode.attrs <- XMLAttrs(sampleXMLnode)
expect_that(
sampleXMLnode.attrs,
equals(list()))
})
test_that("set and get XML node text value", {
sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
# set node name
XMLValue(sampleXMLnode) <- "added value"
sampleXMLnode.value <- XMLValue(sampleXMLnode)
expect_that(
sampleXMLnode.value,
equals("added value"))
})
test_that("set and get XML node children", {
sampleXMLnode <- XMLNode("name", attrs=list(atr="test"))
# children will be returned as a list
sampleXMLChild <- list(XMLNode("child", attrs=list(atr="test")))
# set node children
XMLChildren(sampleXMLnode) <- sampleXMLChild
sampleXMLnode.children <- XMLChildren(sampleXMLnode)
expect_that(
sampleXMLnode.children,
equals(sampleXMLChild))
})
test_that("set and get XML tree children", {
load("sample_XML_tree.RData")
# children will be returned as a list
sampleXMLChild <- list(XMLNode("child", attrs=list(atr="test")))
# set node children
XMLChildren(sampleXMLTree) <- sampleXMLChild
sampleXMLTree.children <- XMLChildren(sampleXMLTree)
expect_that(
sampleXMLTree.children,
equals(sampleXMLChild))
})
test_that("set and get XML tree DTD info", {
load("sample_XML_tree.RData")
sampleDTD <- list(doctype="html", decl="PUBLIC",
id="-//W3C//DTD XHTML 1.0 Transitional//EN",
refer="http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd")
# set missing values
XMLDTD(sampleXMLTree) <- sampleDTD
# try to get them back
sampleXMLTree.DTD <- XMLDTD(sampleXMLTree)
expect_that(
sampleXMLTree.DTD,
equals(sampleDTD))
})
test_that("set and get XML tree decl info", {
load("sample_XML_tree.RData")
sampleDecl <- list(version="1.0", encoding="UTF-8")
# set missing values
XMLDecl(sampleXMLTree) <- sampleDecl
# try to get them back
sampleXMLTree.decl <- XMLDecl(sampleXMLTree)
expect_that(
sampleXMLTree.decl,
equals(sampleDecl))
})
test_that("set and get XML tree file info", {
load("sample_XML_tree.RData")
# set missing values
XMLFile(sampleXMLTree) <- "somefile.xml"
# try to get them back
sampleXMLTree.file <- XMLFile(sampleXMLTree)
expect_that(
sampleXMLTree.file,
equals("somefile.xml"))
})
context("getter/setter methods: XMLScan")
test_that("scan XML tree for node names", {
load("sample_XML_tree.RData")
# this should return a list of 3
sampleXMLTree.nodes <- XMLScan(sampleXMLTree, "empty")
expect_is(
sampleXMLTree.nodes,
"list")
expect_that(
length(sampleXMLTree.nodes),
equals(3))
})
test_that("remove XML nodes from tree by name", {
load("sample_XML_tree.RData")
# this should remove all nodes,
# exept the parent "tree" node
XMLScan(sampleXMLTree, "empty") <- NULL
expect_identical(
sampleXMLTree,
XMLTree(XMLNode("tree")))
})
context("XML validation")
test_that("define XML validation scheme", {
load("sample_XML_validity.RData")
# should generate an object of class XiMpLe.validity
# try something HTMLish
# first define <li> validation to use recursively
XML.validity.li <- XMLValidity(
children=list(
li=c("a", "br", "strong")
),
attrs=list(
a=c("href") # allow only href for testing
),
allChildren=c("!--"),
allAttrs=c("id", "class"),
empty=c("br")
)
sample_XML_validity.generated <- XMLValidity(
children=list(
body=c("a", "p", "ol", "ul", "strong"),
head=c("title"),
html=c("head", "body"),
ol=XML.validity.li,
p=c("a", "br", "ol", "ul", "strong"),
ul=XML.validity.li
),
attrs=list(
a=c("href", "name"),
p=c("align")
),
allChildren=c("!--"),
allAttrs=c("id", "class"),
empty=c("br"),
ignore=c("foobar")
)
expect_that(
sample_XML_validity.generated,
equals(sample_XML_validity))
})
test_that("validate XML objects: child nodes", {
load("sample_XML_validity.RData")
validChildNodes <- XMLNode("html",
XMLNode("head",
XMLNode("!--", "comment always passes"),
XMLNode("title", "test")
),
XMLNode("!--", "comment always passes"),
XMLNode("body",
XMLNode("!--", "comment always passes"),
XMLNode("p",
XMLNode("!--", "comment always passes"),
XMLNode("a", "my link"),
XMLNode("br"),
"text goes on"
),
XMLNode("p",
XMLNode("ol",
XMLNode("!--",
XMLNode("undefined", "should be OK because of 'graceful' default mode")
),
XMLNode("li",
"firstly this"
),
XMLNode("!--", "comment always passes"),
XMLNode("li",
"secondly this"
)
)
)
)
)
invalidChildNodes <- XMLNode("html",
XMLNode("head",
XMLNode("title",
XMLNode("body", "test")
)
)
)
undefinedChildNodes <- XMLNode("html",
XMLNode("head",
XMLNode("meta", "test")
)
)
invalidEmptyNode <- XMLNode("p",
XMLNode("br", "test")
)
validityResultT <- validXML(
validChildNodes,
validity=sample_XML_validity,
attributes=FALSE
)
# the object "validityResultF" should be available after this call
expect_warning(
validityResultF <- validXML(
invalidChildNodes,
validity=sample_XML_validity,
attributes=FALSE,
warn=TRUE
),
regexp="Invalid XML nodes for <title> section: body"
)
expect_true(validityResultT)
expect_false(validityResultF)
expect_error(
validXML(
invalidChildNodes,
validity=sample_XML_validity,
attributes=FALSE
),
regexp="Invalid XML nodes for <title> section: body"
)
expect_error(
validXML(
undefinedChildNodes,
validity=sample_XML_validity,
attributes=FALSE
),
regexp="Invalid XML nodes for <head> section: meta"
)
expect_error(
validXML(
invalidEmptyNode,
validity=sample_XML_validity,
attributes=FALSE
),
regexp="Invalid XML node <br />: Should be empty, but it isn't!"
)
})
test_that("validate XML objects: attributes", {
load("sample_XML_validity.RData")
validAttributes <- XMLNode("html",
XMLNode("head",
XMLNode("title", "test", attrs=list(id="title"))
),
XMLNode("body",
XMLNode("p",
XMLNode("a", "my link", attrs=list(href="link.html", class="underline", name="valid"))
),
XMLNode("p",
XMLNode("ol",
XMLNode("li",
"firstly this"
),
XMLNode("li",
"secondly this",
attrs=list(id="li2")
)
),
attrs=list(class="ordered")
),
attrs=list(id="body")
)
)
invalidAttributes <- XMLNode("html",
XMLNode("head",
XMLNode("title", "test", attrs=list(href="title.html"))
)
)
invalidRecursion <- XMLNode("html",
XMLNode("body",
XMLNode("ol",
XMLNode("li",
XMLNode("a", attrs=list(name="invalid"))
)
)
)
)
undefinedAttributes <- XMLNode("body",
XMLNode("p",
XMLNode("strong", "test"),
attrs=list(style="text-align: right;")
)
)
validityResultT <- validXML(
validAttributes,
validity=sample_XML_validity,
children=FALSE
)
# the object "validityResultF" should be available after this call
expect_warning(
validityResultF <- validXML(
invalidAttributes,
validity=sample_XML_validity,
children=FALSE,
warn=TRUE
),
regexp="Invalid XML attributes for <title> node: href"
)
# the object "validityResultF" should be available after this call
expect_warning(
validityResultRecursionF <- validXML(
invalidRecursion,
validity=sample_XML_validity,
children=FALSE,
warn=TRUE
),
regexp="Invalid XML attributes for <a> node: name"
)
expect_true(validityResultT)
expect_false(validityResultF)
expect_error(
validXML(
invalidAttributes,
validity=sample_XML_validity,
children=FALSE
),
regexp="Invalid XML attributes for <title> node: href"
)
expect_error(
validXML(
undefinedAttributes,
validity=sample_XML_validity,
children=FALSE
),
regexp="Invalid XML attributes for <p> node: style"
)
})
context("Class updates")
test_that("update XML tag tree from XiMpLe.doc to XiMpLe_doc", {
load("sample_XML_tree_old.RData")
load("sample_XML_tree.RData")
sampleXMLTree_old <- as_XiMpLe_doc(sampleXMLTree_old)
expect_that(
sampleXMLTree_old,
equals(sampleXMLTree)
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.