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

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

Author: romain
Date: 2010-06-18 19:17:21 +0200 (Fri, 18 Jun 2010)
New Revision: 1610

Modified:
   pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R
Log:
this is fun

Modified: pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R	2010-06-18 17:03:04 UTC (rev 1609)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.sapply.R	2010-06-18 17:17:21 UTC (rev 1610)
@@ -57,3 +57,24 @@
 	checkEquals( fx(1:10) , (1:10)^2 )
 }
 
+test.sugar.sapply.square <- function( ){
+
+	inc <- '
+	template <typename T>
+	class square : public std::unary_function<T,T> {
+	public:
+		T operator()( T t) const { return t*t ; }
+	} ;
+	'
+	
+	fx <- cxxfunction( signature( x = "numeric" ), '
+	
+		NumericVector xx(x) ;
+		return all( sapply( xx * xx , square<double>() ) < 10 );
+	
+	', include = inc, plugin = "Rcpp" )
+	
+	checkTrue( fx(1:10)  )
+}
+
+