[rkward/releases/0.6.4] packages/XiMpLe: added tests to validation functionality
m.eik michalke
meik.michalke at uni-duesseldorf.de
Tue Dec 8 22:53:41 UTC 2015
Git commit d5a16f3b072af43795f960898ea68d2fb59c6b30 by m.eik michalke.
Committed on 08/12/2015 at 22:51.
Pushed by meikm into branch 'releases/0.6.4'.
added tests to validation functionality
- also added support for validation of empty nodes
- fixed some recursion issues
- added some examples
- updated docs
M +1 -1 packages/XiMpLe/DESCRIPTION
M +10 -2 packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
M +149 -14 packages/XiMpLe/R/01_method_04_validXML.R
M +27 -4 packages/XiMpLe/R/XMLValidity.R
M +25 -4 packages/XiMpLe/R/XiMpLe-internal.R
M +1 -1 packages/XiMpLe/R/XiMpLe-package.R
A +53 -0 packages/XiMpLe/man/XMLValidity.Rd
M +1 -1 packages/XiMpLe/man/XiMpLe-package.Rd
M +8 -22 packages/XiMpLe/man/XiMpLe.validity-class.Rd
M +74 -6 packages/XiMpLe/man/validXML.Rd
A +- -- packages/XiMpLe/tests/testthat/sample_XML_validity.RData
M +368 -174 packages/XiMpLe/tests/testthat/tests.R
http://commits.kde.org/rkward/d5a16f3b072af43795f960898ea68d2fb59c6b30
diff --git a/packages/XiMpLe/DESCRIPTION b/packages/XiMpLe/DESCRIPTION
index 7d1090b..17fab58 100644
--- a/packages/XiMpLe/DESCRIPTION
+++ b/packages/XiMpLe/DESCRIPTION
@@ -19,7 +19,7 @@ LazyLoad: yes
URL: http://reaktanz.de/?c=hacking&s=XiMpLe
Authors at R: c(person(given="Meik", family="Michalke", email="meik.michalke at hhu.de", role=c("aut", "cre")))
Version: 0.03-24
-Date: 2015-12-07
+Date: 2015-12-08
RoxygenNote: 5.0.1
Collate:
'00_class_01_XiMpLe.node.R'
diff --git a/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R b/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
index cbc5bec..0df0258 100644
--- a/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
+++ b/packages/XiMpLe/R/00_class_03_XiMpLe.validity.R
@@ -19,6 +19,8 @@
#' Class XiMpLe.validity
#'
#' Used for objects that describe valid child nodes and attributes of XiMpLe.nodes.
+#'
+#' You should use \code{\link[XiMpLe:XMLValidity]{XMLValidity}} to create objects of this class.
#'
#' @slot children Named list of character vectors, where the element name defines the parent node
#' name and each character string a valid child node name.
@@ -26,10 +28,14 @@
#' name and each character string a valid attribute name.
#' @slot allChildren Character vector, names of globally valid child nodes for all nodes, if any.
#' @slot allAttrs Character vector, names of globally valid attributes for all nodes, if any.
+#' @slot empty Character vector, names of nodes that must be empty nodes (i.e., no closing tag), if any.
#' @name XiMpLe.validity,-class
#' @aliases XiMpLe.validity-class XiMpLe.validity,-class
#' @import methods
#' @keywords classes
+#' @seealso
+#' \code{\link[XiMpLe:XMLValidity]{XMLValidity}},
+#' \code{\link[XiMpLe:validXML]{validXML}}
#' @rdname XiMpLe.validity-class
#' @export
@@ -38,13 +44,15 @@ setClass("XiMpLe.validity",
children="list",
attrs="list",
allChildren="character",
- allAttrs="character"
+ allAttrs="character",
+ empty="character"
),
prototype(
children=list(),
attrs=list(),
allChildren=character(),
- allAttrs=character()
+ allAttrs=character(),
+ empty=character()
)
)
diff --git a/packages/XiMpLe/R/01_method_04_validXML.R b/packages/XiMpLe/R/01_method_04_validXML.R
index fd67a79..99c7412 100644
--- a/packages/XiMpLe/R/01_method_04_validXML.R
+++ b/packages/XiMpLe/R/01_method_04_validXML.R
@@ -23,18 +23,23 @@
#'
#' XiMpLe can't handle DOM specifications yet, but this method can be used to construct
#' validation schemes.
+#'
+#' @note: If no \code{parent} is specified, \code{obj} will be checked recursively. If
#'
#' @param obj An object of class \code{XiMpLe.doc} or \code{XiMpLe.node}. If \code{parent=NULL}, this object
#' will be checked for validity, including its child nodes. If \code{parent} is either a character string
#' or another XiMpLe node, it will be checked whether \code{obj} is a valid child node of \code{parent}.
-## TODO: validity class objects
-#' @param validity A list with validity information.
+#' @param validity An object of class \code{\link[XiMpLe:XiMpLe.validity-class]{XiMpLe.validity}},
+#' see \code{\link[XiMpLe:XMLValidity]{XMLValidity}}.
#' @param parent Either a character string (name of the parent node) or a XiMpLe node, whose name will be used
#' as name of the parent node.
+#' @param children Logical, whether child node names should be checked for validity.
+#' @param attributes Logical, whether attributes should be checked for validity.
#' @param warn Logical, whether invalid objects should cause a warning or stop with an error.
#' @param section Either a character string (name of the section) or a XiMpLe node, whose name will be used
#' as name of the XML section this check refers to. This is only relevant for warnings and error messages,
#' in case you want to use something different than the actual parent node name.
+#' @param caseSens Logical, whether checks should be case sensitive or not.
#' @return Returns \code{TRUE} if tests pass, and depending on the setting of \code{warn} either \code{FALSE} or
#' an error if a test fails.
#' @aliases
@@ -42,8 +47,10 @@
#' validXML,XiMpLe.doc-method
#' validXML,XiMpLe.node-method
#' validXML,XiMpLe.XML-method
-#' @seealso
-#' \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+#' @seealso
+#' \code{\link[XiMpLe:validXML]{validXML}},
+#' \code{\link[XiMpLe:XMLValidity]{XMLValidity}},
+#' \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}, and
#' \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
#' @keywords methods
#' @docType methods
@@ -51,16 +58,71 @@
#' @rdname validXML
#' @include 00_class_01_XiMpLe.node.R
#' @include 00_class_02_XiMpLe.doc.R
-setGeneric("validXML", function(obj, validity, parent=NULL, children=TRUE, attributes=TRUE, warn=FALSE, section=parent){standardGeneric("validXML")})
+setGeneric("validXML", function(obj, validity=XMLValidity(), parent=NULL, children=TRUE, attributes=TRUE, warn=FALSE, section=parent, caseSens=TRUE){standardGeneric("validXML")})
#' @rdname validXML
#' @export
-setMethod("validXML", signature(obj="XiMpLe.XML"), function(obj, validity, parent=NULL, children=TRUE, attributes=TRUE, warn=FALSE, section=parent){
- childValidity <- attributeValidity <- NULL
+#' @examples
+#' HTMLish <- XMLValidity(
+#' children=list(
+#' body=c("a", "p", "ol", "ul", "strong"),
+#' head=c("title"),
+#' html=c("head", "body"),
+#' li=c("a", "br", "strong"),
+#' ol=c("li"),
+#' p=c("a", "br", "ol", "ul", "strong"),
+#' ul=c("li")
+#' ),
+#' attrs=list(
+#' a=c("href", "name"),
+#' p=c("align")
+#' ),
+#' allChildren=c("!--"),
+#' allAttrs=c("id", "class"),
+#' empty=c("br")
+#' )
+#' # make XML object
+#' validChildNodes <- XMLNode("html",
+#' XMLNode("head",
+#' XMLNode("!--", "comment always passes"),
+#' XMLNode("title", "test")
+#' ),
+#' XMLNode("body",
+#' XMLNode("p",
+#' XMLNode("a", "my link"),
+#' XMLNode("br"),
+#' "text goes on"
+#' )
+#' )
+#' )
+#' invalidChildNodes <- XMLNode("html",
+#' XMLNode("head",
+#' XMLNode("title",
+#' XMLNode("body", "test")
+#' )
+#' )
+#' )
+#'
+#' # do validity checks
+#' # the first should pass
+#' validXML(
+#' validChildNodes,
+#' validity=HTMLish
+#' )
+#'
+#' # now this one should cause a warning and return FALSE
+#' validXML(
+#' invalidChildNodes,
+#' validity=HTMLish,
+#' warn=TRUE
+#' )
+setMethod("validXML", signature(obj="XiMpLe.XML"), function(obj, validity=XMLValidity(), parent=NULL, children=TRUE, attributes=TRUE,
+ warn=FALSE, section=parent, caseSens=TRUE){
+ childValidity <- attributeValidity <- emptyValidity <- NULL
if(!is.XiMpLe.validity(validity)){
stop(simpleError(paste0(
"Invalid value for \"validity\": Got class ",
- class(valid),
+ class(validity),
", should be XiMpLe.validity!"))
)
}
@@ -69,6 +131,7 @@ setMethod("validXML", signature(obj="XiMpLe.XML"), function(obj, validity, paren
# we're checking "obj" as the parent node itself
# - check attributes of "obj" directly
# - check child nodes of "obj" for valid node names
+ # - check if "obj" should be empty but is not
# - recursion: check attributes of child nodes etc.
# b) "parent" is given
# we're checking "obj" as child node for a given parent
@@ -78,6 +141,23 @@ setMethod("validXML", signature(obj="XiMpLe.XML"), function(obj, validity, paren
recursion <- FALSE
if(is.null(parent)){
parentName <- XMLName(obj)
+ nodeChildren <- XMLChildren(obj)
+ # check for violations of mandatory empty nodes
+ emptyNodes <- slot(validity, "empty")
+ if(!isTRUE(caseSens)){
+ emptyNodes <- tolower(emptyNodes)
+ } else {}
+ if(parentName %in% emptyNodes){
+ if(length(nodeChildren) > 0 | !identical(XMLValue(obj), character())){
+ return.message <- paste0("Invalid XML node <", parentName, " />: Should be empty, but it isn't!")
+ if(isTRUE(warn)){
+ warning(return.message, call.=FALSE)
+ emptyValidity <- FALSE
+ } else {
+ stop(simpleError(return.message))
+ }
+ } else {}
+ } else {}
recursion <- TRUE
} else if(is.XiMpLe.node(parent)){
parentName <- XMLName(parent)
@@ -106,15 +186,29 @@ setMethod("validXML", signature(obj="XiMpLe.XML"), function(obj, validity, paren
if(isTRUE(children)){
if(isTRUE(recursion)){
# are there any children to check in the first place?
- nodeChildren <- XMLChildren(obj)
if(length(nodeChildren) > 0){
childValidity <- all(sapply(
nodeChildren,
function(thisChild){
# check child itself
- thisChildValidity <- valid.child(parent=parentName, children=thisChild, validity=validity, warn=warn, section=section)
+ thisChildValidity <- valid.child(
+ parent=parentName,
+ children=thisChild,
+ validity=validity,
+ warn=warn,
+ section=section,
+ caseSens=caseSens
+ )
# check grandchildren
- grandChildValidity <- validXML(thisChild, validity=validity, children=children, attributes=attributes, warn=warn, section=thisChild)
+ grandChildValidity <- validXML(
+ thisChild,
+ validity=validity,
+ children=children,
+ attributes=attributes,
+ warn=warn,
+ section=thisChild,
+ caseSens=caseSens
+ )
return(all(thisChildValidity, grandChildValidity))
}
))
@@ -122,13 +216,54 @@ setMethod("validXML", signature(obj="XiMpLe.XML"), function(obj, validity, paren
childValidity <- NULL
}
} else {
- childValidity <- valid.child(parent=parentName, children=obj, validity=validity, warn=warn, section=section)
+ childValidity <- valid.child(
+ parent=parentName,
+ children=obj,
+ validity=validity,
+ warn=warn,
+ section=section,
+ caseSens=caseSens
+ )
}
} else {}
if(isTRUE(attributes)){
# we only check attributes of "obj"
- attributeValidity <- valid.attribute(node=XMLName(obj), attrs=XMLAttrs(obj), validity=validity, warn=warn)
+ attributeValidityObj <- valid.attribute(
+ node=XMLName(obj),
+ attrs=XMLAttrs(obj),
+ validity=validity,
+ warn=warn,
+ caseSens=caseSens
+ )
+ if(isTRUE(recursion) & !isTRUE(children)){
+ # we can skip this if children was TRUE, because attributes were
+ # already checked recursively, then. but if not:
+ # are there any children to check in the first place?
+ if(length(nodeChildren) > 0){
+ attributeValidityRecursive <- all(sapply(
+ nodeChildren,
+ function(thisChild){
+ # because of the recursion this checks the attributes of "thisChild"
+ thisChildValidity <- validXML(
+ thisChild,
+ validity=validity,
+ children=FALSE,
+ attributes=TRUE,
+ warn=warn,
+ section=thisChild,
+ caseSens=caseSens
+ )
+ return(thisChildValidity)
+ }
+ ))
+ } else {
+ attributeValidityRecursive <- NULL
+ }
+ } else {
+ attributeValidityRecursive <- NULL
+ }
+ attributeValidity <- all(attributeValidityObj, attributeValidityRecursive)
} else {}
- return(all(childValidity, attributeValidity))
+ return(all(childValidity, attributeValidity, emptyValidity))
})
diff --git a/packages/XiMpLe/R/XMLValidity.R b/packages/XiMpLe/R/XMLValidity.R
index 2583bd4..6749346 100644
--- a/packages/XiMpLe/R/XMLValidity.R
+++ b/packages/XiMpLe/R/XMLValidity.R
@@ -27,13 +27,32 @@
#' name and each character string a valid attribute name.
#' @param allChildren Character vector, names of globally valid child nodes for all nodes, if any.
#' @param allAttrs Character vector, names of globally valid attributes for all nodes, if any.
+#' @param empty Character vector, names of nodes that must be empty nodes (i.e., no closing tag), if any.
#' @return An object of class \code{\link[XiMpLe:XiMpLe.validity-class]{XiMpLe.validity}}
#' @seealso
#' \code{\link[XiMpLe:validXML]{validXML}}
#' @export
-#' @rdname XiMpLe.validity-class
-
-XMLValidity <- function(children=NULL, attrs=NULL, allChildren=NULL, allAttrs=NULL){
+#' @rdname XMLValidity
+#' @examples
+#' HTMLish <- XMLValidity(
+#' children=list(
+#' body=c("a", "p", "ol", "ul", "strong"),
+#' head=c("title"),
+#' html=c("head", "body"),
+#' li=c("a", "br", "strong"),
+#' ol=c("li"),
+#' p=c("a", "br", "ol", "ul", "strong"),
+#' ul=c("li")
+#' ),
+#' attrs=list(
+#' a=c("href", "name"),
+#' p=c("align")
+#' ),
+#' allChildren=c("!--"),
+#' allAttrs=c("id", "class"),
+#' empty=c("br")
+#' )
+XMLValidity <- function(children=NULL, attrs=NULL, allChildren=NULL, allAttrs=NULL, empty=NULL){
if(is.null(children)){
children <- list()
@@ -47,12 +66,16 @@ XMLValidity <- function(children=NULL, attrs=NULL, allChildren=NULL, allAttrs=NU
if(is.null(allAttrs)){
allAttrs <- character()
} else {}
+ if(is.null(empty)){
+ empty <- character()
+ } else {}
newValidity <- new("XiMpLe.validity",
children=children,
attrs=attrs,
allChildren=allChildren,
- allAttrs=allAttrs
+ allAttrs=allAttrs,
+ empty=empty
)
return(newValidity)
diff --git a/packages/XiMpLe/R/XiMpLe-internal.R b/packages/XiMpLe/R/XiMpLe-internal.R
index 77ba1dd..3e52a4d 100644
--- a/packages/XiMpLe/R/XiMpLe-internal.R
+++ b/packages/XiMpLe/R/XiMpLe-internal.R
@@ -566,7 +566,13 @@ XML.nodes <- function(single.tags, end.here=NA, start=1){
# - section: an optional name for the section for the warning/error
# (if it shouldn't be the parent name)
# - node names: can alternatively be given instead of 'children', as character vector
-valid.child <- function(parent, children, validity, warn=FALSE, section=parent, node.names=NULL){
+# - graceful: allow everything inside "!--" comments?
+valid.child <- function(parent, children, validity, warn=FALSE, section=parent, node.names=NULL,
+ caseSens=TRUE, graceful=TRUE){
+ if(isTRUE(graceful) && identical(parent, "!--")){
+ # skip all checks and return TRUE
+ return(TRUE)
+ } else {}
if(is.null(node.names)){
# check the node names and allow only valid ones
node.names <- unlist(sapply(child.list(children), function(this.child){
@@ -585,8 +591,16 @@ valid.child <- function(parent, children, validity, warn=FALSE, section=parent,
}
}))
} else {}
+
+ validAllChildren <- slot(validity, "allChildren")
+ validChildren <- slot(validity, "children")[[parent]]
+ if(!isTRUE(caseSens)){
+ node.names <- tolower(node.names)
+ validAllChildren <- tolower(validAllChildren)
+ validChildren <- tolower(validChildren)
+ } else {}
- invalid.sets <- !node.names %in% c(slot(validity, "allChildren"), slot(validity, "children")[[parent]])
+ invalid.sets <- !node.names %in% c(validAllChildren, validChildren)
if(any(invalid.sets)){
return.message <- paste0("Invalid XML nodes for <", section, "> section: ", paste(node.names[invalid.sets], collapse=", "))
if(isTRUE(warn)){
@@ -607,10 +621,17 @@ valid.child <- function(parent, children, validity, warn=FALSE, section=parent,
# - node: a character string, node name
# - attrs: a named list of attributes to check
# - validity: definitions of valid child nodes, class XiMpLe.validity
-valid.attribute <- function(node, attrs, validity, warn=FALSE){
+valid.attribute <- function(node, attrs, validity, warn=FALSE, caseSens=TRUE){
if(length(attrs) > 0){
attrsNames <- names(attrs)
- invalid.sets <- !attrsNames %in% c(slot(validity, "allAttrs"), slot(validity, "attrs")[[node]])
+ validAllAttrs <- slot(validity, "allAttrs")
+ validAttrs <- slot(validity, "attrs")[[node]]
+ if(!isTRUE(caseSens)){
+ attrsNames <- tolower(attrsNames)
+ validAllAttrs <- tolower(validAllAttrs)
+ validAttrs <- tolower(validAttrs)
+ } else {}
+ invalid.sets <- !attrsNames %in% c(validAllAttrs, validAttrs)
if(any(invalid.sets)){
return.message <- paste0("Invalid XML attributes for <", node, "> node: ", paste(attrsNames[invalid.sets], collapse=", "))
if(isTRUE(warn)){
diff --git a/packages/XiMpLe/R/XiMpLe-package.R b/packages/XiMpLe/R/XiMpLe-package.R
index 9fc6dae..82fadaa 100644
--- a/packages/XiMpLe/R/XiMpLe-package.R
+++ b/packages/XiMpLe/R/XiMpLe-package.R
@@ -4,7 +4,7 @@
#' Package: \tab XiMpLe\cr
#' Type: \tab Package\cr
#' Version: \tab 0.03-24\cr
-#' Date: \tab 2015-12-07\cr
+#' Date: \tab 2015-12-08\cr
#' Depends: \tab R (>= 2.9.0),methods\cr
#' Encoding: \tab UTF-8\cr
#' License: \tab GPL (>= 3)\cr
diff --git a/packages/XiMpLe/man/XMLValidity.Rd b/packages/XiMpLe/man/XMLValidity.Rd
new file mode 100644
index 0000000..ad5f9d5
--- /dev/null
+++ b/packages/XiMpLe/man/XMLValidity.Rd
@@ -0,0 +1,53 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/XMLValidity.R
+\name{XMLValidity}
+\alias{XMLValidity}
+\title{Constructor function for XiMpLe.validity objects}
+\usage{
+XMLValidity(children = NULL, attrs = NULL, allChildren = NULL,
+ allAttrs = NULL, empty = NULL)
+}
+\arguments{
+\item{children}{Named list of character vectors, where the element name defines the parent node
+name and each character string a valid child node name.}
+
+\item{attrs}{Named list of character vectors, where the element name defines the parent node
+name and each character string a valid attribute name.}
+
+\item{allChildren}{Character vector, names of globally valid child nodes for all nodes, if any.}
+
+\item{allAttrs}{Character vector, names of globally valid attributes for all nodes, if any.}
+
+\item{empty}{Character vector, names of nodes that must be empty nodes (i.e., no closing tag), if any.}
+}
+\value{
+An object of class \code{\link[XiMpLe:XiMpLe.validity-class]{XiMpLe.validity}}
+}
+\description{
+Create validity definitions for XiMpLe nodes, to be used by
+\code{\link[XiMpLe:validXML]{validXML}}.
+}
+\examples{
+HTMLish <- XMLValidity(
+ children=list(
+ body=c("a", "p", "ol", "ul", "strong"),
+ head=c("title"),
+ html=c("head", "body"),
+ li=c("a", "br", "strong"),
+ ol=c("li"),
+ p=c("a", "br", "ol", "ul", "strong"),
+ ul=c("li")
+ ),
+ attrs=list(
+ a=c("href", "name"),
+ p=c("align")
+ ),
+ allChildren=c("!--"),
+ allAttrs=c("id", "class"),
+ empty=c("br")
+)
+}
+\seealso{
+\code{\link[XiMpLe:validXML]{validXML}}
+}
+
diff --git a/packages/XiMpLe/man/XiMpLe-package.Rd b/packages/XiMpLe/man/XiMpLe-package.Rd
index 640e03c..067c0d6 100644
--- a/packages/XiMpLe/man/XiMpLe-package.Rd
+++ b/packages/XiMpLe/man/XiMpLe-package.Rd
@@ -12,7 +12,7 @@ A Simple XML Tree Parser and Generator.
Package: \tab XiMpLe\cr
Type: \tab Package\cr
Version: \tab 0.03-24\cr
-Date: \tab 2015-12-07\cr
+Date: \tab 2015-12-08\cr
Depends: \tab R (>= 2.9.0),methods\cr
Encoding: \tab UTF-8\cr
License: \tab GPL (>= 3)\cr
diff --git a/packages/XiMpLe/man/XiMpLe.validity-class.Rd b/packages/XiMpLe/man/XiMpLe.validity-class.Rd
index 60ca8ca..fc41f1c 100644
--- a/packages/XiMpLe/man/XiMpLe.validity-class.Rd
+++ b/packages/XiMpLe/man/XiMpLe.validity-class.Rd
@@ -1,39 +1,22 @@
% Generated by roxygen2: do not edit by hand
-% Please edit documentation in R/00_class_03_XiMpLe.validity.R, R/XMLValidity.R, R/zzz_is_get_utils.R
+% Please edit documentation in R/00_class_03_XiMpLe.validity.R, R/zzz_is_get_utils.R
\docType{class}
\name{XiMpLe.validity,-class}
-\alias{XMLValidity}
\alias{XiMpLe.validity,-class}
\alias{XiMpLe.validity-class}
\alias{is.XiMpLe.validity}
\title{Class XiMpLe.validity}
\usage{
-XMLValidity(children = NULL, attrs = NULL, allChildren = NULL,
- allAttrs = NULL)
-
is.XiMpLe.validity(x)
}
\arguments{
-\item{children}{Named list of character vectors, where the element name defines the parent node
-name and each character string a valid child node name.}
-
-\item{attrs}{Named list of character vectors, where the element name defines the parent node
-name and each character string a valid attribute name.}
-
-\item{allChildren}{Character vector, names of globally valid child nodes for all nodes, if any.}
-
-\item{allAttrs}{Character vector, names of globally valid attributes for all nodes, if any.}
-
\item{x}{An arbitrary \code{R} object.}
}
-\value{
-An object of class \code{\link[XiMpLe:XiMpLe.validity-class]{XiMpLe.validity}}
-}
\description{
Used for objects that describe valid child nodes and attributes of XiMpLe.nodes.
-
-Create validity definitions for XiMpLe nodes, to be used by
-\code{\link[XiMpLe:validXML]{validXML}}.
+}
+\details{
+You should use \code{\link[XiMpLe:XMLValidity]{XMLValidity}} to create objects of this class.
}
\section{Slots}{
@@ -47,9 +30,12 @@ name and each character string a valid attribute name.}
\item{\code{allChildren}}{Character vector, names of globally valid child nodes for all nodes, if any.}
\item{\code{allAttrs}}{Character vector, names of globally valid attributes for all nodes, if any.}
+
+\item{\code{empty}}{Character vector, names of nodes that must be empty nodes (i.e., no closing tag), if any.}
}}
\seealso{
-\code{\link[XiMpLe:validXML]{validXML}}
+\code{\link[XiMpLe:XMLValidity]{XMLValidity}},
+ \code{\link[XiMpLe:validXML]{validXML}}
}
\keyword{classes}
diff --git a/packages/XiMpLe/man/validXML.Rd b/packages/XiMpLe/man/validXML.Rd
index eedaaeb..6930699 100644
--- a/packages/XiMpLe/man/validXML.Rd
+++ b/packages/XiMpLe/man/validXML.Rd
@@ -9,27 +9,35 @@
\alias{validXML,XiMpLe.node-method}
\title{Validate S4 objects of XiMpLe XML classes}
\usage{
-validXML(obj, validity, parent = NULL, children = TRUE, attributes = TRUE,
- warn = FALSE, section = parent)
+validXML(obj, validity = XMLValidity(), parent = NULL, children = TRUE,
+ attributes = TRUE, warn = FALSE, section = parent, caseSens = TRUE)
-\S4method{validXML}{XiMpLe.XML}(obj, validity, parent = NULL,
- children = TRUE, attributes = TRUE, warn = FALSE, section = parent)
+\S4method{validXML}{XiMpLe.XML}(obj, validity = XMLValidity(),
+ parent = NULL, children = TRUE, attributes = TRUE, warn = FALSE,
+ section = parent, caseSens = TRUE)
}
\arguments{
\item{obj}{An object of class \code{XiMpLe.doc} or \code{XiMpLe.node}. If \code{parent=NULL}, this object
will be checked for validity, including its child nodes. If \code{parent} is either a character string
or another XiMpLe node, it will be checked whether \code{obj} is a valid child node of \code{parent}.}
-\item{validity}{A list with validity information.}
+\item{validity}{An object of class \code{\link[XiMpLe:XiMpLe.validity-class]{XiMpLe.validity}},
+see \code{\link[XiMpLe:XMLValidity]{XMLValidity}}.}
\item{parent}{Either a character string (name of the parent node) or a XiMpLe node, whose name will be used
as name of the parent node.}
+\item{children}{Logical, whether child node names should be checked for validity.}
+
+\item{attributes}{Logical, whether attributes should be checked for validity.}
+
\item{warn}{Logical, whether invalid objects should cause a warning or stop with an error.}
\item{section}{Either a character string (name of the section) or a XiMpLe node, whose name will be used
as name of the XML section this check refers to. This is only relevant for warnings and error messages,
in case you want to use something different than the actual parent node name.}
+
+\item{caseSens}{Logical, whether checks should be case sensitive or not.}
}
\value{
Returns \code{TRUE} if tests pass, and depending on the setting of \code{warn} either \code{FALSE} or
@@ -43,8 +51,68 @@ or \code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}} have valid child nodes.
XiMpLe can't handle DOM specifications yet, but this method can be used to construct
validation schemes.
}
+\note{
+: If no \code{parent} is specified, \code{obj} will be checked recursively. If
+}
+\examples{
+HTMLish <- XMLValidity(
+ children=list(
+ body=c("a", "p", "ol", "ul", "strong"),
+ head=c("title"),
+ html=c("head", "body"),
+ li=c("a", "br", "strong"),
+ ol=c("li"),
+ p=c("a", "br", "ol", "ul", "strong"),
+ ul=c("li")
+ ),
+ attrs=list(
+ a=c("href", "name"),
+ p=c("align")
+ ),
+ allChildren=c("!--"),
+ allAttrs=c("id", "class"),
+ empty=c("br")
+)
+# make XML object
+validChildNodes <- XMLNode("html",
+ XMLNode("head",
+ XMLNode("!--", "comment always passes"),
+ XMLNode("title", "test")
+ ),
+ XMLNode("body",
+ XMLNode("p",
+ XMLNode("a", "my link"),
+ XMLNode("br"),
+ "text goes on"
+ )
+ )
+)
+invalidChildNodes <- XMLNode("html",
+ XMLNode("head",
+ XMLNode("title",
+ XMLNode("body", "test")
+ )
+ )
+)
+
+# do validity checks
+# the first should pass
+validXML(
+ validChildNodes,
+ validity=HTMLish
+)
+
+# now this one should cause a warning and return FALSE
+validXML(
+ invalidChildNodes,
+ validity=HTMLish,
+ warn=TRUE
+)
+}
\seealso{
-\code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}
+\code{\link[XiMpLe:validXML]{validXML}},
+ \code{\link[XiMpLe:XMLValidity]{XMLValidity}},
+ \code{\link[XiMpLe:XiMpLe.doc-class]{XiMpLe.doc}}, and
\code{\link[XiMpLe:XiMpLe.node-class]{XiMpLe.node}}
}
\keyword{methods}
diff --git a/packages/XiMpLe/tests/testthat/sample_XML_validity.RData b/packages/XiMpLe/tests/testthat/sample_XML_validity.RData
new file mode 100644
index 0000000..32a3b7f
Binary files /dev/null and b/packages/XiMpLe/tests/testthat/sample_XML_validity.RData differ
diff --git a/packages/XiMpLe/tests/testthat/tests.R b/packages/XiMpLe/tests/testthat/tests.R
index c36879d..bada695 100644
--- a/packages/XiMpLe/tests/testthat/tests.R
+++ b/packages/XiMpLe/tests/testthat/tests.R
@@ -1,251 +1,445 @@
context("XML generation")
test_that("generate empty XML node", {
- sampleXMLStandard <- dget("sample_XML_node_empty_dput.txt")
- expect_that(
- XMLNode("empty"),
- equals(sampleXMLStandard)
- )
+ 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)
- )
+ 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")
- expect_that(
- XMLNode("empty", "test", attrs=list(foo="bar")),
- equals(sampleXMLnode.attrs)
- )
+ # re-create object sampleXMLnode.attrs
+ load("sample_XML_node_attrs.RData")
+ expect_that(
+ XMLNode("empty", "test", attrs=list(foo="bar")),
+ equals(sampleXMLnode.attrs)
+ )
})
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)
- )
+ # 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 sampleXMLparsed
- load("sample_RSS_parsed.RData")
+ # re-create object sampleXMLparsed
+ load("sample_RSS_parsed.RData")
- sampleXMLFile <- normalizePath("koRpus_RSS_sample.xml")
- XMLtoParse <- file(sampleXMLFile, encoding="UTF-8")
- sampleXMLparsed.test <- parseXMLTree(XMLtoParse)
- close(XMLtoParse)
+ sampleXMLFile <- normalizePath("koRpus_RSS_sample.xml")
+ XMLtoParse <- file(sampleXMLFile, encoding="UTF-8")
+ sampleXMLparsed.test <- parseXMLTree(XMLtoParse)
+ close(XMLtoParse)
- expect_that(
- sampleXMLparsed.test,
- equals(sampleXMLparsed))
+ expect_that(
+ sampleXMLparsed.test,
+ equals(sampleXMLparsed))
})
context("extracting nodes")
test_that("extract node from parsed XML tree", {
- # re-create object sampleXMLparsed
- load("sample_RSS_parsed.RData")
- # re-create object sampleXMLnode.extracted
- load("sample_XML_node_extracted.RData")
+ # re-create object sampleXMLparsed
+ load("sample_RSS_parsed.RData")
+ # re-create object sampleXMLnode.extracted
+ load("sample_XML_node_extracted.RData")
- sampleXMLnode.test <- node(sampleXMLparsed, node=list("rss","channel","atom:link"))
+ sampleXMLnode.test <- node(sampleXMLparsed, node=list("rss","channel","atom:link"))
- expect_that(
- sampleXMLnode.test,
- equals(sampleXMLnode.extracted))
+ expect_that(
+ sampleXMLnode.test,
+ equals(sampleXMLnode.extracted))
})
context("changing node values")
test_that("change attribute values in XML node", {
- # re-create object sampleXMLparsed
- load("sample_RSS_parsed.RData")
- # re-create object sampleXMLnode.extracted
- load("sample_XML_tree_changed.RData")
-
- # replace URL
- node(sampleXMLparsed,
- node=list("rss","channel","atom:link"),
- what="attributes", element="href") <- "http://example.com"
-
- # remove "rel" attribute
- node(sampleXMLparsed,
- node=list("rss","channel","atom:link"),
- what="attributes", element="rel") <- NULL
-
- expect_that(
- sampleXMLparsed,
- equals(sampleXMLparsed.changed))
+ # re-create object sampleXMLparsed
+ load("sample_RSS_parsed.RData")
+ # re-create object sampleXMLnode.extracted
+ load("sample_XML_tree_changed.RData")
+
+ # replace URL
+ node(sampleXMLparsed,
+ node=list("rss","channel","atom:link"),
+ what="attributes", element="href") <- "http://example.com"
+
+ # remove "rel" attribute
+ node(sampleXMLparsed,
+ node=list("rss","channel","atom:link"),
+ what="attributes", element="rel") <- NULL
+
+ expect_that(
+ sampleXMLparsed,
+ equals(sampleXMLparsed.changed))
})
test_that("change nested text value in XML node", {
- # re-create object sampleXMLparsed
- load("sample_RSS_parsed.RData")
- # re-create object sampleXMLnode.extracted
- load("sample_XML_tree_changed_value.RData")
-
- # change text
- node(sampleXMLparsed,
- node=list("rss","channel","item","title"),
- what="value",
- cond.value="Changes in koRpus version 0.04-30") <- "this value was changed!"
-
- expect_that(
- sampleXMLparsed,
- equals(sampleXMLparsed.changed.value))
+ # re-create object sampleXMLparsed
+ load("sample_RSS_parsed.RData")
+ # re-create object sampleXMLnode.extracted
+ load("sample_XML_tree_changed_value.RData")
+
+ # change text
+ node(sampleXMLparsed,
+ node=list("rss","channel","item","title"),
+ what="value",
+ cond.value="Changes in koRpus version 0.04-30") <- "this value was changed!"
+
+ expect_that(
+ sampleXMLparsed,
+ equals(sampleXMLparsed.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"))
+ 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()))
+ 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"))
+ 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))
+ 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))
+ 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))
+ 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))
+ 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"))
+ 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")
+ load("sample_XML_tree.RData")
- # this should return a list of 3
- sampleXMLTree.nodes <- XMLScan(sampleXMLTree, "empty")
+ # this should return a list of 3
+ sampleXMLTree.nodes <- XMLScan(sampleXMLTree, "empty")
- expect_is(
- sampleXMLTree.nodes,
- "list")
- expect_that(
- length(sampleXMLTree.nodes),
- equals(3))
+ 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")
+ load("sample_XML_tree.RData")
+
+ # this should remove all nodes,
+ # exept the parent "tree" node
+ XMLScan(sampleXMLTree, "empty") <- NULL
- # 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
+ sample_XML_validity.generated <- XMLValidity(
+ children=list(
+ body=c("a", "p", "ol", "ul", "strong"),
+ head=c("title"),
+ html=c("head", "body"),
+ li=c("a", "br", "strong"),
+ ol=c("li"),
+ p=c("a", "br", "ol", "ul", "strong"),
+ ul=c("li")
+ ),
+ attrs=list(
+ a=c("href", "name"),
+ p=c("align")
+ ),
+ allChildren=c("!--"),
+ allAttrs=c("id", "class"),
+ empty=c("br")
+ )
+
+ 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!"
+ )
+})
- expect_identical(
- sampleXMLTree,
- XMLTree(XMLNode("tree")))
+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"))
+ ),
+ 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"))
+ )
+ )
+ 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"
+ )
+ 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"
+ )
})
More information about the rkward-tracker
mailing list