[rkward-cvs] SF.net SVN: rkward:[3109] trunk/rkward/rkward/rbackend/rpackages
m-eik at users.sourceforge.net
m-eik at users.sourceforge.net
Wed Oct 6 15:56:38 UTC 2010
Revision: 3109
http://rkward.svn.sourceforge.net/rkward/?rev=3109&view=rev
Author: m-eik
Date: 2010-10-06 15:56:37 +0000 (Wed, 06 Oct 2010)
Log Message:
-----------
rkwardtests: initial R package for the testing framework. WIP, not really working yet.
Added Paths:
-----------
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/DESCRIPTION
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/NAMESPACE
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTest-class.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTestResult-class.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTestSuite-class.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rk.rerun.plugin.link.replacement.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.makeplugintests.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.runRKTestSuite.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.setSuiteStandards.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-internal.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-package.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/show-method.R
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTest-class.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTestResult-class.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTestSuite-class.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rk.rerun.plugin.link.replacement.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.makeplugintests.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.runRKTestSuite.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.setSuiteStandards.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rkwardtests-package.Rd
trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/show.Rd
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/DESCRIPTION
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/DESCRIPTION (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/DESCRIPTION 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,13 @@
+Package: rkwardtests
+Type: Package
+Title: RKWard Plugin Test Suite Framework
+Version: 0.5.5
+Date: 2010-10-05
+Author: Thomas Friedrichsmeier
+Maintainer: Thomas Friedrichsmeier <thomas.friedrichsmeier at ruhr-uni-bochum.de>, m.eik michalke <meik.michalke at uni-duesseldorf.de>
+Depends: R (>= 2.9.0),methods,roxygen
+Description: A set of functions, classes and methods to test plugins that were written for RKWard.
+License: GPL (>= 2)
+Encoding: UTF-8
+LazyLoad: yes
+URL: http://rkward.sourceforge.net
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/NAMESPACE
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/NAMESPACE (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/NAMESPACE 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,9 @@
+export(.rk.rerun.plugin.link.replacement)
+import(methods)
+exportClasses(RKTest)
+export(rktest.makeplugintests)
+exportClasses(RKTestResult)
+export(rktest.runRKTestSuite)
+export(rktest.setSuiteStandards)
+exportClasses(RKTestSuite)
+exportMethods(show)
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTest-class.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTest-class.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTest-class.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,23 @@
+#' This class is used internally by \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}.
+#'
+#' @title S4 class RKTest
+#' @slot id A unique character string
+#' @slot call A function to be called
+#' @slot fuzzy_output Allow fuzzy results
+#' @slot expect_error Expect errors
+#' @slot libraries A charcter vector naming needed libraries
+#' @name RKTest
+#' @import methods
+#' @keywords classes
+#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}
+#' @exportClass RKTest
+#' @rdname RKTest-class
+
+setClass ("RKTest",
+ representation (id="character", call="function", fuzzy_output="logical", expect_error="logical", libraries="character"),
+ prototype(character(0), id=NULL, call=function () { stop () }, fuzzy_output=FALSE, expect_error=FALSE, libraries=character(0)),
+ validity=function (object) {
+ if (is.null (object at id)) return (FALSE)
+ return (TRUE)
+ }
+ )
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTestResult-class.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTestResult-class.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTestResult-class.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,25 @@
+#' Class RKTestResult
+#'
+#' This class is used internally by \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}.
+#'
+#' @title S4 class RKTestResult
+#' @slot id A unique character string naming a test.
+#' @slot code_match A character string indicating whether the run code matched the standard.
+#' @slot output_match A character string indicating whether the resulting output matched the standard.
+#' @slot message_match A character string indicating whether the resulting R messages matched the standard.
+#' @slot error A character string indicating errors.
+#' @slot passed Logical: Did the test pass?
+#' @name RKTestResult
+#' @import methods
+#' @keywords classes
+#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}
+#' @exportClass RKTestResult
+#' @rdname RKTestResult-class
+
+setClass ("RKTestResult",
+ representation (id = "character", code_match = "character", output_match = "character", message_match = "character", error="character", passed="logical"),
+ prototype(character(0), id = character (0), code_match = character (0), output_match = character (0), message_match = character (0), error = character (0), passed=FALSE),
+ validity=function (object) {
+ return (all.equal (length (object at id), length (object at code_match), length (object at output_match), length (object at message_match), length (object at error), length (object at passed)))
+ }
+ )
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTestSuite-class.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTestSuite-class.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/RKTestSuite-class.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,26 @@
+#' Class RKTestSuite
+#'
+#' This class is used to create test suite objects that can be fed to \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}.
+#'
+#' @title S4 class RKTestSuite
+#' @slot id A unique character string to identify a test suite
+#' @slot libraries A charcter vector naming libraries that the test suite depends on.
+#' @slot initCalls A list of functions to be run before any tests, e.g. to load libraries or data objects.
+#' @slot tests A list of the actual plugin tests.
+#' @slot postCalls A list of functions to be run after all tests, e.g. to clean up.
+#' @name RKTestSuite
+#' @import methods
+#' @keywords classes
+#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}
+#' @exportClass RKTestSuite
+#' @rdname RKTestSuite-class
+
+setClass ("RKTestSuite",
+ representation (id="character", libraries="character", initCalls="list", tests="list", postCalls="list"),
+ prototype(character(0), id=NULL, libraries=character(0), initCalls=list(), tests=list(), postCalls=list ()),
+ validity=function (object) {
+ if (length (object at id) != 1) return (FALSE)
+ if (length (object at tests) < 1) return (FALSE)
+ return (TRUE)
+ }
+ )
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rk.rerun.plugin.link.replacement.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rk.rerun.plugin.link.replacement.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rk.rerun.plugin.link.replacement.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,39 @@
+#' Replace "Run again" link in RKWard with code
+#'
+#' You can use this to temporarily replace .rk.rerun.plugin.link (see example below).
+#' This way, after running a plugin, you are shown the call needed to run this
+#' plugin with those settings, instead of the link.
+#'
+#' This code can be used in a plugin test suite.
+#'
+#' @title Replace "Run again" link in RKWard
+#' @usage .rk.rerun.plugin.link <- .rk.rerun.plugin.link.replacement
+#' @aliases .rk.rerun.plugin.link.replacement
+#' @param plugin (used internally)
+#' @param settings (used internally)
+#' @param label (used internally)
+#' @return Replaces the "Run again" link in RKWard with the code that would have been called.
+#' @docType function
+#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}
+#' @keywords utilities
+#' @seealso \code{\link[rkwardtests:RKTestSuite]{RKTestSuite-class}}, \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}
+#' @export
+#' @rdname rk.rerun.plugin.link.replacement
+#' @examples
+#' \dontrun{
+#' # NOTE: Do NOT end the function with brackets, as its code has to be
+#' # written into .rk.rerun.plugin.link
+#' .rk.rerun.plugin.link <- .rk.rerun.plugin.link.replacement
+#' }
+
+.rk.rerun.plugin.link.replacement <- function (plugin, settings, label) {
+ .rk.cat.output ("<h3>Rerun code:</h3>")
+ .rk.cat.output ("<pre>")
+ .rk.cat.output ("rk.call.plugin (\"")
+ .rk.cat.output (plugin)
+ .rk.cat.output ("\", ")
+ .rk.cat.output (gsub ("^\"", "", gsub ("=", "=\"", gsub ("\n", "\", ", settings))))
+ .rk.cat.output ("\", submit.mode=\"submit\")</pre>")
+}
+
+
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.makeplugintests.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.makeplugintests.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.makeplugintests.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,58 @@
+#' Run a whole RKWard plugin test suite
+#'
+#' The function \code{rktest.makeplugintests} will run a whole test suite that was prepared to check one or several RKWard plugins.
+#'
+#' @title Run RKWard plugin test suite
+#' @usage rktest.makeplugintests(testsuites, outfile="make_plugintests.txt")
+#' @aliases rktest.makeplugintests
+#' @param testsuites A character vector naming the test suites to be run.
+#' @param outfile A character string giving a file name for the result log.
+#' @return Results are printed to stdout and saved to the defined output file.
+#' @docType function
+#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}
+#' @keywords utilities
+#' @seealso \code{\link[rkwardtests:RKTestSuite]{RKTestSuite-class}}, \code{\link[rkwardtests:RKTestResult]{RKTestResult-class}}
+#' @export
+#' @examples
+#' \dontrun{
+#' rktest.makeplugintests(testsuites=c("rkward_application_tests.R", "import_export_plugins.R"))
+#' }
+
+rktest.makeplugintests <- function(testsuites, outfile="make_plugintests.txt"){
+ ## initialize
+ rktest.initializeEnvironment()
+
+ ## add your test suite files, to this vector:
+ #testsuites <- c ("rkward_application_tests.R", "import_export_plugins.R", "item_response_theory.R", "analysis_plugins.R", "distributions.R", "plots.R")
+
+ #plugintest.outfile <- 'make_plugintests.txt'
+ sink (file = outfile, append=FALSE, type="output", split=TRUE)
+ cat ("RKWard Version:\n")
+ print (.rk.app.version)
+ cat ("\n\nR-Version:\n")
+ print (R.version)
+ cat ("\n\nInstalled packages:\n")
+ print (subset(installed.packages(),select=c(LibPath,Version)))
+
+ allresults <- new ("RKTestResult")
+ for (testsuite in testsuites) {
+ source (testsuite)
+ allresults <- rktest.appendTestResults (allresults, results)
+ rm ("results")
+ }
+
+ cat ("\n\nOverall results:\n")
+ print (allresults)
+
+ if (any (is.na (allresults at passed))) {
+ cat ("\nNOTE: Skipped tests due to missing libaries are not an indication of problems.")
+ cat ("\nCurrently, the following R packages are needed in order to run all available tests:")
+ # TODO: Make this list dynamic and / or print only the missing libs
+ cat ('\n"R2HTML", "tseries", "nortest", "outliers", "exactRankTests", "moments", "car", "hdrcde", "qcc", "xtable", "eRm", "ltm"')
+ }
+
+ sink()
+
+ cat (paste ("\n\nThese output are saved in: ", paste (getwd(), outfile, sep=.Platform$file.sep), ".\nIf needed, send them to rkward-devel at lists.sourceforge.net\n", sep=""))
+
+}
\ No newline at end of file
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.runRKTestSuite.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.runRKTestSuite.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.runRKTestSuite.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,53 @@
+#' Run a single RKWard plugin test suite
+#'
+#' This function can be called to run a single plugin test suite.
+#'
+#' @title Run RKWard plugin test suite
+#' @usage rktest.runRKTestSuite(suite, basedir=getwd())
+#' @aliases rktest.runRKTestSuite
+#' @param suite Character string naming the test suite to run.
+#' @param basedir Defaults to the working directory.
+#' @return An object of class \code{\link[rkwardtests:RKTestResult]{RKTestResult-class}}.
+#' @docType function
+#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}
+#' @keywords utilities
+#' @seealso \code{\link[rkwardtests:RKTestSuite]{RKTestSuite-class}}, \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}
+#' @export
+#' @examples
+#' \dontrun{
+#' result <- rktest.runRKTestSuite()
+#' }
+
+rktest.runRKTestSuite <- function (suite, basedir=getwd ()) {
+ rktest.initializeEnvironment ()
+ result <- new ("RKTestResult") # FALSE by default
+
+ if (!inherits (suite, "RKTestSuite")) return (result)
+ if (!validObject (suite)) return (result)
+
+ # clean any old results
+ rktest.cleanRKTestSuite (suite, basedir)
+
+ oldwd = getwd ()
+ on.exit (setwd (oldwd))
+ setwd (paste (basedir, suite at id, sep="/"))
+
+ if (length (suite at initCalls) > 0) {
+ for (i in 1:length (suite at initCalls)) try (suite at initCalls[[i]]())
+ }
+ rk.sync.global () # objects might have been added/changed in the init calls
+
+ for (i in 1:length (suite at tests)) {
+ suite at tests[[i]]@libraries <- c(suite at libraries, suite at tests[[i]]@libraries)
+ try (res <- rktest.runRKTest(suite at tests[[i]]))
+ result <- rktest.appendTestResults (result, res)
+ }
+
+ if (length (suite at postCalls) > 0) {
+ for (i in 1:length (suite at postCalls)) try (suite at postCalls[[i]]())
+ }
+
+ rktest.resetEnvironment ()
+
+ result
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.setSuiteStandards.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.setSuiteStandards.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rktest.setSuiteStandards.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,41 @@
+#' Set RKWard plugin test suite standards
+#'
+#' Use this function after you plugin passed all tests to set the resulting code,
+#' output and R messages as the standard that will be compared to during following tests.
+#'
+#' @title Set RKWard suite standards
+#' @usage rktest.setSuiteStandards(suite, basedir=getwd())
+#' @aliases rktest.setSuiteStandards
+#' @param suite Character string naming the test suite to set standards for.
+#' @param basedir Defaults to the working directory.
+#' @return The function simply changes the names of the previously created files,
+#' specifically adding the prefix "RKTestStandard.".
+#' @docType function
+#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}
+#' @keywords utilities
+#' @seealso \code{\link[rkwardtests:RKTestSuite]{RKTestSuite-class}}, \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}
+#' @export
+#' @examples
+#' \dontrun{
+#' rktest.setSuiteStandards()
+#' }
+
+rktest.setSuiteStandards <- function (suite, basedir=getwd ()) {
+ if (!inherits (suite, "RKTestSuite")) return (result)
+ if (!validObject (suite)) return (result)
+
+ ok <- readline ("You are about to set new standards for this suite. This means you are certain that ALL tests in this suite have produced the expected/correct result on the last run. If you are absolutely sure, enter \"I am sure\" to proceed.");
+ if (ok != "I am sure") stop ("Aborted")
+
+ oldwd = getwd ()
+ on.exit (setwd (oldwd))
+ setwd (paste (basedir, suite at id, sep="/"))
+
+ files <- list.files ()
+ files <- grep ("\\.(messages.txt|rkcommands.R|rkout)$", files, value=TRUE)
+ files <- grep ("^RKTestStandard", files, value=TRUE, invert=TRUE)
+ file.copy (files, paste ("RKTestStandard.", files, sep=""), overwrite=TRUE)
+
+ # clean anything that is *not* a standard file
+ rktest.cleanRKTestSuite (suite, basedir)
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-internal.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-internal.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-internal.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,191 @@
+# these functions are all used internally
+
+rktest.appendTestResults <- function (objecta, objectb) {
+ stopifnot (inherits (objecta, "RKTestResult") && validObject (objecta))
+ stopifnot (inherits (objectb, "RKTestResult") && validObject (objectb))
+
+ index <- length (objecta at id)
+ for (i in 1:length (objectb at id)) {
+ objecta at id[index+i] = objectb at id[i]
+ objecta at code_match[index+i] = objectb at code_match[i]
+ objecta at output_match[index+i] = objectb at output_match[i]
+ objecta at message_match[index+i] = objectb at message_match[i]
+ objecta at error[index+i] = objectb at error[i]
+ objecta at passed[index+i] = objectb at passed[i]
+ }
+
+ objecta
+}
+
+rktest.file <- function (id, extension) {
+ file.path(getwd(), paste (id, extension, sep=""))
+}
+
+# returns true, if file corresponds to standard.
+rktest.compare.against.standard <- function (file, fuzzy=FALSE) {
+ standard_file <- gsub ("^(.*\\/)([^\\/]*)$", "\\1RKTestStandard\\.\\2", file)
+ if (file.exists (file)) {
+ # purge empty files
+ info <- file.info (file)
+ if (info$size[1] == 0) file.remove (file)
+ }
+ if (!file.exists (file)) {
+ # if neither exists, that means both files are empty
+ if (!file.exists (standard_file)) return ("match (empty)")
+ }
+
+ output.diff <- suppressWarnings (system(paste("diff", shQuote(file), shQuote(standard_file), "--strip-trailing-cr", "--new-file"), intern=TRUE))
+ if (!length (output.diff)) return ("match")
+ if ((length (output.diff) == 1) && (!nzchar (output.diff))) return ("match")
+
+ # below: there are *some* differences
+ if (fuzzy) {
+ size <- if (file.exists (file)) file.info (file)$size[1] else 0
+ s_size <- if (file.exists (standard_file)) file.info (standard_file)$size[1] else 0
+
+ # crude test: files should at least have a similar size
+ if ((size < (s_size + 20)) && (size > (s_size - 20))) return ("fuzzy match")
+ }
+
+ print (paste ("Differences between", file, "and", standard_file, ":"))
+ print (output.diff)
+
+ return ("MISMATCH")
+}
+
+rktest.runRKTest.internal <- function (test, output_file, code_file, message_file) {
+ # save / restore old output file
+ old_output <- rk.get.output.html.file ()
+ rk.set.output.html.file (output_file)
+ on.exit (rk.set.output.html.file (old_output), add=TRUE)
+
+ message_file_handle <- file (message_file, open="w+")
+ sink(message_file_handle, type="message")
+ on.exit ({
+ sink (NULL, type="message")
+ close (message_file_handle)
+ }, add=TRUE)
+
+ rk.record.commands (code_file)
+ on.exit (rk.record.commands (NULL), add=TRUE)
+
+ old.symbols <- ls (envir=globalenv (), all.names=TRUE)
+ on.exit ({
+ # clean up any new objects created by the test
+ new.symbols <- ls (envir=globalenv (), all.names=TRUE)
+ new.symbols <- new.symbols[!(new.symbols %in% old.symbols)]
+ rm (list=new.symbols, envir=globalenv ())
+ rk.sync.global ()
+ }, add=TRUE)
+
+ failed <- TRUE
+ try ({
+ test at call ()
+ failed <- FALSE
+ })
+
+ return (failed)
+}
+
+rktest.runRKTest <- function (test) {
+ result <- new ("RKTestResult") # FALSE by default
+
+ if (!inherits (test, "RKTest")) return (result)
+ result at id <- test at id
+ if (!validObject (test)) return (result)
+
+ missing_libs <- character(0)
+ for (lib in test at libraries) {
+ if (!suppressWarnings (base::require (lib, character.only=TRUE, quietly=TRUE))) {
+ missing_libs <- c (missing_libs, lib)
+ }
+ }
+ if (length (missing_libs) > 0) {
+ result at output_match <- result at message_match <- result at code_match <- NA_character_
+ result at error <- "missing lib(s)"
+ result at passed <- NA
+ cat ("\nSkipping test \"", test at id, "\" due to missing libraries: \"", paste (missing_libs, collapse="\", \""), "\"\n", sep="")
+ return (result)
+ }
+
+ output_file <- rktest.file (test at id, ".rkout")
+ code_file <- rktest.file (test at id, ".rkcommands.R")
+ message_file <- rktest.file (test at id, ".messages.txt")
+
+ # the essence of the test:
+ res.error <- rktest.runRKTest.internal (test, output_file, code_file, message_file)
+ passed <- (res.error == test at expect_error)
+ if (res.error) {
+ if (test at expect_error) result at error <- "expected error"
+ else result at error <- "ERROR"
+ } else {
+ if (test at expect_error) result at error <- "MISSING ERROR"
+ else result at error <- "no"
+ }
+
+ result at output_match = rktest.compare.against.standard (output_file, test at fuzzy_output)
+ if (result at output_match == "MISMATCH") passed <- FALSE
+ result at message_match = rktest.compare.against.standard (message_file)
+ if (result at message_match == "MISMATCH") passed <- FALSE
+ result at code_match = rktest.compare.against.standard (code_file)
+ if (result at code_match == "MISMATCH") passed <- FALSE
+
+ result at passed <- passed
+
+ result
+}
+
+rktest.cleanRKTestSuite <- function (suite, basedir=getwd ()) {
+ oldwd = getwd ()
+ on.exit (setwd (oldwd))
+ setwd (paste (basedir, suite at id, sep="/"))
+
+ files <- list.files ()
+ # do not delete the standards!
+ files <- grep ("^RKTestStandard\\..*\\.(messages.txt|rkcommands.R|rkout)$", files, value=TRUE, invert=TRUE)
+
+ unlink (files)
+
+ invisible (NULL)
+}
+
+## Initialize test environment
+rktest.initializeEnvironment <- function () {
+ # Almost all tests depend on R2HTML, indirectly, so we should really assume it (or have the user install it) at the start
+ stopifnot (require (R2HTML))
+
+ # By default .rk.rerun.plugin.link() and .rk.make.hr() are silenced during the test runs
+ .rk.rerun.plugin.link <<- .rk.make.hr <<- function (...) { list (...) }
+
+ # This should make the output of rk.graph.on() fixed
+ rk.get.tempfile.name <<- function (prefix="image", extension=".jpg") paste (prefix, extension, sep="")
+ options (rk.graphics.type="PNG", rk.graphics.width=480, rk.graphics.height=480)
+
+ # HACK: Override date, so we don't get a difference for each call of rk.header ()
+ # TODO: implement a clean solution inside rk.header()
+ assign ("date", function () {
+ return ("DATE")
+ }, envir=globalenv())
+
+ # numerical precision is often a problem. To work around this in many places, reduce default printed precision to 5 digits
+ options (digits=5)
+
+ # Make sure i18n does not get in the way
+ invisible (Sys.setenv (LANGUAGE="C"))
+ if (.Platform$OS.type == "unix") invisible (Sys.setlocale ("LC_MESSAGES", "C"))
+ options (useFancyQuotes=FALSE)
+
+ # This version of rk.set.output.html.file does not notify the frontend of the change. Without this, you'll get lots of output windows.
+ rk.set.output.html.file <<- function (x) {
+ stopifnot(is.character(x))
+ assign(".rk.output.html.file", x, as.environment("package:rkward"))
+ }
+}
+## moved this into rktest.makeplugintests()
+#rktest.initializeEnvironment ()
+
+# counterpart to rktest.initializeEnvironment. Restores the most important settings
+rktest.resetEnvironment <- function () {
+ rm (list=c ("rk.set.output.html.file", "rk.get.tempfile.name", ".rk.make.hr"), envir=globalenv ())
+ .rk.rerun.plugin.link <<- .rk.rerun.plugin.link.replacement
+}
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-package.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-package.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/rkwardtests-package.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,24 @@
+#' RKWard Plugin Test Suite Framework.
+#'
+#' \tabular{ll}{
+#' Package: \tab rkwardtests\cr
+#' Type: \tab Package\cr
+#' Version: \tab 0.5.5\cr
+#' Date: \tab 2010-10-05\cr
+#' Depends: \tab R (>= 2.9.0),methods,roxygen\cr
+#' Encoding: \tab UTF-8\cr
+#' License: \tab GPL (>= 3)\cr
+#' LazyLoad: \tab yes\cr
+#' URL: \tab http://rkward.sourceforge.net \cr
+#' }
+#'
+#' A set of functions, classes and methods to test plugins that were written for RKWard.
+#'
+#' @aliases rkwardtests-package rkwardtests
+#' @name rkwardtests-package
+#' @docType package
+#' @title RKWard Plugin Test Suite Framework.
+#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}, Meik Michalke \email{meik.michalke@@uni-duesseldorf.de}
+#' @keywords package
+#' @seealso \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}
+roxygen()
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/show-method.R
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/show-method.R (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/R/show-method.R 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,42 @@
+#' show method for S4 objects of class RKTestResult
+#'
+#' Prints a summary of plugin test results.
+#'
+#' @title show method for objects of class RKTestResult
+#' @method show RKTestResult
+#' @param object An object of class RKTestResult
+#' @aliases show,RKTestResult-method
+#' @author Thomas Friedrichsmeier \email{thomas.friedrichsmeier@@ruhr-uni-bochum.de}
+#' @keywords methods
+#' @examples
+#' \dontrun{
+#' rktest.makeplugintests("rkward_application_tests.R")
+#' }
+#' @exportMethod show
+#' @rdname show
+
+setMethod ("show", "RKTestResult", function (object) {
+ stopifnot (inherits (object, "RKTestResult"))
+
+ cat (format ("ID", width=30))
+ cat (format ("code match", width=15))
+ cat (format ("output match", width=15))
+ cat (format ("message match", width=15))
+ cat (format ("error", width=15))
+ cat (format ("result", width=15))
+ cat ("\n", rep ("-", 96), "\n", sep="")
+
+ for (i in 1:length (object at id)) {
+ cat (format (object at id[i], width=30))
+ cat (format (object at code_match[i], width=15))
+ cat (format (object at output_match[i], width=15))
+ cat (format (object at message_match[i], width=15))
+ cat (format (object at error[i], width=15))
+ cat (format (if (is.na (object at passed[i])) "--skipped--" else if (object at passed[i]) "pass" else "FAIL", width=15))
+ cat ("\n")
+ }
+
+ cat (rep ("-", 96), "\n", sep="")
+ cat (as.character (sum (object at passed, na.rm=TRUE)), " / ", as.character (sum (!is.na (object at passed))), " tests passed\n")
+ if (sum (is.na (object at passed)) > 0) cat ("(", as.character (sum (is.na (object at passed))), " / ", as.character (length (object at passed)), " tests skipped due to missing libraries)", sep="");
+})
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTest-class.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTest-class.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTest-class.Rd 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,10 @@
+\name{RKTest-class}
+\alias{RKTest
+-class}
+\alias{RKTest}
+\title{S4 class RKTest}
+\description{This class is used internally by \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}.}
+\keyword{classes}
+\author{Thomas Friedrichsmeier \email{thomas.friedrichsmeier at ruhr-uni-bochum.de}}
+\section{Slots}{\describe{\item{\code{id}:}{}\item{\code{call}:}{}\item{\code{fuzzy_output}:}{}\item{\code{expect_error}:}{}\item{\code{libraries}:}{}}}
+
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTestResult-class.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTestResult-class.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTestResult-class.Rd 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,11 @@
+\name{RKTestResult-class}
+\alias{RKTestResult
+-class}
+\alias{RKTestResult}
+\title{S4 class RKTestResult}
+\description{Class RKTestResult}
+\details{This class is used internally by \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}.}
+\keyword{classes}
+\author{Thomas Friedrichsmeier \email{thomas.friedrichsmeier at ruhr-uni-bochum.de}}
+\section{Slots}{\describe{\item{\code{id}:}{}\item{\code{code_match}:}{}\item{\code{output_match}:}{}\item{\code{message_match}:}{}\item{\code{error}:}{}\item{\code{passed}:}{}}}
+
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTestSuite-class.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTestSuite-class.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/RKTestSuite-class.Rd 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,11 @@
+\name{RKTestSuite-class}
+\alias{RKTestSuite
+-class}
+\alias{RKTestSuite}
+\title{S4 class RKTestSuite}
+\description{Class RKTestSuite}
+\details{This class is used to create test suite objects that can be fed to \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}.}
+\keyword{classes}
+\author{Thomas Friedrichsmeier \email{thomas.friedrichsmeier at ruhr-uni-bochum.de}}
+\section{Slots}{\describe{\item{\code{id}:}{}\item{\code{libraries}:}{}\item{\code{initCalls}:}{}\item{\code{tests}:}{}\item{\code{postCalls}:}{}}}
+
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rk.rerun.plugin.link.replacement.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rk.rerun.plugin.link.replacement.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rk.rerun.plugin.link.replacement.Rd 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,26 @@
+\name{rk.rerun.plugin.link.replacement}
+\alias{.rk.rerun.plugin.link.replacement}
+\title{Replace "Run again" link in RKWard}
+\usage{.rk.rerun.plugin.link <- .rk.rerun.plugin.link.replacement}
+\description{Replace "Run again" link in RKWard with code}
+\details{You can use this to temporarily replace .rk.rerun.plugin.link (see example below).
+This way, after running a plugin, you are shown the call needed to run this
+plugin with those settings, instead of the link.
+
+This code can be used in a plugin test suite.}
+\alias{.rk.rerun.plugin.link.replacement}
+\value{Replaces the "Run again" link in RKWard with the code that would have been called.}
+\docType{function}
+\author{Thomas Friedrichsmeier \email{thomas.friedrichsmeier at ruhr-uni-bochum.de}}
+\keyword{utilities}
+\seealso{\code{\link[rkwardtests:RKTestSuite]{RKTestSuite-class}}, \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}}
+\arguments{\item{plugin}{(used internally)}
+\item{settings}{(used internally)}
+\item{label}{(used internally)}
+}
+\examples{\dontrun{
+# NOTE: Do NOT end the function with brackets, as its code has to be
+# written into .rk.rerun.plugin.link
+.rk.rerun.plugin.link <- .rk.rerun.plugin.link.replacement
+}}
+
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.makeplugintests.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.makeplugintests.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.makeplugintests.Rd 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,19 @@
+\name{rktest.makeplugintests}
+\alias{rktest.makeplugintests}
+\title{Run RKWard plugin test suite}
+\usage{rktest.makeplugintests(testsuites, outfile="make_plugintests.txt")}
+\description{Run a whole RKWard plugin test suite}
+\details{The function \code{rktest.makeplugintests} will run a whole test suite that was prepared to check one or several RKWard plugins.}
+\alias{rktest.makeplugintests}
+\value{Results are printed to stdout and saved to the defined output file.}
+\docType{function}
+\author{Thomas Friedrichsmeier \email{thomas.friedrichsmeier at ruhr-uni-bochum.de}}
+\keyword{utilities}
+\seealso{\code{\link[rkwardtests:RKTestSuite]{RKTestSuite-class}}, \code{\link[rkwardtests:RKTestResult]{RKTestResult-class}}}
+\arguments{\item{testsuites}{A character vector naming the test suites to be run.}
+\item{outfile}{A character string giving a file name for the result log.}
+}
+\examples{\dontrun{
+rktest.makeplugintests(testsuites=c("rkward_application_tests.R", "import_export_plugins.R"))
+}}
+
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.runRKTestSuite.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.runRKTestSuite.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.runRKTestSuite.Rd 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,19 @@
+\name{rktest.runRKTestSuite}
+\alias{rktest.runRKTestSuite}
+\title{Run RKWard plugin test suite}
+\usage{rktest.runRKTestSuite(suite, basedir=getwd())}
+\description{Run a single RKWard plugin test suite}
+\details{This function can be called to run a single plugin test suite.}
+\alias{rktest.runRKTestSuite}
+\value{An object of class \code{\link[rkwardtests:RKTestResult]{RKTestResult-class}}.}
+\docType{function}
+\author{Thomas Friedrichsmeier \email{thomas.friedrichsmeier at ruhr-uni-bochum.de}}
+\keyword{utilities}
+\seealso{\code{\link[rkwardtests:RKTestSuite]{RKTestSuite-class}}, \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}}
+\arguments{\item{suite}{Character string naming the test suite to run.}
+\item{basedir}{Defaults to the working directory.}
+}
+\examples{\dontrun{
+result <- rktest.runRKTestSuite()
+}}
+
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.setSuiteStandards.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.setSuiteStandards.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rktest.setSuiteStandards.Rd 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,21 @@
+\name{rktest.setSuiteStandards}
+\alias{rktest.setSuiteStandards}
+\title{Set RKWard suite standards}
+\usage{rktest.setSuiteStandards(suite, basedir=getwd())}
+\description{Set RKWard plugin test suite standards}
+\details{Use this function after you plugin passed all tests to set the resulting code,
+output and R messages as the standard that will be compared to during following tests.}
+\alias{rktest.setSuiteStandards}
+\value{The function simply changes the names of the previously created files,
+specifically adding the prefix "RKTestStandard.".}
+\docType{function}
+\author{Thomas Friedrichsmeier \email{thomas.friedrichsmeier at ruhr-uni-bochum.de}}
+\keyword{utilities}
+\seealso{\code{\link[rkwardtests:RKTestSuite]{RKTestSuite-class}}, \code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}}
+\arguments{\item{suite}{Character string naming the test suite to set standards for.}
+\item{basedir}{Defaults to the working directory.}
+}
+\examples{\dontrun{
+rktest.setSuiteStandards()
+}}
+
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rkwardtests-package.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rkwardtests-package.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/rkwardtests-package.Rd 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,25 @@
+\name{rkwardtests-package}
+\alias{rkwardtests-package}
+\alias{rkwardtests-package}
+\title{RKWard Plugin Test Suite Framework.}
+\description{RKWard Plugin Test Suite Framework.}
+\details{\tabular{ll}{
+Package: \tab rkwardtests\cr
+Type: \tab Package\cr
+Version: \tab 0.5.5\cr
+Date: \tab 2010-10-05\cr
+Depends: \tab R (>= 2.9.0),methods,roxygen\cr
+Encoding: \tab UTF-8\cr
+License: \tab GPL (>= 3)\cr
+LazyLoad: \tab yes\cr
+URL: \tab http://rkward.sourceforge.net \cr
+}
+
+A set of functions, classes and methods to test plugins that were written for RKWard.}
+\alias{rkwardtests-package}
+\alias{rkwardtests}
+\docType{package}
+\author{Thomas Friedrichsmeier \email{thomas.friedrichsmeier at ruhr-uni-bochum.de}, Meik Michalke \email{meik.michalke at uni-duesseldorf.de}}
+\keyword{package}
+\seealso{\code{\link[rkwardtests:rktest.makeplugintests]{rktest.makeplugintests}}}
+
Added: trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/show.Rd
===================================================================
--- trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/show.Rd (rev 0)
+++ trunk/rkward/rkward/rbackend/rpackages/rkwardtests/man/show.Rd 2010-10-06 15:56:37 UTC (rev 3109)
@@ -0,0 +1,17 @@
+\name{show}
+\alias{show,-method}
+\alias{show}
+\title{show method for objects of class RKTestResult}
+\usage{\method{show}{RKTestResult}(object)
+}
+\description{show method for S4 objects of class RKTestResult}
+\details{Prints a summary of plugin test results.}
+\alias{show,RKTestResult-method}
+\author{Thomas Friedrichsmeier \email{thomas.friedrichsmeier at ruhr-uni-bochum.de}}
+\keyword{methods}
+\arguments{\item{object}{An object of class RKTestResult}
+}
+\examples{\dontrun{
+rktest.makeplugintests("rkward_application_tests.R")
+}}
+
This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site.
More information about the rkward-tracker
mailing list