[Sciviews-commits] r324 - in pkg/svUnit: . R inst/doc man
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Sep 30 14:57:41 CEST 2010
Author: mariotomo
Date: 2010-09-30 14:57:40 +0200 (Thu, 30 Sep 2010)
New Revision: 324
Modified:
pkg/svUnit/DESCRIPTION
pkg/svUnit/NAMESPACE
pkg/svUnit/R/svSuiteData.R
pkg/svUnit/R/svTestData.R
pkg/svUnit/inst/doc/svUnit.pdf
pkg/svUnit/man/svSuiteData.Rd
Log:
adding a junit protocol.
there are a few open questions:
all svTestData receive as 'unit' the last unit read, not the one containing the test case.
there is no accessor for: timing, max.kind, ... well, these two.
what is actually the difference between text and msg?
Modified: pkg/svUnit/DESCRIPTION
===================================================================
--- pkg/svUnit/DESCRIPTION 2010-09-30 12:05:13 UTC (rev 323)
+++ pkg/svUnit/DESCRIPTION 2010-09-30 12:57:40 UTC (rev 324)
@@ -2,7 +2,7 @@
Type: Package
Title: SciViews GUI API - Unit testing
Depends: R (>= 1.9.0)
-Suggests: svGUI, datasets, utils
+Suggests: svGUI, datasets, utils, XML
Description: A complete unit test system and functions to implement its GUI part
Version: 0.7-4
Date: 2010-09-30
Modified: pkg/svUnit/NAMESPACE
===================================================================
--- pkg/svUnit/NAMESPACE 2010-09-30 12:05:13 UTC (rev 323)
+++ pkg/svUnit/NAMESPACE 2010-09-30 12:57:40 UTC (rev 324)
@@ -30,6 +30,7 @@
metadata,
protocol,
protocol_text,
+ protocol_junit,
runTest,
stats,
svSuite,
@@ -51,6 +52,8 @@
S3method(protocol, default)
S3method(protocol_text, svSuiteData)
+S3method(protocol_junit, svSuiteData)
+S3method(protocol_junit, svTestData)
S3method(runTest, default)
S3method(runTest, svTest)
Modified: pkg/svUnit/R/svSuiteData.R
===================================================================
--- pkg/svUnit/R/svSuiteData.R 2010-09-30 12:05:13 UTC (rev 323)
+++ pkg/svUnit/R/svSuiteData.R 2010-09-30 12:57:40 UTC (rev 324)
@@ -113,3 +113,41 @@
summary(object[[Test]], file = file, append = TRUE)
}
}
+
+protocol_junit <- function (object, ...)
+ UseMethod("protocol_junit")
+
+protocol_junit.svSuiteData <- function (object, file="", append=FALSE, ...)
+{
+ if (!is.svSuiteData(object))
+ stop("'object' must inherit from 'svSuiteData'")
+ if(!require(XML, quietly=TRUE))
+ return(invisible(FALSE))
+
+ Tests <- sort(ls(object))
+ if((length(Tests) > 0) && inherits(object[[Tests[1]]], "svSuiteData"))
+ ## this is a set of suites (containing svSuiteData)
+ root <- xmlNode('testsuites')
+ else
+ ## this is a single suite (containing svTestData)
+ root <- xmlNode('testsuite')
+
+ with(stats(object), addAttributes(root,
+ name=NULL,
+ tests=length(Tests),
+ errors=sum(kind == '**ERROR**'),
+ failures=sum(kind == '**FAILS**'),
+ skip=sum(kind == 'DEACTIVATED')))
+ if (length(Tests) > 0) {
+ for (Test in Tests)
+ root <- addChildren(root, kids=list(protocol_junit(object[[Test]], append=TRUE)))
+ }
+
+ ## decide whether to return the xml node or write the xml file
+ if(append)
+ return(root)
+ else {
+ saveXML(root, file)
+ return(invisible(TRUE))
+ }
+}
Modified: pkg/svUnit/R/svTestData.R
===================================================================
--- pkg/svUnit/R/svTestData.R 2010-09-30 12:05:13 UTC (rev 323)
+++ pkg/svUnit/R/svTestData.R 2010-09-30 12:57:40 UTC (rev 324)
@@ -84,3 +84,34 @@
sep = "", file = file, append = TRUE)
}
}
+
+
+protocol_junit.svTestData <- function(object, ...) {
+ if(!require(XML, quietly=TRUE))
+ return(invisible(FALSE))
+
+ toValidXmlString <- function(s) gsub("<", "<", s)
+
+ basename <- function(s) sub(".*/", "", s)
+
+ Context <- attr(object, "context")
+ Stats <- attr(object, "stats")
+ result <- xmlNode('testcase',
+ attrs=c(
+ 'classname'=basename(Context[['unit']]),
+ 'name'=toValidXmlString(Context[['test']]),
+ 'time'=object$timing))
+ kind <- as.numeric(.kindMax(object$kind)) # TODO: use accessor
+ elementName <- c(NA, 'failure', 'error', NA)[kind]
+ if(!is.na(elementName)) {
+ failureNode <- xmlNode(elementName,
+ attrs=c(
+ 'type'=elementName,
+ 'message'=object$res)) # TODO: use accessor
+ result <- addChildren(result, kids=list(failureNode))
+ }
+ if(kind == 4)
+ result <- addChildren(result, kids=list(xmlNode('skipped')))
+
+ return(result)
+}
Modified: pkg/svUnit/inst/doc/svUnit.pdf
===================================================================
(Binary files differ)
Modified: pkg/svUnit/man/svSuiteData.Rd
===================================================================
--- pkg/svUnit/man/svSuiteData.Rd 2010-09-30 12:05:13 UTC (rev 323)
+++ pkg/svUnit/man/svSuiteData.Rd 2010-09-30 12:57:40 UTC (rev 324)
@@ -11,6 +11,9 @@
\alias{protocol.svSuiteData}
\alias{protocol_text}
\alias{protocol_text.svSuiteData}
+\alias{protocol_junit}
+\alias{protocol_junit.svSuiteData}
+\alias{protocol_junit.svTestData}
\title{ Objects of class 'svSuiteData' contain results from running test suites }
\description{
@@ -39,6 +42,7 @@
\method{protocol}{svSuiteData}(object, type = "text", file = "", append = FALSE, \dots)
protocol_text(object, file = "", append = FALSE, \dots)
\method{protocol_text}{svSuiteData}(object, file = "", append = FALSE, ...)
+\method{protocol_junit}{svSuiteData}(object, file = "", append = FALSE, ...)
}
\arguments{
@@ -55,8 +59,8 @@
\code{file = ""}, the protocol report is output to the console }
\item{append}{ do we append to this file? }
\item{type}{ character. The type of protocol report to create. For the moment,
- only \code{type = "text"} is supported, but further types (HTML, LaTeX,
- Wiki, etc.) will be provided later. }
+ only \code{type = "text"} and \code{type = "junit"} are supported,
+ but further types (HTML, LaTeX, Wiki, etc.) will be provided later. }
\item{\dots}{ further arguments to pass to methods. Not used yet. }
}
More information about the Sciviews-commits
mailing list