[Rcpp-commits] r3076 - in pkg/RcppEigen: . inst inst/unitTests tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Jun 15 03:59:51 CEST 2011
Author: edd
Date: 2011-06-15 03:59:47 +0200 (Wed, 15 Jun 2011)
New Revision: 3076
Added:
pkg/RcppEigen/inst/unitTests/
pkg/RcppEigen/inst/unitTests/runTests.R
pkg/RcppEigen/inst/unitTests/runit.fastLm.R
pkg/RcppEigen/tests/
pkg/RcppEigen/tests/doRUnit.R
Modified:
pkg/RcppEigen/ChangeLog
Log:
added initial unit tests
Modified: pkg/RcppEigen/ChangeLog
===================================================================
--- pkg/RcppEigen/ChangeLog 2011-06-15 00:40:18 UTC (rev 3075)
+++ pkg/RcppEigen/ChangeLog 2011-06-15 01:59:47 UTC (rev 3076)
@@ -1,3 +1,8 @@
+2011-06-14 Dirk Eddelbuettel <edd at debian.org>
+
+ * inst/unitTests/*: Added initial unit tests
+ * tests/doRUnit.R: Added hook to run RUnit tests
+
2011-06-14 Douglas Bates <bates at stat.wisc.edu>
* src/fastLm.cpp: Cosmetic fixes.
Added: pkg/RcppEigen/inst/unitTests/runTests.R
===================================================================
--- pkg/RcppEigen/inst/unitTests/runTests.R (rev 0)
+++ pkg/RcppEigen/inst/unitTests/runTests.R 2011-06-15 01:59:47 UTC (rev 3076)
@@ -0,0 +1,105 @@
+
+pkg <- "RcppEigen"
+
+if ( ! require( "inline", character.only = TRUE, quietly = TRUE ) ){
+ stop( "The inline package is required to run RcppEigen unit tests" )
+}
+
+if ( compareVersion( packageDescription( "inline" )[["Version"]], "0.3.5" ) < 0 ){
+ stop( "RcppEigen unit tests need at least the version 0.3.5 of inline" )
+}
+
+if (require("RUnit", quietly = TRUE)) {
+
+ is_local <- function(){
+ if ( exists( "argv", globalenv() ) && "--local" %in% argv ) return(TRUE)
+ if ( "--local" %in% commandArgs(TRUE) ) return(TRUE)
+ FALSE
+ }
+ if ( is_local() ) path <- getwd()
+
+ 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)
+
+ output <- NULL
+
+ process_args <- function(argv){
+ if ( !is.null(argv) && length(argv) > 0 ){
+ rx <- "^--output=(.*)$"
+ g <- grep( rx, argv, value = TRUE )
+ if ( length(g) ){
+ sub( rx, "\\1", g[1L] )
+ }
+ }
+ }
+
+ # R CMD check uses this
+ if ( exists( "RcppEigen.unit.test.output.dir", globalenv() ) ){
+ output <- RcppEigen.unit.test.output.dir
+ } else {
+
+ ## give a chance to the user to customize where he/she wants
+ ## the unit tests results to be stored with the --output= command
+ ## line argument
+ if ( exists( "argv", globalenv() ) ){
+ ## littler
+ output <- process_args(argv)
+ } else {
+ ## Rscript
+ output <- process_args(commandArgs(TRUE))
+ }
+ }
+
+ # if it did not work, try to use /tmp
+ if ( is.null(output) ){
+ if ( file.exists( "/tmp" ) ){
+ output <- "/tmp"
+ } else {
+ output <- getwd()
+ }
+ }
+
+ ## Print results
+ output.txt <- file.path( output, sprintf("%s-unitTests.txt", pkg))
+ output.html <- file.path( output, sprintf("%s-unitTests.html", pkg))
+
+ printTextProtocol(tests, fileName=output.txt)
+ message( sprintf( "saving txt unit test report to '%s'", output.txt ) )
+
+ ## Print HTML version to a file
+ ## printHTMLProtocol has problems on Mac OS X
+ if (Sys.info()["sysname"] != "Darwin"){
+ message( sprintf( "saving html unit test report to '%s'", output.html ) )
+ printHTMLProtocol(tests, fileName=output.html)
+ }
+
+ ## stop() if there are any failures i.e. FALSE to unit test.
+ ## This will cause R CMD check to return error and stop
+ err <- getErrors(tests)
+ if ( (err$nFail + err$nErr) > 0) {
+ stop( sprintf( "unit test problems: %d failures, %d errors", err$nFail, err$nErr) )
+ } else {
+ success <- err$nTestFunc - err$nFail - err$nErr - err$nDeactivated
+ cat( sprintf( "%d / %d\n", success, err$nTestFunc ) )
+ }
+ }
+} else {
+ cat("R package 'RUnit' cannot be loaded -- no unit tests run\n", "for package", pkg,"\n")
+}
+
Added: pkg/RcppEigen/inst/unitTests/runit.fastLm.R
===================================================================
--- pkg/RcppEigen/inst/unitTests/runit.fastLm.R (rev 0)
+++ pkg/RcppEigen/inst/unitTests/runit.fastLm.R 2011-06-15 01:59:47 UTC (rev 3076)
@@ -0,0 +1,48 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2011 Dirk Eddelbuettel, Romain Francois and Douglas Bates
+#
+# This file is part of RcppEigen
+#
+# RcppEigen is free software: you can redistribute it and/or modify it
+# under the terms of the GNU General Public License as published by
+# the Free Software Foundation, either version 2 of the License, or
+# (at your option) any later version.
+#
+# RcppEigen is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with RcppEigen. If not, see <http://www.gnu.org/licenses/>.
+
+.setUp <- function(){
+ suppressMessages(require(datasets))
+ suppressMessages(require(RcppEigen))
+}
+
+test.fastLm <- function() {
+ data(trees)
+ flm <- .Call("fastLm",
+ cbind(1, log(trees$Girth)),
+ log(trees$Volume),
+ package="RcppEigen")
+ fit <- lm(log(Volume) ~ log(Girth), data=trees)
+
+ checkEquals(as.numeric(flm$coefficients), as.numeric(coef(fit)),
+ msg="fastLm.coef")
+ checkEquals(as.numeric(flm$stderr), as.numeric(coef(summary(fit))[,2]),
+ msg="fastLm.stderr")
+}
+
+test.fastLm.formula <- function() {
+ data(trees)
+ flm <- fastLm(log(Volume) ~ log(Girth), data=trees)
+ fit <- lm(log(Volume) ~ log(Girth), data=trees)
+
+ checkEquals(flm$coefficients, coef(fit), msg="fastLm.formula.coef")
+ checkEquals(as.numeric(flm$stderr), as.numeric(coef(summary(fit))[,2]),
+ msg="fastLm.formula.stderr")
+}
+
Added: pkg/RcppEigen/tests/doRUnit.R
===================================================================
--- pkg/RcppEigen/tests/doRUnit.R (rev 0)
+++ pkg/RcppEigen/tests/doRUnit.R 2011-06-15 01:59:47 UTC (rev 3076)
@@ -0,0 +1,33 @@
+#### doRUnit.R --- Run RUnit tests
+####------------------------------------------------------------------------
+
+### borrowed from package fUtilities in RMetrics
+### http://r-forge.r-project.org/plugins/scmsvn/viewcvs.php/pkg/fUtilities/tests/doRUnit.R?rev=1958&root=rmetrics&view=markup
+
+### Originally follows Gregor Gojanc's example in CRAN package 'gdata'
+### and the corresponding section in the R Wiki:
+### http://wiki.r-project.org/rwiki/doku.php?id=developers:runit
+
+### MM: Vastly changed: This should also be "runnable" for *installed*
+## package which has no ./tests/
+## ----> put the bulk of the code e.g. in ../inst/unitTests/runTests.R :
+
+if(require("RUnit", quietly = TRUE)) {
+ pkg <- "RcppArmadillo"
+
+ require( pkg, character.only=TRUE)
+
+ path <- system.file("unitTests", package = pkg)
+
+ stopifnot(file.exists(path), file.info(path.expand(path))$isdir)
+
+ ## without this, we get unit test failures
+ Sys.setenv( R_TESTS = "" )
+
+ RcppArmadillo.unit.test.output.dir <- getwd()
+
+ source(file.path(path, "runTests.R"), echo = TRUE)
+
+} else {
+ print( "package RUnit not available, cannot run unit tests" )
+}
More information about the Rcpp-commits
mailing list