[Rcpp-commits] r2735 - in pkg/RcppClassic: . inst/doc inst/unitTests tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Dec 8 00:24:10 CET 2010
Author: edd
Date: 2010-12-08 00:24:10 +0100 (Wed, 08 Dec 2010)
New Revision: 2735
Added:
pkg/RcppClassic/inst/unitTests/runTests.R
pkg/RcppClassic/tests/
pkg/RcppClassic/tests/doRUnit.R
Modified:
pkg/RcppClassic/DESCRIPTION
pkg/RcppClassic/cleanup
pkg/RcppClassic/inst/doc/Makefile
Log:
some steps towards unitTests
some more cleanup
Modified: pkg/RcppClassic/DESCRIPTION
===================================================================
--- pkg/RcppClassic/DESCRIPTION 2010-12-07 13:48:10 UTC (rev 2734)
+++ pkg/RcppClassic/DESCRIPTION 2010-12-07 23:24:10 UTC (rev 2735)
@@ -9,6 +9,7 @@
facilitates the integration of R and C++. New project should use the new
Rcpp API in the Rcpp package
Depends: R (>= 2.12.0), Rcpp (>= 0.8.9.3), methods
+Suggests: RUnit, inline
LinkingTo: Rcpp
License: GPL (>= 2)
MailingList: Please send questions and comments regarding Rcpp to rcpp-devel at lists.r-forge.r-project.org
Modified: pkg/RcppClassic/cleanup
===================================================================
--- pkg/RcppClassic/cleanup 2010-12-07 13:48:10 UTC (rev 2734)
+++ pkg/RcppClassic/cleanup 2010-12-07 23:24:10 UTC (rev 2735)
@@ -1,4 +1,8 @@
+cd inst/doc
+make clean
+cd ../..
+
rm -f src/*.o src/*.so src/*.a src/*.d src/*.dll src/*.rc \
inst/lib/libRcppClassic.so inst/lib/*.h inst/lib/libRcppClassic.a \
inst/doc/*.out \
@@ -6,7 +10,9 @@
inst/doc/*.aux inst/doc/*.log inst/doc/*.tex \
inst/doc/latex/*.aux inst/doc/latex/*.log \
src/Makedeps libRcppClassic.a \
- build/RcppClassic.pdf
+ build/RcppClassic.pdf
+rm -rf inst/doc/auto
+
find . -name \*~ -exec rm {} \;
find . -name \*.flc -exec rm {} \;
Modified: pkg/RcppClassic/inst/doc/Makefile
===================================================================
--- pkg/RcppClassic/inst/doc/Makefile 2010-12-07 13:48:10 UTC (rev 2734)
+++ pkg/RcppClassic/inst/doc/Makefile 2010-12-07 23:24:10 UTC (rev 2735)
@@ -13,8 +13,8 @@
pdfclean:
rm -f RcppClassic.pdf
clean:
- rm -f index.html
- rm -f *.tex *.bbl *.blg *.aux *.out *.log
+ @rm -f index.html
+ @rm -f *.tex *.bbl *.blg *.aux *.out *.log
RcppClassic.pdf: RcppClassic.Rnw
R CMD Sweave RcppClassic.Rnw
Added: pkg/RcppClassic/inst/unitTests/runTests.R
===================================================================
--- pkg/RcppClassic/inst/unitTests/runTests.R (rev 0)
+++ pkg/RcppClassic/inst/unitTests/runTests.R 2010-12-07 23:24:10 UTC (rev 2735)
@@ -0,0 +1,162 @@
+## -*- mode: R; tab-width: 4 -*-
+##
+## Copyright (C) 2009 - 2010 Dirk Eddelbuettel and Romain Francois
+##
+## This file is part of RcppClassic.
+##
+## RcppClassic 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.
+##
+## RcppClassic 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 RcppClassic. If not, see <http://www.gnu.org/licenses/>.
+
+pkg <- "RcppClassic"
+
+if( ! require( "inline", character.only = TRUE, quietly = TRUE ) ){
+ stop( "The inline package is required to run RcppClassic unit tests" )
+}
+
+if( compareVersion( packageDescription( "inline" )[["Version"]], "0.3.4.4" ) < 0 ){
+ stop( "RcppClassic unit tests need at least the version 0.3.4.4 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
+ # , testFileRegexp = "Vector"
+ )
+
+ ## this is crass but as we time out on Windows we have no choice
+ ## but to disable a number of tests
+ ## TODO: actually prioritize which ones we want
+ allTests <- function() {
+ if (.Platform$OS.type != "windows") return(TRUE)
+ if (exists( "argv", globalenv() ) && "--allTests" %in% argv) return(TRUE)
+ if ("--allTests" %in% commandArgs(TRUE)) return(TRUE)
+ return(FALSE)
+ }
+ ## if (.Platform$OS.type == "windows" && allTests() == FALSE) {
+ ## ## by imposing [D-Z] (instead of an implicit A-Z) we are going from
+ ## ## 45 tests to run down to 38 (numbers as of release 0.8.3)
+ ## testSuite$testFileRegexp <- "^runit.[D-Z]+\\.[rR]$"
+ ## }
+
+ 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( "RcppClassic.unit.test.output.dir", globalenv() ) ){
+ output <- RcppClassic.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) {
+ data <- Filter(
+ function(x) any( sapply(x, function(.) .[["kind"]] ) %in% c("error","failure") ) ,
+ tests[[1]]$sourceFileResults )
+ err_msg <- sapply( data,
+ function(x) {
+ raw.msg <- paste(
+ sapply( Filter( function(.) .[["kind"]] %in% c("error","failure"), x ), "[[", "msg" ),
+ collapse = " // "
+ )
+ raw.msg <- gsub( "Error in compileCode(f, code, language = language, verbose = verbose) : \n", "", raw.msg, fixed = TRUE )
+ raw.msg <- gsub( "\n", "", raw.msg, fixed = TRUE )
+ raw.msg
+ }
+ )
+ msg <- sprintf( "unit test problems: %d failures, %d errors\n%s",
+ err$nFail, err$nErr,
+ paste( err_msg, collapse = "\n" )
+ )
+ stop( msg )
+ } 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/RcppClassic/tests/doRUnit.R
===================================================================
--- pkg/RcppClassic/tests/doRUnit.R (rev 0)
+++ pkg/RcppClassic/tests/doRUnit.R 2010-12-07 23:24:10 UTC (rev 2735)
@@ -0,0 +1,37 @@
+#### 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( identical( .Platform$OS.type, "windows" ) && identical( .Platform$r_arch, "x64" ) ){
+ print( "unit tests not run on windows 64 (workaround alert)" )
+} else {
+ if(require("RUnit", quietly = TRUE)) {
+ pkg <- "RcppClassic"
+
+ 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 = "" )
+
+ Rcpp.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