[Rcpp-commits] r499 - pkg/inst/unitTests

[noreply at r-forge.r-project.org]

Author: romain
Date: 2010-01-28 10:07:16 +0100 (Thu, 28 Jan 2010)
New Revision: 499

Modified:
   pkg/inst/unitTests/runTests.R
   pkg/inst/unitTests/runit.RcppResultSet.R
Log:
added --local and --output command line arguments to runTests.R script

Modified: pkg/inst/unitTests/runTests.R
===================================================================
--- pkg/inst/unitTests/runTests.R	2010-01-28 08:16:53 UTC (rev 498)
+++ pkg/inst/unitTests/runTests.R	2010-01-28 09:07:16 UTC (rev 499)
@@ -2,6 +2,13 @@
 
 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)
@@ -21,25 +28,51 @@
     } else { ## run from shell / Rscript / R CMD Batch / ...
         ## Run
         tests <- runTestSuite(testSuite)
-
-        if(file.access(path, 02) != 0) {
-            ## cannot write to path -> use writable one
-            tdir <- tempfile(paste(pkg, "unitTests", sep="_"))
-            dir.create(tdir)
-            pathReport <- file.path(tdir, "report")
-            cat("RUnit reports are written into ", tdir, "/report.(txt|html)",
-                sep = "")
+        
+        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", argv[g] )
+        		}
+        	}
+        }
+        
+        # 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 {
-            pathReport <- file.path(path, "report")
+        	# 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
-        # printTextProtocol(tests)
-        printTextProtocol(tests, fileName=paste(pathReport, ".txt", sep=""))
+        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")
-        printHTMLProtocol(tests, fileName=paste(pathReport, ".html", sep=""))
+        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
@@ -52,6 +85,3 @@
     "for package", pkg,"\n")
 }
 
-
-################################################################################
-

Modified: pkg/inst/unitTests/runit.RcppResultSet.R
===================================================================
--- pkg/inst/unitTests/runit.RcppResultSet.R	2010-01-28 08:16:53 UTC (rev 498)
+++ pkg/inst/unitTests/runit.RcppResultSet.R	2010-01-28 09:07:16 UTC (rev 499)
@@ -116,10 +116,10 @@
      # setting tz = "UTC" because otherwise the format gets set as the tz
      posixt <- as.POSIXct("2000-01-01 01:02:03.456", "%Y-%m-%d %H:%M:%OS", tz = "UTC" )
      result <- funx(as.numeric(posixt))[[1]]
-     # RcppDateTime discards the timezone, so the only reliable way to 
-     # compare these times is to compare the numeric values
-     checkEquals( as.numeric(result), as.numeric(posixt), 
-     	msg = "RcppResultSet.RcppDatetime")
+     # RcppDateTime discards the timezone, so we have to set it back 
+     # otherwise the comparison fails on the attributes
+     attr( result, "tzone") <- "UTC" 
+     checkEquals( result, posixt, msg = "RcppResultSet.RcppDatetime")
 }
 
 test.RcppResultSet.RcppDatetimeVector <- function() {