[Rcpp-commits] r500 - in pkg: R inst inst/unitTests

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Jan 28 10:28:26 CET 2010


Author: romain
Date: 2010-01-28 10:28:26 +0100 (Thu, 28 Jan 2010)
New Revision: 500

Added:
   pkg/R/unit.tests.R
Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runTests.R
Log:
new unexported Rcpp:::test function to trigger unit tests

Added: pkg/R/unit.tests.R
===================================================================
--- pkg/R/unit.tests.R	                        (rev 0)
+++ pkg/R/unit.tests.R	2010-01-28 09:28:26 UTC (rev 500)
@@ -0,0 +1,29 @@
+# Copyright (C)        2009 - 2010 Dirk Eddelbuettel and Romain Francois
+#
+# This file is part of Rcpp.
+#
+# Rcpp 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.
+#
+# Rcpp 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 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 )
+}
+

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-28 09:07:16 UTC (rev 499)
+++ pkg/inst/ChangeLog	2010-01-28 09:28:26 UTC (rev 500)
@@ -1,5 +1,8 @@
 2010-01-28  Romain Francois <francoisromain at free.fr>
 
+	* R/unit.tests.R: new unexported function "test" to trigger
+	unit tests using installed test cases
+
 	* src/Rcpp/CharacterVector.h: minor bug fix in assign
 
 	* inst/unitTest/runit.RcppResultSet.R: compare time using 

Modified: pkg/inst/unitTests/runTests.R
===================================================================
--- pkg/inst/unitTests/runTests.R	2010-01-28 09:07:16 UTC (rev 499)
+++ pkg/inst/unitTests/runTests.R	2010-01-28 09:28:26 UTC (rev 500)
@@ -36,7 +36,7 @@
         		rx <- "^--output=(.*)$"
         		g  <- grep( rx, argv, value = TRUE )
         		if( length(g) ){
-        			sub( rx, "\\1", argv[g] )
+        			sub( rx, "\\1", g[1L] )
         		}
         	}
         }
@@ -64,6 +64,7 @@
         ## 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 ) )
         



More information about the Rcpp-commits mailing list