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

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

Author: edd
Date: 2010-07-09 04:41:12 +0200 (Fri, 09 Jul 2010)
New Revision: 1844

Modified:
   pkg/Rcpp/inst/unitTests/runit.Function.R
Log:
disable RcppDatetime test on double init as TZ gets in the way on windows
also turn 'sort' example in Function test to increasing


Modified: pkg/Rcpp/inst/unitTests/runit.Function.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Function.R	2010-07-08 16:27:05 UTC (rev 1843)
+++ pkg/Rcpp/inst/unitTests/runit.Function.R	2010-07-09 02:41:12 UTC (rev 1844)
@@ -1,4 +1,5 @@
 #!/usr/bin/r -t
+# -*- mode: R; tab-width: 4 -*-
 #
 # Copyright (C) 2010	Dirk Eddelbuettel and Romain Francois
 #
@@ -22,48 +23,49 @@
     tests <- ".rcpp.Function"
     if( ! exists( tests, globalenv() )) {
         ## definition of all the functions at once
-        f <- list( 
-        	"function_" = list( 
+        f <- list(
+        	"function_" = list(
         		signature(x="ANY"), 'return Function(x) ;'
-        	), 
-        	"function_variadic" = list( 
-        		signature(x="function", y = "ANY"), 
+        	),
+        	"function_variadic" = list(
+        		signature(x="function", y = "ANY"),
         		'
 				Function sort(x) ;
-				return sort( y, Named("decreasing", true) ) ;
-				' 
-        	), 
-        	"function_env" = list( 
-        		signature(x="function"), 
+				//return sort( y, Named("decreasing", true) ) ;
+				return sort( y ) ;
+				'
+        	),
+        	"function_env" = list(
+        		signature(x="function"),
         		'
 					Function fun(x) ;
 					return fun.environment() ;
 				'
-        	), 
-        	"function_unarycall" = list( 
-        		signature(y = "list" ), 
+        	),
+        	"function_unarycall" = list(
+        		signature(y = "list" ),
         		'
 				Function len( "length" ) ;
 				List x(y) ;
 				IntegerVector output( x.size() ) ;
-				std::transform( 
-					x.begin(), x.end(), 
+				std::transform(
+					x.begin(), x.end(),
 					output.begin(),
 					unary_call<IntegerVector,int>(len)
 					) ;
 				return output ;
 				'
-        	), 
-        	"function_binarycall" = list( 
-        		signature(x1 = "list", x2 = "integer" ), 
+        	),
+        	"function_binarycall" = list(
+        		signature(x1 = "list", x2 = "integer" ),
         		'
 					Function pmin( "pmin" ) ;
 					List list(x1) ;
 					IntegerVector vec(x2) ;
 					List output( list.size() ) ;
-					std::transform( 
+					std::transform(
 						list.begin(), list.end(),
-						vec.begin(), 
+						vec.begin(),
 						output.begin(),
 						binary_call<IntegerVector,int,IntegerVector>(pmin)
 						) ;
@@ -86,36 +88,35 @@
 	funx <- .rcpp.Function$function_
     checkEquals( funx( rnorm ), rnorm, msg = "Function( CLOSXP )" )
 	checkEquals( funx( is.function ), is.function, msg = "Pairlist( BUILTINSXP )" )
-	
+
 	checkException( funx(1:10), msg = "Function( INTSXP) " )
 	checkException( funx(TRUE), msg = "Function( LGLSXP )" )
 	checkException( funx(1.3), msg = "Function( REALSXP) " )
 	checkException( funx(as.raw(1) ), msg = "Function( RAWSXP)" )
 	checkException( funx(new.env()), msg = "Function not compatible with environment" )
-	
+
 }
 
 test.Function.variadic <- function(){
 	funx <- .rcpp.Function$function_variadic
-    checkEquals( funx( sort, sample(1:20) ), 
-		20:1, msg = "calling function" )
+    checkEquals( funx( sort, sample(1:20) ), 1:20, msg = "calling function" )
 	checkException( funx(sort, sort), msg = "Function, R error -> exception" )
 }
 
 test.Function.env <- function(){
 	funx <- .rcpp.Function$function_env
     checkEquals( funx(rnorm), asNamespace("stats" ), msg = "Function::environment" )
-	checkException( funx(is.function), 
+	checkException( funx(is.function),
 		msg = "Function::environment( builtin) : exception" )
-	checkException( funx(`~`), 
+	checkException( funx(`~`),
 		msg = "Function::environment( special) : exception" )
 }
 
 test.Function.unary.call <- function(){
 	funx <- .rcpp.Function$function_unarycall
-	checkEquals( 
-		funx( lapply( 1:10, function(n) seq(from=n, to = 0 ) ) ), 
-		2:11 , 
+	checkEquals(
+		funx( lapply( 1:10, function(n) seq(from=n, to = 0 ) ) ),
+		2:11 ,
 		msg = "unary_call(Fcuntion)" )
 }
 
@@ -124,7 +125,7 @@
 	data <- lapply( 1:10, function(n) seq(from=n, to = 0 ) )
 	res <- funx( data , rep(5L,10) )
 	expected <- lapply( data, pmin, 5 )
-	checkEquals( res, expected, 
+	checkEquals( res, expected,
 		msg = "binary_call(Function)" )
 }