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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Thu Dec 9 14:18:47 CET 2010


Author: romain
Date: 2010-12-09 14:18:47 +0100 (Thu, 09 Dec 2010)
New Revision: 2754

Modified:
   pkg/Rcpp/R/unit.tests.R
   pkg/Rcpp/inst/unitTests/runit.DataFrame.R
   pkg/Rcpp/inst/unitTests/runit.Date.R
   pkg/Rcpp/inst/unitTests/runit.Function.R
   pkg/Rcpp/inst/unitTests/runit.Language.R
   pkg/Rcpp/inst/unitTests/runit.Matrix.R
   pkg/Rcpp/inst/unitTests/runit.Module.R
   pkg/Rcpp/inst/unitTests/runit.RObject.R
   pkg/Rcpp/inst/unitTests/runit.S4.R
   pkg/Rcpp/inst/unitTests/runit.Vector.R
   pkg/Rcpp/inst/unitTests/runit.as.R
   pkg/Rcpp/inst/unitTests/runit.environments.R
   pkg/Rcpp/inst/unitTests/runit.misc.R
   pkg/Rcpp/inst/unitTests/runit.stats.R
   pkg/Rcpp/inst/unitTests/runit.sugar.R
   pkg/Rcpp/inst/unitTests/runit.wrap.R
Log:
will explain later

Modified: pkg/Rcpp/R/unit.tests.R
===================================================================
--- pkg/Rcpp/R/unit.tests.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/R/unit.tests.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -27,3 +27,13 @@
 	system( cmd )
 }
 
+compile_unit_tests <- function( definitions, includes = "", cxxargs = "" ){
+    signatures <- lapply(definitions, "[[", 1L)
+    bodies <- lapply(definitions, "[[", 2L)
+    cxxfunction <- get( "cxxfunction", asNamespace("inline" ) )
+    fun <- cxxfunction( signatures, bodies, plugin = "Rcpp", 
+        includes = sprintf( "using namespace std;\n%s", paste( includes, collapse = "\n") ), 
+        cxxargs = cxxargs
+    )
+    fun
+}

Modified: pkg/Rcpp/inst/unitTests/runit.DataFrame.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.DataFrame.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.DataFrame.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -18,14 +18,8 @@
 # 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(){
