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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jul 7 15:06:05 CEST 2010


Author: romain
Date: 2010-07-07 15:06:05 +0200 (Wed, 07 Jul 2010)
New Revision: 1808

Removed:
   pkg/Rcpp/inst/unitTests/runit.ExpressionVector.R
Modified:
   pkg/Rcpp/inst/unitTests/runit.Function.R
   pkg/Rcpp/inst/unitTests/runit.Vector.R
Log:
merge runit.RawVector and runit.ExpressionVector

Deleted: pkg/Rcpp/inst/unitTests/runit.ExpressionVector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.ExpressionVector.R	2010-07-07 12:40:00 UTC (rev 1807)
+++ pkg/Rcpp/inst/unitTests/runit.ExpressionVector.R	2010-07-07 13:06:05 UTC (rev 1808)
@@ -1,78 +0,0 @@
-#!/usr/bin/r -t
-#
-# Copyright (C) 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.ExpressionVector <- function(){
-	funx <- cppfunction(signature(), '
-	ExpressionVector x(2) ;
-	x[0] = Symbol( "rnorm" ) ;
-	x[1] = Rf_lcons( Symbol("rnorm"), Rf_cons( Rf_ScalarReal(10.0), R_NilValue) ) ;
-	return x ;'  )
-	ex <- parse( text = "rnorm; rnorm(10)" )
-	# get rid of the srcref stuff so that we can compare
-	# more easily
-	attributes(ex) <- NULL 
-	checkEquals( funx(),  ex , msg = "ExpressionVector" )
-}
-
-if( Rcpp:::capabilities()[["variadic templates"]] ){
-	test.ExpressionVector.variadic <- function(){
-		funx <- cppfunction(signature(), '
-		ExpressionVector x(2) ;
-		x[0] = Symbol( "rnorm" ) ;
-		x[1] = Language( "rnorm", 10.0 ) ;
-		return x ;', cxxargs = "-std=c++0x" )
-		ex <- parse( text = "rnorm; rnorm(10)" )
-		attributes(ex) <- NULL
-		checkEquals( funx(),  ex , msg = "ExpressionVector (using variadic templates) " )
-	}
-}
-
-test.ExpressionVector.parse <- function( ){
-	funx <- cppfunction(signature(), '
-	ExpressionVector code( "local( { y <- sample(1:10); sort(y) })" ) ;
-	return code ;'  )
-	code <- funx()
-	results <- eval( code )
-	checkEquals( results, 1:10, msg = "ExpressionVector parsing" )
-}
-
-test.ExpressionVector.parse.error <- function(){
-	funx <- cppfunction(signature(), '
-	ExpressionVector code( "rnorm(" ) ;
-	return code ;'  )
-	checkException( funx(), msg = "parse error" )
-}
-
-test.ExpressionVector.eval <- function(){
-	funx <- cppfunction(signature(), '
-	ExpressionVector code( "local( { y <- sample(1:10); sort(y) })" ) ;
-	return code.eval() ;'  )
-	checkEquals( funx(), 1:10, msg = "ExpressionVector::eval" )
-}
-
-test.ExpressionVector.eval.env <- function(){
-	funx <- cppfunction(signature(env = "environment"), '
-	ExpressionVector code( "sort(x)" ) ;
-	return code.eval(env) ;'  )
-	
-	e <- new.env()
-	e[["x"]] <- sample(1:10)
-	checkEquals( funx(e), 1:10, msg = "ExpressionVector::eval" )
-}
-

Modified: pkg/Rcpp/inst/unitTests/runit.Function.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Function.R	2010-07-07 12:40:00 UTC (rev 1807)
+++ pkg/Rcpp/inst/unitTests/runit.Function.R	2010-07-07 13:06:05 UTC (rev 1808)
@@ -71,8 +71,7 @@
 				'
         	)
         )
-
-        signatures <- lapply(f, "[[", 1L)
+  signatures <- lapply(f, "[[", 1L)
         bodies <- lapply(f, "[[", 2L)
         fun <- cxxfunction(signatures, bodies,
                            plugin = "Rcpp", includes = "using namespace std;",

Modified: pkg/Rcpp/inst/unitTests/runit.Vector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Vector.R	2010-07-07 12:40:00 UTC (rev 1807)
+++ pkg/Rcpp/inst/unitTests/runit.Vector.R	2010-07-07 13:06:05 UTC (rev 1808)
@@ -17,32 +17,156 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
+.setUp <- function() {
+    tests <- ".rcpp.Vector"
+    if( ! exists( tests, globalenv() )) {
+        ## definition of all the functions at once
+        f <- list(
+        	"raw_" = list( 
+        		signature(), 
+        		'
+				RawVector x(10) ;
+				for( int i=0; i<10; i++) x[i] = (Rbyte)i ;
+				return x ;
+				'
+        	), 
+        	"raw_REALSXP" = list( 
+        		signature(vec = "raw" ),
+        		'
+				RawVector x(vec) ;
+				for( int i=0; i<x.size(); i++) { 
+					x[i] = x[i]*2 ;
+				}
+				return x ;
+				'
+        	), 
+        	"expression_" = list( 
+        		signature(), 
+        		'
+				ExpressionVector x(2) ;
+				x[0] = Symbol( "rnorm" ) ;
+				x[1] = Rf_lcons( Symbol("rnorm"), Rf_cons( Rf_ScalarReal(10.0), R_NilValue) ) ;
+				return x ;
+				'
+        	), 
+        	"expression_variadic" = list( 
+        		signature(), 
+        		'
+				ExpressionVector x(2) ;
+				x[0] = Symbol( "rnorm" ) ;
+				x[1] = Language( "rnorm", 10.0 ) ;
+				return x ;
+				'
+        	), 
+        	"expression_parse" = list( 
+        		signature(), 
+        		'
+					ExpressionVector code( "local( { y <- sample(1:10); sort(y) })" ) ;
+					return code ;
+				'
+        	), 
+        	"expression_parseerror" = list( 
+        		signature(), 
+        		'
+					ExpressionVector code( "rnorm(" ) ;
+					return code ;
+				'
+        	), 
+        	"expression_eval" = list( 
+        		signature(), 
+        		'
+				ExpressionVector code( "local( { y <- sample(1:10); sort(y) })" ) ;
+				return code.eval() ;
+				'
+        	), 
+        	"expression_evalenv" = list( 
+        		signature(env = "environment"), 
+        		'
+				ExpressionVector code( "sort(x)" ) ;
+				return code.eval(env) ;
+				' 
+        	)
+        	
+        )
+
+        if (Rcpp:::capabilities()[["initializer lists"]]) {
+        	g <- list(
+        		"raw_initializer_list"=list(
+        			signature(), 
+        			'
+					RawVector x = {0,1,2,3} ;
+					for( int i=0; i<x.size(); i++) x[i] = x[i]*2 ;
+					return x ;
+					'
+        		)
+        	)
+        	f <- c(f,g)
+        }
+
+        signatures <- lapply(f, "[[", 1L)
+        bodies <- lapply(f, "[[", 2L)
+        fun <- cxxfunction(signatures, bodies,
+                           plugin = "Rcpp", includes = "using namespace std;",
+                           cxxargs = ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x",""))
+        getDynLib( fun ) # just forcing loading the dll now
+        assign( tests, fun, globalenv() )
+    }
+}
+
 test.RawVector <- function(){
-	funx <- cppfunction(signature(), '
-	RawVector x(10) ;
-	for( int i=0; i<10; i++) x[i] = (Rbyte)i ;
-	return x ;' )
+	funx <- .rcpp.Vector$raw_
 	checkEquals( funx(), as.raw(0:9), msg = "RawVector(int)" )
 }
 
 test.RawVector.REALSXP <- function(){
-	funx <- cppfunction(signature(vec = "raw" ), '
-	RawVector x(vec) ;
-	for( int i=0; i<x.size(); i++) { 
-		x[i] = x[i]*2 ;
-	}
-	return x ;'  )
+	funx <- .rcpp.Vector$raw_REALSXP
 	checkEquals( funx(as.raw(0:9)), as.raw(2*0:9), msg = "RawVector( RAWSXP) " )
 }
 
-test.RawVector.initializer.list <- function(){
-	if( Rcpp:::capabilities()[["initializer lists"]] ){
-		funx <- cppfunction(signature(), '
-		RawVector x = {0,1,2,3} ;
-		for( int i=0; i<x.size(); i++) x[i] = x[i]*2 ;
-		return x ;', cxxargs = "-std=c++0x" )
+if( Rcpp:::capabilities()[["initializer lists"]] ){
+	test.RawVector.initializer.list <- function(){
+		funx <- .rcpp.Vector$raw_initializer_list
 		checkEquals( funx(), as.raw(2*0:3), msg = "RawVector( initializer list) " )
 	}
 }
 
+test.ExpressionVector <- function(){
+	funx <- .rcpp.Vector$expression_
+	ex <- parse( text = "rnorm; rnorm(10)" )
+	# get rid of the srcref stuff so that we can compare
+	# more easily
+	attributes(ex) <- NULL 
+	checkEquals( funx(),  ex , msg = "ExpressionVector" )
+}
 
+test.ExpressionVector.variadic <- function(){
+	funx <- .rcpp.Vector$expression_variadic
+	ex <- parse( text = "rnorm; rnorm(10)" )
+	attributes(ex) <- NULL
+	checkEquals( funx(),  ex , msg = "ExpressionVector (using variadic templates) " )
+}
+
+test.ExpressionVector.parse <- function( ){
+	funx <- .rcpp.Vector$expression_parse
+	code <- funx()
+	results <- eval( code )
+	checkEquals( results, 1:10, msg = "ExpressionVector parsing" )
+}
+
+test.ExpressionVector.parse.error <- function(){
+	funx <- .rcpp.Vector$expression_parseerror
+	checkException( funx(), msg = "parse error" )
+}
+
+test.ExpressionVector.eval <- function(){
+	funx <- .rcpp.Vector$expression_eval
+	checkEquals( funx(), 1:10, msg = "ExpressionVector::eval" )
+}
+
+test.ExpressionVector.eval.env <- function(){
+	funx <- .rcpp.Vector$expression_evalenv
+	e <- new.env()
+	e[["x"]] <- sample(1:10)
+	checkEquals( funx(e), 1:10, msg = "ExpressionVector::eval in specific environment" )
+}
+



More information about the Rcpp-commits mailing list