[Rcpp-commits] r4453 - in pkg/Rcpp: . R inst/doc vignettes

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Aug 31 20:40:31 CEST 2013


Author: edd
Date: 2013-08-31 20:40:31 +0200 (Sat, 31 Aug 2013)
New Revision: 4453

Removed:
   pkg/Rcpp/inst/doc/unitTests/
Modified:
   pkg/Rcpp/R/unit.tests.R
   pkg/Rcpp/cleanup
   pkg/Rcpp/vignettes/Rcpp-unitTests.Rnw
Log:
unitTest vignette now works from vignettes/ (and without using a Makefile)


Modified: pkg/Rcpp/R/unit.tests.R
===================================================================
--- pkg/Rcpp/R/unit.tests.R	2013-08-31 17:12:29 UTC (rev 4452)
+++ pkg/Rcpp/R/unit.tests.R	2013-08-31 18:40:31 UTC (rev 4453)
@@ -16,36 +16,36 @@
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
 test <- function( output = if( file.exists( "/tmp" ) ) "/tmp" else getwd() ){
-	if( !file.exists( output ) ){ stop( "output directory does not exist" ) }
-	
-	Rscript <- file.path( R.home( component = "bin" ), "Rscript" )
-	if( .Platform$OS.type == "windows" ){
-		Rscript <- sprintf( "%s.exe", Rscript )
-	}
-	test.script <- system.file( "unitTests", "runTests.R", package = "Rcpp" )
-	cmd <- sprintf( '"%s" "%s" --output=%s', Rscript, test.script, output )
-	system( cmd )
+    if( !file.exists( output ) ){ stop( "output directory does not exist" ) }
+
+    Rscript <- file.path( R.home( component = "bin" ), "Rscript" )
+    if( .Platform$OS.type == "windows" ){
+        Rscript <- sprintf( "%s.exe", Rscript )
+    }
+    test.script <- system.file( "unitTests", "runTests.R", package = "Rcpp" )
+    cmd <- sprintf( '"%s" "%s" --output=%s', Rscript, test.script, output )
+    system( cmd )
 }
 
 compile_unit_tests <- function( definitions, includes = "", cxxargs = "" ){
     signatures <- lapply(definitions, "[[", 1L)
     bodies <- lapply(definitions, "[[", 2L)
     cxxfunction <- get( "cxxfunction", asNamespace("inline" ) )
-    fun <- cxxfunction( signatures, bodies, plugin = "Rcpp", 
-        includes = sprintf( "using namespace std;\n%s", paste( includes, collapse = "\n") ), 
+    fun <- cxxfunction( signatures, bodies, plugin = "Rcpp",
+        includes = sprintf( "using namespace std;\n%s", paste( includes, collapse = "\n") ),
         cxxargs = cxxargs
     )
     fun
 }
 
 unit_test_setup <- function(file, packages = NULL) {
-	function(){
-	    if( !is.null(packages) ){
-	        for( p in packages ){
-	            suppressMessages( require( p, character.only = TRUE ) )
-	        }
-	    }
-	    if (!exists("pathRcppTests")) pathRcppTests <- getwd()
+    function(){
+        if( !is.null(packages) ){
+            for( p in packages ){
+                suppressMessages( require( p, character.only = TRUE ) )
+            }
+        }
+        if (!exists("pathRcppTests")) pathRcppTests <- getwd()
         sourceCpp(file.path(pathRcppTests, "cpp", file ))
     }
 }

Modified: pkg/Rcpp/cleanup
===================================================================
--- pkg/Rcpp/cleanup	2013-08-31 17:12:29 UTC (rev 4452)
+++ pkg/Rcpp/cleanup	2013-08-31 18:40:31 UTC (rev 4453)
@@ -24,10 +24,11 @@
 	src/Makedeps libRcpp.a \
 	build/Rcpp.pdf \
 	src/symbols.rds \
-	inst/unitTests/testRcppClass/src/symbols.rds
+	inst/unitTests/testRcppClass/src/symbols.rds \
+	vignettes/*.aux vignettes/*.log vignettes/*.out \
 
 rm -rf	autom4te.cache inst/lib/ inst/doc/man/ inst/doc/html/ inst/doc/latex/ \
-   	inst/doc/auto inst/doc/Rcpp-*/auto/ src-* 
+   	inst/doc/auto inst/doc/Rcpp-*/auto/ src-* vignettesq/auto
 
 find . -name \*~ -exec rm {} \;
 find . -name \*.flc -exec rm {} \;

Modified: pkg/Rcpp/vignettes/Rcpp-unitTests.Rnw
===================================================================
--- pkg/Rcpp/vignettes/Rcpp-unitTests.Rnw	2013-08-31 17:12:29 UTC (rev 4452)
+++ pkg/Rcpp/vignettes/Rcpp-unitTests.Rnw	2013-08-31 18:40:31 UTC (rev 4453)
@@ -1,5 +1,8 @@
 \documentclass[10pt]{article}
 %\VignetteIndexEntry{Rcpp-unitTests}
+%\VignetteKeywords{R,Rcpp,unit tests}
+%\VignettePackage{Rcpp}
+
 \usepackage{vmargin}
 \setmargrb{0.75in}{0.75in}{0.75in}{0.75in}
 
@@ -7,28 +10,60 @@
 \RequirePackage[T1]{fontenc}
 
 <<echo=FALSE,print=FALSE>>=
-require( Rcpp )
+require(Rcpp)
 prettyVersion <- packageDescription("Rcpp")$Version
 prettyDate <- format(Sys.Date(), "%B %e, %Y")
+library(RUnit)
 @
 
 \usepackage[colorlinks]{hyperref}
 \author{Dirk Eddelbuettel \and Romain Fran\c{c}ois}
-\title{\texttt{Rcpp}: Unit testing results}
-\date{\texttt{Rcpp} version \Sexpr{prettyVersion} as of \Sexpr{prettyDate}}
+\title{\textbf{Rcpp}: Unit testing results}
+\date{Rcpp version \Sexpr{prettyVersion} as of \Sexpr{prettyDate}}
 
 \begin{document}
 \maketitle
 
+\section*{Test Execution}
+
+<<unitTesting,echo=FALSE,print=FALSE>>=
+pkg <- "Rcpp"
+
+## Make sure we run all tests for the vignette
+Sys.setenv("RunAllRcppTests"="yes")
+
+if (file.exists("unitTests-results")) unlink("unitTests-results", recursive = TRUE)
+dir.create("unitTests-results")
+pathRcppTests <<- system.file("unitTests", package = pkg)
+path <- system.file("unitTests", package=pkg)
+testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs=path)
+tests <- runTestSuite(testSuite)
+err <- getErrors(tests)
+if (err$nFail > 0) stop(sprintf("unit test problems: %d failures", err$nFail))
+if (err$nErr > 0) stop( sprintf("unit test problems: %d errors", err$nErr))
+printHTMLProtocol(tests, fileName=sprintf("unitTests-results/%s-unitTests.html", pkg))
+printTextProtocol(tests, fileName=sprintf("unitTests-results/%s-unitTests.txt" , pkg))
+
+if (file.exists("/tmp")) {
+    invisible(sapply(c("txt", "html"), function(ext) {
+        fname <- sprintf("unitTests-results/%s-unitTests.%s", pkg, ext)
+        file.copy(fname, "/tmp", overwrite=TRUE)
+    }))
+}
+@
+
+\section*{Test Results}
+
 \begin{verbatim}
-<<echo=F,results=tex>>=
+<<importResults,echo=FALSE,results=tex>>=
 results <- "unitTests-results/Rcpp-unitTests.txt"
-if( file.exists( results ) ){
-	writeLines( readLines( results ) )
+if (file.exists(results)) {
+    writeLines(readLines(results))
 } else{
-	writeLines( "unit test results not available" )
+    writeLines( "unit test results not available" )
 }
 @
+
 \end{verbatim}
 
 \end{document}



More information about the Rcpp-commits mailing list