-	suppressMessages( require( datasets ) )
-	data( iris )
-
-    tests <- ".Rcpp.DataFrame"
-    if( ! exists(tests, globalenv() )) {
-        ## definition of all the functions at once
-        f <- list("FromSEXP"=list(
+definitions <- function(){
+    list("FromSEXP"=list(
                   signature(x="ANY"),
                   'DataFrame df(x) ;
 				   return df;')
@@ -87,12 +81,15 @@
 						_["stringsAsFactors"] = false ); ')
 
                   )
+   
+}
 
-        signatures <- lapply(f, "[[", 1L)
-        bodies <- lapply(f, "[[", 2L)
-        fun <- cxxfunction(signatures, bodies,
-                           plugin = "Rcpp", includes = "using namespace std;")
-        getDynLib( fun ) # just forcing loading the dll now
+.setUp <- function(){
+	suppressMessages( require( datasets ) )
+	data( iris )
+    tests <- ".Rcpp.DataFrame"
+    if( ! exists(tests, globalenv() )) {
+        fun <- Rcpp:::compile_unit_tests( definitions() )
         assign( tests, fun, globalenv() )
     }
 }

Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -18,13 +18,8 @@
 # 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.Date"
-    if( ! exists(tests, globalenv() )) {
-
-        ## definition of all the functions at once
-        f <- list("ctor_sexp"=list(
+definitions <- function(){
+    list("ctor_sexp"=list(
                   signature(d="Date"),
                   'Date dt = Date(d);
                    return wrap(dt);')
@@ -125,12 +120,13 @@
 				    return wrap(dt);')
 
                   )
+}
 
-        signatures <- lapply(f, "[[", 1L)
-        bodies <- lapply(f, "[[", 2L)
-        fun <- cxxfunction( signatures, bodies, plugin = "Rcpp")
-        getDynLib( fun ) # just forcing loading the dll now
-        assign( tests, fun, globalenv() )
+.setUp <- function() {
+    tests <- ".Rcpp.Date"
+    if( ! exists(tests, globalenv() )) {
+        fun <- Rcpp:::compile_unit_tests(definitions() )
+        assign( tests, fun , globalenv() )
     }
 }
 

Modified: pkg/Rcpp/inst/unitTests/runit.Function.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Function.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.Function.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -18,12 +18,8 @@
 # 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() {
-	suppressMessages( require( stats ) )
-    tests <- ".rcpp.Function"
-    if( ! exists( tests, globalenv() )) {
-        ## definition of all the functions at once
-        f <- list(
+definitions <- function(){
+    list(
         	"function_" = list(
         		signature(x="ANY"), 'return Function(x) ;'
         	),
@@ -72,13 +68,22 @@
 					return output ;
 				'
         	)
+        )    
+}
+
+cxxargs <- function(){
+    ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x","")
+}
+
+.setUp <- function() {
+	suppressMessages( require( stats ) )
+    tests <- ".rcpp.Function"
+    if( ! exists( tests, globalenv() )) {
+        ## definition of all the functions at once
+        fun <- Rcpp:::compile_unit_tests( 
+            definitions(), 
+            cxxargs = cxxargs() 
         )
-  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() )
     }
 }

Modified: pkg/Rcpp/inst/unitTests/runit.Language.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Language.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.Language.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -17,11 +17,8 @@
 # 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(){
-	if( ! exists( ".rcpp.language", globalenv() ) ){
-		# definition of all the functions at once
-		
-		sugar.functions <- list( 
+definitions <- function(){
+    list( 
 			"runit_language" = list( 
 				signature(x="ANY"), 'return Language(x) ;'
 			), 
@@ -290,12 +287,12 @@
 			)
 			
 		)
-		
-		signatures <- lapply( sugar.functions, "[[", 1L )
-		bodies <- lapply( sugar.functions, "[[", 2L )
-		fx <- cxxfunction( signatures, bodies, plugin = "Rcpp" )
-		getDynLib( fx ) # just forcing loading the dll now
-		assign( ".rcpp.language", fx, globalenv() )
+}
+
+.setUp <- function(){
+	if( ! exists( ".rcpp.language", globalenv() ) ){
+		fun <- Rcpp:::compile_unit_tests( definitions() )
+		assign( ".rcpp.language", fun, globalenv() )
 	}
 }
 

Modified: pkg/Rcpp/inst/unitTests/runit.Matrix.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Matrix.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.Matrix.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -17,11 +17,8 @@
 # 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.Matrix"
-    if( ! exists( tests, globalenv() )) {
-        ## definition of all the functions at once
-        f <- list(
+definitions <- function(){
+    list(
         	"matrix_numeric" = list( 
         		signature(x = "matrix" ), '
 					NumericMatrix m(x) ;
@@ -225,13 +222,19 @@
 			    '
 			)
 		)
-        
-        signatures <- lapply(f, "[[", 1L)
-        bodies <- lapply(f, "[[", 2L)
-        fun <- cxxfunction(signatures, bodies,
-                           plugin = "Rcpp",
-                           cxxargs = ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x",""))
-        getDynLib( fun ) # just forcing loading the dll now
+}
+
+cxxargs <- function(){
+    ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x","")
+}
+
+.setUp <- function() {
+    tests <- ".rcpp.Matrix"
+    if( ! exists( tests, globalenv() )) {
+        fun <- Rcpp:::compile_unit_tests( 
+            definitions(), 
+            cxxargs = cxxargs()
+        )
         assign( tests, fun, globalenv() )
     }
 }

Modified: pkg/Rcpp/inst/unitTests/runit.Module.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Module.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.Module.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -109,73 +109,6 @@
 
 }
 
-# hide this one for now (suncc not happy about overloads)
-if(FALSE){
-test.Module.stdvec <- function(){
-
-code <- ''
-
-inc  <- '
-typedef std::vector<double> vec ;
-
-void vec_assign( vec* obj, Rcpp::NumericVector data ){
-	obj->assign( data.begin(), data.end() ) ;
-}
-
-void vec_insert( vec* obj, int position, Rcpp::NumericVector data){
-	vec::iterator it = obj->begin() + position ;
-	obj->insert( it, data.begin(), data.end() ) ;
-}
-
-Rcpp::NumericVector vec_asR( vec* obj){
-	return Rcpp::wrap( *obj ) ;
-}
-
-RCPP_MODULE(yada){
-	using namespace Rcpp ;
-
-	class_<vec>( "vec")
-	
-	    .constructor() 
-	    
-	 	.method( "size", &vec::size)
- 		.method( "max_size", &vec::max_size)
- 		.method( "resize", &vec::resize)
- 		.method( "capacity", &vec::capacity)
- 		.method( "empty", &vec::empty)
- 		.method( "reserve", &vec::reserve)
- 		.method( "push_back", &vec::push_back )
- 		.method( "pop_back", &vec::pop_back )
- 		.method( "clear", &vec::clear )
-
- 		.const_method( "back", &vec::back )
-		.const_method( "front", &vec::front )
-		.const_method( "at", &vec::at )
-
-		.method( "assign", &vec_assign )
-		.method( "insert", &vec_insert )
-		.method( "as.vector", &vec_asR )
-
-
-	;
-}
-
-'
-	fx <- cxxfunction( signature(), "", include = inc, plugin = "Rcpp" )
-
-	yada <- Rcpp:::Module( "yada", getDynLib( fx ) )
-	v <- new( yada$vec )
-	v$assign( 1:10 )
-
-	checkEquals( v$back(), 10 )
-	v$push_back( 10 )
-	checkEquals( as.integer(v$size()), 11L )
-	checkEquals( v$at( 0 ), 1 )
-	checkEquals( v$as.vector(), c(1:10, 10 ) )
-
-}
-}
-
 test.Module.property <- function(){
 
 	inc  <- '

Modified: pkg/Rcpp/inst/unitTests/runit.RObject.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RObject.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.RObject.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -18,14 +18,8 @@
 # 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(){
-    suppressMessages( require( datasets ) )
-    data( iris )
-
-    tests <- ".Rcpp.RObject"
-    if( ! exists(tests, globalenv() )) {
-        ## definition of all the functions at once
-        f <- list("asDouble"=list(
+definitions <- function(){
+    list("asDouble"=list(
                   signature(x="numeric"),
                   'double d = as<double>(x);
 				   return(wrap( 2*d ) );')
@@ -155,12 +149,22 @@
 
                   )
 
-        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
+}
+
+cxxargs <- function(){
+    ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x","")
+}
+
+.setUp <- function(){
+    suppressMessages( require( datasets ) )
+    data( iris )
+
+    tests <- ".Rcpp.RObject"
+    if( ! exists(tests, globalenv() )) {
+        fun <- Rcpp:::compile_unit_tests(
+            definitions(), 
+            cxxargs = cxxargs()
+        )
         assign( tests, fun, globalenv() )
     }
 }

Modified: pkg/Rcpp/inst/unitTests/runit.S4.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.S4.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.S4.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -17,11 +17,8 @@
 # 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.S4"
-    if( ! exists( tests, globalenv() )) {
-        ## definition of all the functions at once
-        f <- list(
+definitions <- function(){
+    list(
         	"S4_methods" = list( 
         		signature(x = "ANY" ), '
 					RObject y(x) ;
@@ -93,12 +90,19 @@
         	)
         )
         
-        signatures <- lapply(f, "[[", 1L)
-        bodies <- lapply(f, "[[", 2L)
-        fun <- cxxfunction(signatures, bodies,
-                           plugin = "Rcpp",
-                           cxxargs = ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x",""))
-        getDynLib( fun ) # just forcing loading the dll now
+}
+
+cxxargs <- function(){
+    ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x","")
+}
+
+.setUp <- function() {
+    tests <- ".rcpp.S4"
+    if( ! exists( tests, globalenv() )) {
+        fun <- Rcpp:::compile_unit_tests( 
+            definitions(), 
+            cxxargs = cxxargs() 
+        )
         assign( tests, fun, globalenv() )
     }
 }

Modified: pkg/Rcpp/inst/unitTests/runit.Vector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Vector.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.Vector.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -17,11 +17,8 @@
 # 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(
+definitions <- function(){
+    f <- list(
         	"raw_" = list( 
         		signature(), 
         		'
@@ -635,16 +632,28 @@
         	)     
         	f <- c(f,g)
         }
+        f
+    
+}
 
-        signatures <- lapply(f, "[[", 1L)
-        bodies <- lapply(f, "[[", 2L)
-        fun <- cxxfunction(signatures, bodies,
-                           plugin = "Rcpp", includes = "
-                           using namespace std;
-                           inline double square( double x){ return x*x; }
-                           ",
-                           cxxargs = ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x",""))
-        getDynLib( fun ) # just forcing loading the dll now
+includes <- function(){
+"
+    inline double square( double x){ return x*x; }
+"    
+}
+
+cxxargs <- function(){
+    ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x","")
+}
+
+.setUp <- function() {
+    tests <- ".rcpp.Vector"
+    if( ! exists( tests, globalenv() )) {
+        fun <- Rcpp:::compile_unit_tests( 
+            definitions(), 
+            includes = includes(), 
+            cxxargs = cxxargs()
+        )
         assign( tests, fun, globalenv() )
     }
 }

Modified: pkg/Rcpp/inst/unitTests/runit.as.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.as.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.as.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -17,76 +17,72 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
+definitions <- function() {
+    list("as_int"=list(
+              signature(x="numeric"),
+              'int y = as<int>(x);
+           return wrap(y) ;')
+    
+              ,"as_double"=list(
+               signature(x="numeric"),
+               'double y = as<double>(x) ;
+        return wrap(y) ;')
+    
+              ,"as_raw"=list(
+               signature(x="numeric"),
+               'Rbyte y = as<Rbyte>(x) ;
+            return wrap(y) ;')
+    
+              ,"as_bool"=list(
+               signature(x="numeric"),
+               'bool y = as<bool>(x) ;
+            return wrap(y) ;')
+    
+              ,"as_string"=list(
+               signature(x="character"),
+               'std::string y = as<std::string>(x) ;
+            return wrap(y) ;')
+    
+              ,"as_vector_int"=list(
+               signature(x="numeric"),
+               'vector<int> y = as< vector<int> >(x) ;
+            return wrap(y) ;')
+    
+              ,"as_vector_double"=list(
+               signature(x="numeric"),
+               'vector<double> y = as< vector<double> >(x) ;
+            return wrap(y) ;')
+    
+              ,"as_vector_raw"=list(
+               signature(x="numeric"),
+               'vector<Rbyte> y = as< vector<Rbyte> >(x) ;
+            return wrap(y) ;')
+    
+              ,"as_vector_bool"=list(
+               signature(x="numeric"),
+               'vector<bool> y = as< vector<bool> >(x) ;
+            return wrap(y) ;')
+    
+              ,"as_vector_string"=list(
+               signature(x="character"),
+               'vector<string> y = as< vector<string> >(x) ;
+            return wrap(y) ;')
+    
+              ,"as_deque_int"=list(
+               signature(x="integer"),
+               'deque<int> y = as< deque<int> >(x) ;
+        return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;')
+    
+              ,"as_list_int"=list(
+               signature(x="integer"),
+               'list<int> y = as< list<int> >(x) ;
+            return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;')
+            )
+}
 .setUp <- function() {
     tests <- ".rcpp.as"
     if( ! exists( tests, globalenv() )) {
-        ## definition of all the functions at once
-        f <- list("as_int"=list(
-                  signature(x="numeric"),
-                  'int y = as<int>(x);
-	           return wrap(y) ;')
-
-                  ,"as_double"=list(
-                   signature(x="numeric"),
-                   'double y = as<double>(x) ;
-		    return wrap(y) ;')
-
-                  ,"as_raw"=list(
-                   signature(x="numeric"),
-                   'Rbyte y = as<Rbyte>(x) ;
-	            return wrap(y) ;')
-
-                  ,"as_bool"=list(
-                   signature(x="numeric"),
-                   'bool y = as<bool>(x) ;
-	            return wrap(y) ;')
-
-                  ,"as_string"=list(
-                   signature(x="character"),
-                   'std::string y = as<std::string>(x) ;
-	            return wrap(y) ;')
-
-                  ,"as_vector_int"=list(
-                   signature(x="numeric"),
-                   'vector<int> y = as< vector<int> >(x) ;
-	            return wrap(y) ;')
-
-                  ,"as_vector_double"=list(
-                   signature(x="numeric"),
-                   'vector<double> y = as< vector<double> >(x) ;
-  	            return wrap(y) ;')
-
-                  ,"as_vector_raw"=list(
-                   signature(x="numeric"),
-                   'vector<Rbyte> y = as< vector<Rbyte> >(x) ;
-	            return wrap(y) ;')
-
-                  ,"as_vector_bool"=list(
-                   signature(x="numeric"),
-                   'vector<bool> y = as< vector<bool> >(x) ;
-	            return wrap(y) ;')
-
-                  ,"as_vector_string"=list(
-                   signature(x="character"),
-                   'vector<string> y = as< vector<string> >(x) ;
-	            return wrap(y) ;')
-
-                  ,"as_deque_int"=list(
-                   signature(x="integer"),
-                   'deque<int> y = as< deque<int> >(x) ;
-		    return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;')
-
-                  ,"as_list_int"=list(
-                   signature(x="integer"),
-                   'list<int> y = as< list<int> >(x) ;
-	            return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;')
-
-                  )
-
-        signatures <- lapply(f, "[[", 1L)
-        bodies <- lapply(f, "[[", 2L)
-        fun <- cxxfunction( signatures, bodies, plugin = "Rcpp", includes = "using namespace std;")
-        getDynLib( fun ) # just forcing loading the dll now
+        fun <- Rcpp:::compile_unit_tests(definitions())
         assign( tests, fun, globalenv() )
     }
 }

Modified: pkg/Rcpp/inst/unitTests/runit.environments.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.environments.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.environments.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -17,11 +17,8 @@
 # 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(){
-	if( ! exists( ".rcpp.environments", globalenv() ) ){
-		# definition of all the functions at once
-		
-		sugar.functions <- list( 
+definitions <- function(){
+    list( 
 			"runit_ls" = list( 
 				signature(x="environment"), 
 				'
@@ -184,11 +181,12 @@
 				'
 			)
 		)
-		signatures <- lapply( sugar.functions, "[[", 1L )
-		bodies <- lapply( sugar.functions, "[[", 2L )
-		fx <- cxxfunction( signatures, bodies, plugin = "Rcpp" )
-		getDynLib( fx ) # just forcing loading the dll now
-		assign( ".rcpp.environments", fx, globalenv() )
+}
+
+.setUp <- function(){
+	if( ! exists( ".rcpp.environments", globalenv() ) ){
+		fun <- Rcpp:::compile_unit_tests( definitions() )
+	    assign( ".rcpp.environments", fun, globalenv() )
 	}
 }
 			

Modified: pkg/Rcpp/inst/unitTests/runit.misc.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.misc.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.misc.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -17,11 +17,8 @@
 # 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.misc"
-    if( ! exists( tests, globalenv() )) {
-        ## definition of all the functions at once
-        f <- list(
+definitions <- function(){
+    list(
         	"symbol_" = list( 
         		signature(), 
         		'
@@ -80,11 +77,10 @@
 				'
         	)
         )   
+}
 
-        signatures <- lapply(f, "[[", 1L)
-        bodies <- lapply(f, "[[", 2L)
-        fun <- cxxfunction(signatures, bodies,
-                           plugin = "Rcpp", includes = "
+includes <- function(){
+    "
                            
     using namespace std;
                            
@@ -95,8 +91,21 @@
 	    int nrow() const { return dd[0]; }
 	    int ncol() const { return dd[1]; }
 	};
-	",  cxxargs = ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x",""))
-        getDynLib( fun ) # just forcing loading the dll now
+	"
+}
+
+cxxargs <- function() {
+    ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x","")
+}
+
+.setUp <- function() {
+    tests <- ".rcpp.misc"
+    if( ! exists( tests, globalenv() )) {
+        fun <- Rcpp:::compile_unit_tests( 
+            definitions(), 
+            includes = includes(),
+            cxxargs = cxxargs()
+        )
         assign( tests, fun, globalenv() )
     }
 }

Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -18,11 +18,8 @@
 # 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(){
-	if( ! exists( ".rcpp.stats", globalenv() ) ){
-		# definition of all the functions at once
-
-		f <- list(
+definitions <- function(){
+    list(
 				  "runit_dbeta" = list(
 				  signature(x = "numeric",
 							a = "numeric", b = "numeric"),
@@ -238,13 +235,15 @@
 			      return wrap(qt( xx, d, lt, lg));
 				  ')
 
-                  ) ## end of list of test function sources
+         )
+}
 
-		signatures <- lapply( f, "[[", 1L )
-		bodies <- lapply( f, "[[", 2L )
-		fx <- cxxfunction( signatures, bodies, plugin = "Rcpp" )
-		getDynLib( fx ) # just forcing loading the dll now
-		assign( ".rcpp.stats", fx, globalenv() )
+.setUp <- function(){
+	if( ! exists( ".rcpp.stats", globalenv() ) ){
+		fun <- Rcpp:::compile_unit_tests( 
+		    definitions()
+		)
+	    assign( ".rcpp.stats", fun, globalenv() )
 	}
 }
 

Modified: pkg/Rcpp/inst/unitTests/runit.sugar.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -17,11 +17,8 @@
 # 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(){
-	if( ! exists( ".rcpp.sugar", globalenv() ) ){
-		# definition of all the functions at once
-		
-		sugar.functions <- list( 
+definitions <- function(){
+list( 
 			"runit_abs" = list( 
 				signature( x = "numeric", y = "numeric" ), 
 				'
@@ -673,11 +670,11 @@
 			    '
 			)
 		)
-		
-		signatures <- lapply( sugar.functions, "[[", 1L )
-		bodies <- lapply( sugar.functions, "[[", 2L )
-		fx <- cxxfunction( signatures, bodies, plugin = "Rcpp", 
-			include = '
+		    
+}
+
+includes <- function(){
+'
 			template <typename T>
 			class square : public std::unary_function<T,T> {
 			public:
@@ -685,10 +682,16 @@
 			} ;
 			
 			double raw_square( double x){ return x*x; }
-	
-	')
-		getDynLib( fx ) # just forcing loading the dll now
-		assign( ".rcpp.sugar", fx, globalenv() )
+'    
+}
+
+.setUp <- function(){
+	if( ! exists( ".rcpp.sugar", globalenv() ) ){
+		fun <- Rcpp:::compile_unit_tests( 
+		    definitions(), 
+		    includes = includes()
+		)
+	    assign( ".rcpp.sugar", fun, globalenv() )
 	}
 }
 

Modified: pkg/Rcpp/inst/unitTests/runit.wrap.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.wrap.R	2010-12-09 12:36:48 UTC (rev 2753)
+++ pkg/Rcpp/inst/unitTests/runit.wrap.R	2010-12-09 13:18:47 UTC (rev 2754)
@@ -17,10 +17,8 @@
 # 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() {
-    if( ! exists( ".rcpp.wrap", globalenv() )) {
-        ## definition of all the functions at once
-        f <- list("map_string_int"=list(
+definitions <- function(){
+f <- list("map_string_int"=list(
                   signature(),
                   'std::map< std::string, int > m ;
    	           m["b"] = 100;
@@ -181,12 +179,13 @@
         if (Rcpp:::capabilities()[["tr1 unordered maps"]]) {
             f <- c(f,g)
         }
+        f
+}
 
-        signatures <- lapply(f, "[[", 1L)
-        bodies <- lapply(f, "[[", 2L)
-        fun <- cxxfunction( signatures, bodies, plugin = "Rcpp")
-        getDynLib( fun ) # just forcing loading the dll now
-        assign( ".rcpp.wrap", fun, globalenv() )
+.setUp <- function() {
+    if( ! exists( ".rcpp.wrap", globalenv() )) {
+       fun <- Rcpp:::compile_unit_tests( definitions() )
+       assign( ".rcpp.wrap", fun, globalenv() )
     }
 }
 



More information about the Rcpp-commits mailing list