[Ecopd-commits] r40 - in pkg: inst/unitTests tests

[noreply at r-forge.r-project.org]

Author: regetz
Date: 2009-10-21 05:18:14 +0200 (Wed, 21 Oct 2009)
New Revision: 40

Removed:
   pkg/inst/unitTests/runTests.R
Modified:
   pkg/tests/doRUnit.R
Log:
consolidated test-running scripts into a single file


Deleted: pkg/inst/unitTests/runTests.R
===================================================================
--- pkg/inst/unitTests/runTests.R	2009-10-20 23:58:07 UTC (rev 39)
+++ pkg/inst/unitTests/runTests.R	2009-10-21 03:18:14 UTC (rev 40)
@@ -1,62 +0,0 @@
-pkg <- "ecoPD"
-
-if(require("RUnit", quietly = TRUE)) {
-
-    library(package=pkg, character.only = TRUE)
-    if(!(exists("path") && file.exists(path)))
-        path <- system.file("unitTests", package = pkg)
-
-    ## --- Testing ---
-
-    ## Define tests
-    testSuite <- defineTestSuite(name = paste(pkg, "unit testing"),
-                                 dirs = path)
-
-    if(interactive()) {
-        cat("Now have RUnit Test Suite 'testSuite' for package '",
-            pkg, "' :\n", sep='')
-        str(testSuite)
-        cat('', "Consider doing",
-            "\t  tests <- runTestSuite(testSuite)", "\nand later",
-            "\t  printTextProtocol(tests)", '', sep = "\n")
-    } else {
-        ## run from shell / Rscript / R CMD Batch / ...
-        ## Run
-        tests <- runTestSuite(testSuite)
-
-        if(file.access(path, 02) != 0) {
-            ## cannot write to path -> use writable one
-            tdir <- tempfile(paste(pkg, "unitTests", sep="_"))
-            dir.create(tdir)
-            pathReport <- file.path(tdir, "report")
-            cat("RUnit reports are written into ", tdir, "/report.(txt|html)",
-                sep = "")
-        } else {
-            pathReport <- file.path(path, "report")
-        }
-
-        ## Print Results:
-        printTextProtocol(tests, showDetails = FALSE)
-        printTextProtocol(tests, showDetails = FALSE,
-                          fileName = paste(pathReport, "Summary.txt", sep = ""))
-        printTextProtocol(tests, showDetails = TRUE,
-                          fileName = paste(pathReport, ".txt", sep = ""))
-
-        ## Print HTML Version to a File:
-        ## printHTMLProtocol has problems on Mac OS X
-        if (Sys.info()["sysname"] != "Darwin")
-        printHTMLProtocol(tests,
-                          fileName = paste(pathReport, ".html", sep = ""))
-
-        ## stop() if there are any failures i.e. FALSE to unit test.
-        ## This will cause R CMD check to return error and stop
-        tmp <- getErrors(tests)
-        if(tmp$nFail > 0 | tmp$nErr > 0) {
-            stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail,
-                       ", R errors: ",  tmp$nErr, ")\n\n", sep=""))
-        }
-    }
-} else {
-    cat("R package 'RUnit' cannot be loaded -- no unit tests run\n",
-        "for package", pkg,"\n")
-}

Modified: pkg/tests/doRUnit.R
===================================================================
--- pkg/tests/doRUnit.R	2009-10-20 23:58:07 UTC (rev 39)
+++ pkg/tests/doRUnit.R	2009-10-21 03:18:14 UTC (rev 40)
@@ -1,29 +1,62 @@
-# doRUnit.R --- Run RUnit tests
-# slightly modified from fCalendar package
-#------------------------------------------------------------------------
+## RUnit script obtained from:
+##   http://wiki.r-project.org/rwiki/doku.php?id=developers:runit
 
-if(require("RUnit", quietly = TRUE)) {
-
-  # Setup
-  wd <- getwd()
-  pkg <- sub("\\.Rcheck$", '', basename(dirname(wd)))
-
-  # temporary fix to accommodate custom library location:
-  .libPaths("~/R-dev")
-
-  library(package=pkg, character.only=TRUE)
-
+## unit tests will not be done if RUnit is not available
+if(require("RUnit", quietly=TRUE)) {
+ 
+  ## --- Setup ---
+ 
+  pkg <- "ecoPD"
   if(Sys.getenv("RCMDCHECK") == "FALSE") {
-    # Path to unit tests for standalone running under Makefile (not R CMD check)
-    # PKG/tests/../inst/unitTests
+    ## Path to unit tests for standalone running under Makefile (not R CMD check)
+    ## PKG/tests/../inst/unitTests
     path <- file.path(getwd(), "..", "inst", "unitTests")
   } else {
-    # Path to unit tests for R CMD check
-    # PKG.Rcheck/tests/../PKG/unitTests
+    ## Path to unit tests for R CMD check
+    ## PKG.Rcheck/tests/../PKG/unitTests
     path <- system.file(package=pkg, "unitTests")
   }
-
-  stopifnot(file.exists(path), file.info(path.expand(path))$isdir)
-  source(file.path(path, "runTests.R"), echo = TRUE)
-
+  cat("\nRunning unit tests\n")
+  print(list(pkg=pkg, getwd=getwd(), pathToUnitTests=path))
+ 
+  library(package=pkg, character.only=TRUE)
+ 
+  ## If desired, load the name space to allow testing of private functions
+  ## if (is.element(pkg, loadedNamespaces()))
+  ##     attach(loadNamespace(pkg), name=paste("namespace", pkg, sep=":"), pos=3)
+  ##
+  ## or simply call PKG:::myPrivateFunction() in tests
+ 
+  ## --- Testing ---
+ 
+  ## Define tests
+  testSuite <- defineTestSuite(name=paste(pkg, "unit testing"),
+                                          dirs=path)
+  ## Run
+  tests <- runTestSuite(testSuite)
+ 
+  ## Default report name
+  pathReport <- file.path(path, "report")
+ 
+  ## Report to stdout and text files
+  cat("------------------- UNIT TEST SUMMARY ---------------------\n\n")
+  printTextProtocol(tests, showDetails=FALSE)
+  printTextProtocol(tests, showDetails=FALSE,
+                    fileName=paste(pathReport, "Summary.txt", sep=""))
+  printTextProtocol(tests, showDetails=TRUE,
+                    fileName=paste(pathReport, ".txt", sep=""))
+ 
+  ## Report to HTML file
+  printHTMLProtocol(tests, fileName=paste(pathReport, ".html", sep=""))
+ 
+  ## Return stop() to cause R CMD check stop in case of
+  ##  - failures i.e. FALSE to unit tests or
+  ##  - errors i.e. R errors
+  tmp <- getErrors(tests)
+  if(tmp$nFail > 0 | tmp$nErr > 0) {
+    stop(paste("\n\nunit testing failed (#test failures: ", tmp$nFail,
+               ", #R errors: ",  tmp$nErr, ")\n\n", sep=""))
+  }
+} else {
+  warning("cannot run unit tests -- package RUnit is not available")
 }