[Rcpp-commits] r767 - in pkg/RcppArmadillo: . R inst inst/doc inst/doc/unitTests inst/unitTests tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Mon Feb 22 15:20:36 CET 2010
Author: romain
Date: 2010-02-22 15:20:36 +0100 (Mon, 22 Feb 2010)
New Revision: 767
Added:
pkg/RcppArmadillo/inst/doc/
pkg/RcppArmadillo/inst/doc/Makefile
pkg/RcppArmadillo/inst/doc/unitTests/
pkg/RcppArmadillo/inst/doc/unitTests/RcppArmadillo-unitTests.R
pkg/RcppArmadillo/inst/doc/unitTests/RcppArmadillo-unitTests.Rnw
pkg/RcppArmadillo/tests/
pkg/RcppArmadillo/tests/doRUnit.R
Removed:
pkg/RcppArmadillo/R/zzz.R
Modified:
pkg/RcppArmadillo/R/flags.R
pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
Log:
expand the unit test machinery
Modified: pkg/RcppArmadillo/R/flags.R
===================================================================
--- pkg/RcppArmadillo/R/flags.R 2010-02-22 13:46:30 UTC (rev 766)
+++ pkg/RcppArmadillo/R/flags.R 2010-02-22 14:20:36 UTC (rev 767)
@@ -1,4 +1,3 @@
-
## Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
##
## This file is part of RcppArmadillo.
Deleted: pkg/RcppArmadillo/R/zzz.R
===================================================================
--- pkg/RcppArmadillo/R/zzz.R 2010-02-22 13:46:30 UTC (rev 766)
+++ pkg/RcppArmadillo/R/zzz.R 2010-02-22 14:20:36 UTC (rev 767)
@@ -1,41 +0,0 @@
-# Copyright (C) 2010 Dirk Eddelbuettel and Romain Francois
-#
-# This file is part of RcppArmadillo.
-#
-# RcppArmadillo 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.
-#
-# RcppArmadillo 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 RcppArmadillo. If not, see <http://www.gnu.org/licenses/>.
-
-# RcppArmadilloExample <- function(){
-# .Call( "RcppArmadilloExample", PACKAGE = "RcppArmadillo" )
-# }
-#
-# RcppArmadilloExample_as_Mat <- function(){
-# integer_mat <- matrix( as.integer(diag(4)), ncol = 4, nrow = 4 )
-# numeric_mat <- diag(5)
-# .Call( "RcppArmadilloExample_as_Mat",
-# list( integer_mat, numeric_mat ),
-# PACKAGE = "RcppArmadillo" )
-# }
-#
-# RcppArmadilloExample_as_Col <- function(){
-# .Call( "RcppArmadilloExample_as_Col",
-# list( 1:10, as.numeric(1:10) ),
-# PACKAGE = "RcppArmadillo" )
-# }
-#
-# RcppArmadilloExample_as_Row <- function(){
-# .Call( "RcppArmadilloExample_as_Row",
-# list( 1:10, as.numeric(1:10) ),
-# PACKAGE = "RcppArmadillo" )
-# }
-
Added: pkg/RcppArmadillo/inst/doc/Makefile
===================================================================
--- pkg/RcppArmadillo/inst/doc/Makefile (rev 0)
+++ pkg/RcppArmadillo/inst/doc/Makefile 2010-02-22 14:20:36 UTC (rev 767)
@@ -0,0 +1,14 @@
+
+all: clean RcppArmadillo-unitTests.pdf
+
+clean:
+ touch RcppArmadillo-unitTests.pdf
+ rm RcppArmadillo-unitTests.pdf
+
+RcppArmadillo-unitTests.pdf:
+ rm -fr unitTests-results/*
+ Rscript unitTests/RcppArmadillo-unitTests.R
+ R CMD Sweave RcppArmadillo-unitTests.Rnw
+ Rscript -e "tools::texi2dvi( 'RcppArmadillo-unitTests.tex', pdf = TRUE, clean = TRUE )"
+ rm -fr RcppArmadillo-unitTests.tex
+
Added: pkg/RcppArmadillo/inst/doc/unitTests/RcppArmadillo-unitTests.R
===================================================================
--- pkg/RcppArmadillo/inst/doc/unitTests/RcppArmadillo-unitTests.R (rev 0)
+++ pkg/RcppArmadillo/inst/doc/unitTests/RcppArmadillo-unitTests.R 2010-02-22 14:20:36 UTC (rev 767)
@@ -0,0 +1,20 @@
+pkg <- "RcppArmadillo"
+
+# load this package
+require( pkg, character.only = TRUE )
+
+#load RUnit
+runit <- "RUnit" ; require( runit, character.only = TRUE )
+if( file.exists( "unitTests-results" ) ){ unlink("unitTests-results", recursive = TRUE ) }
+dir.create( "unitTests-results" )
+
+path <- system.file("unitTests", package = pkg)
+testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs = path)
+tests <- runTestSuite(testSuite)
+printHTMLProtocol(tests, fileName= sprintf( "unitTests-results/%s-unitTests.html" , pkg ) )
+printTextProtocol(tests, fileName= sprintf( "unitTests-results/%s-unitTests.txt" , pkg ) )
+if( file.exists( "/tmp" ) ){
+ file.copy( sprintf( "unitTests-results/%s-unitTests.txt" , pkg ) , "/tmp", overwrite = TRUE )
+ file.copy( sprintf( "unitTests-results/%s-unitTests.html", pkg ) , "/tmp", overwrite = TRUE )
+}
+
Added: pkg/RcppArmadillo/inst/doc/unitTests/RcppArmadillo-unitTests.Rnw
===================================================================
Modified: pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R 2010-02-22 13:46:30 UTC (rev 766)
+++ pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R 2010-02-22 14:20:36 UTC (rev 767)
@@ -19,14 +19,43 @@
test.wrap.R <- function(){
res <- .Call( "RcppArmadillo_wrap" )
-}
+
+ checkEquals( res[[1]][[1]], matrix(as.integer((diag(3))),nr=3), msg = "eye<imat>(3,3)" )
+ checkEquals( res[[1]][[2]], diag(3), msg = "eye<mat>(3,3)" )
+ checkEquals( res[[1]][[3]], diag(3), msg = "eye<fmat>(3,3)" )
+ checkEquals( res[[1]][[4]], matrix(as.integer((diag(3))),nr=3), msg = "eye<umat>(3,3)" )
+
+ checkEquals( res[[2]][[1]], matrix(0, ncol = 5, nrow=1), msg = "zeros<mat>(5,1)" )
+ checkEquals( res[[2]][[2]], matrix(0, ncol = 5, nrow=1), msg = "zeros<fmat>(5,1)" )
+
+ checkEquals( res[[3]][[1]], matrix(0, ncol = 1, nrow=5), msg = "zeros<mat>(1,5)" )
+ checkEquals( res[[3]][[2]], matrix(0, ncol = 1, nrow=5), msg = "zeros<mat>(1,5)" )
+
+ checkEquals( res[[4]][[1]], matrix(0:3, ncol = 2, nrow=2), msg = "field<int>" )
+ checkEquals( res[[4]][[2]], matrix(letters[1:4], ncol = 2, nrow=2), msg = "field<std::string>" )
+}
test.as.Mat <- function(){
+
+ integer_mat <- matrix( as.integer(diag(4)), ncol = 4, nrow = 4 )
+ numeric_mat <- diag(5)
+ res <- .Call( "RcppArmadillo_as_Mat",
+ list( integer_mat, numeric_mat ),
+ PACKAGE = "RcppArmadillo" )
+ checkEquals( unlist( res), c(4L, 5L, 4L, 5L ), msg = "as<Mat>" )
}
test.as.Col <- function(){
+ res <- .Call( "RcppArmadillo_as_Col",
+ list( 1:10, as.numeric(1:10) ),
+ PACKAGE = "RcppArmadillo" )
+ checkEquals( unlist( res ), rep(55.0, 4 ), msg = "as<Col>" )
}
test.as.Row <- function(){
+ res <- .Call( "RcppArmadillo_as_Row",
+ list( 1:10, as.numeric(1:10) ),
+ PACKAGE = "RcppArmadillo" )
+ checkEquals( unlist( res ), rep(55.0, 4 ), msg = "as<Row>" )
}
Added: pkg/RcppArmadillo/tests/doRUnit.R
===================================================================
--- pkg/RcppArmadillo/tests/doRUnit.R (rev 0)
+++ pkg/RcppArmadillo/tests/doRUnit.R 2010-02-22 14:20:36 UTC (rev 767)
@@ -0,0 +1,27 @@
+#### 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)
+
+ 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