[Rcpp-commits] r2165 - in pkg/Rcpp: R inst/unitTests tests
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Fri Sep 24 21:40:08 CEST 2010
Author: jmc
Date: 2010-09-24 21:40:08 +0200 (Fri, 24 Sep 2010)
New Revision: 2165
Added:
pkg/Rcpp/inst/unitTests/runit.modref.R
Removed:
pkg/Rcpp/tests/modref.R
Modified:
pkg/Rcpp/R/Module.R
Log:
more direct field binder functions; mov modref.R to runit.modref.R in unit tests
Modified: pkg/Rcpp/R/Module.R
===================================================================
--- pkg/Rcpp/R/Module.R 2010-09-24 15:40:54 UTC (rev 2164)
+++ pkg/Rcpp/R/Module.R 2010-09-24 19:40:08 UTC (rev 2165)
@@ -224,13 +224,13 @@
binding_maker <- function( FIELD, where ){
f <- function( x ) NULL
body(f) <- substitute({
- fieldPtr <- FIELD
- if( missing( x ) ){
- fieldPtr$get( .pointer )
- } else {
- fieldPtr$set( .pointer, x )
- }
- }, list(FIELD = FIELD))
+ if( missing( x ) )
+ .Call("CppField__get", class_pointer, pointer, .pointer, PACKAGE = "Rcpp")
+ else
+ .Call("CppField__set", class_pointer, pointer, .pointer, x,
+ PACKAGE = "Rcpp")
+ }, list(class_pointer = FIELD$class_pointer,
+ pointer = FIELD$pointer))
environment(f) <- where
f
}
Added: pkg/Rcpp/inst/unitTests/runit.modref.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.modref.R (rev 0)
+++ pkg/Rcpp/inst/unitTests/runit.modref.R 2010-09-24 19:40:08 UTC (rev 2165)
@@ -0,0 +1,60 @@
+ require( Rcpp )
+ if(!require( inline ))
+ q("no")
+
+ inc <- '
+
+ class World {
+ public:
+ World() : foo(1), msg("hello") {}
+ void set(std::string msg_) { this->msg = msg_; }
+ std::string greet() { return msg; }
+
+ int foo ;
+ double bar ;
+
+ private:
+ std::string msg;
+ };
+
+ void clearWorld( World* w ){
+ w->set( "" );
+ }
+
+ RCPP_MODULE(yada){
+ using namespace Rcpp ;
+
+ class_<World>( "World" )
+ .method( "greet", &World::greet )
+ .method( "set", &World::set )
+ .method( "clear", &clearWorld )
+
+ .field( "foo", &World::foo )
+ .field_readonly( "bar", &World::bar )
+ ;
+
+ }
+
+ '
+ fx <- inline::cxxfunction( signature(), "" , include = inc, plugin = "Rcpp" )
+
+ mod <- Module( "yada", getDynLib(fx) )
+
+ World <- mod$World
+
+ww = new(World)
+wg = World$new()
+
+stopifnot(all.equal(ww$greet(), wg$greet()))
+wgg <- wg$greet()
+
+ww$set("Other")
+
+## test independence of ww, wg
+stopifnot(all.equal(ww$greet(), "Other"),
+ all.equal(wg$greet(), wgg))
+
+World$methods(
+ twice = function() paste(greet(), greet()))
+
+stopifnot(all.equal(ww$twice(), paste(ww$greet(), ww$greet())))
Deleted: pkg/Rcpp/tests/modref.R
===================================================================
--- pkg/Rcpp/tests/modref.R 2010-09-24 15:40:54 UTC (rev 2164)
+++ pkg/Rcpp/tests/modref.R 2010-09-24 19:40:08 UTC (rev 2165)
@@ -1,60 +0,0 @@
- require( Rcpp )
- if(!require( inline ))
- q("no")
-
- inc <- '
-
- class World {
- public:
- World() : foo(1), msg("hello") {}
- void set(std::string msg_) { this->msg = msg_; }
- std::string greet() { return msg; }
-
- int foo ;
- double bar ;
-
- private:
- std::string msg;
- };
-
- void clearWorld( World* w ){
- w->set( "" );
- }
-
- RCPP_MODULE(yada){
- using namespace Rcpp ;
-
- class_<World>( "World" )
- .method( "greet", &World::greet )
- .method( "set", &World::set )
- .method( "clear", &clearWorld )
-
- .field( "foo", &World::foo )
- .field_readonly( "bar", &World::bar )
- ;
-
- }
-
- '
- fx <- inline::cxxfunction( signature(), "" , include = inc, plugin = "Rcpp" )
-
- mod <- Module( "yada", getDynLib(fx) )
-
- World <- mod$World
-
-ww = new(World)
-wg = World$new()
-
-stopifnot(all.equal(ww$greet(), wg$greet()))
-wgg <- wg$greet()
-
-ww$set("Other")
-
-## test independence of ww, wg
-stopifnot(all.equal(ww$greet(), "Other"),
- all.equal(wg$greet(), wgg))
-
-World$methods(
- twice = function() paste(greet(), greet()))
-
-stopifnot(all.equal(ww$twice(), paste(ww$greet(), ww$greet())))
More information about the Rcpp-commits
mailing list