[Rcpp-commits] r1170 - in pkg/Rcpp/inst: . include/Rcpp unitTests

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

Author: romain
Date: 2010-05-05 12:29:07 +0200 (Wed, 05 May 2010)
New Revision: 1170

Modified:
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/Vector.h
   pkg/Rcpp/inst/unitTests/runit.S4.R
Log:
Vector( SlotProxy ) and Vector(AttributeProxy)

Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-05-05 10:08:33 UTC (rev 1169)
+++ pkg/Rcpp/inst/ChangeLog	2010-05-05 10:29:07 UTC (rev 1170)
@@ -4,6 +4,10 @@
 	is of a given S4 class, following Doug's advice in lme4a
 	
 	* inst/include/RcppCommon.h: new STL-like algorithms Rcpp::any and Rcpp::any_if
+	
+	* inst/include/Rcpp/Vector.h: Vector gains a constructor taking a 
+	SlotProxy and a constructor taking an AttributeProxy, allowing this construct
+	NumericVector x( y.slot( "foo" ) )
 
 2010-05-04  Romain Francois <romain at r-enthusiasts.com>
 

Modified: pkg/Rcpp/inst/include/Rcpp/Vector.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Vector.h	2010-05-05 10:08:33 UTC (rev 1169)
+++ pkg/Rcpp/inst/include/Rcpp/Vector.h	2010-05-05 10:29:07 UTC (rev 1170)
@@ -491,6 +491,14 @@
 		return *this ;
 	}
 	
+	Vector( const RObject::SlotProxy& proxy ) throw(not_compatible) {
+		Base::setSEXP( r_cast<RTYPE>( proxy ) ) ;
+	}
+	
+	Vector( const RObject::AttributeProxy& proxy ) throw(not_compatible) {
+		Base::setSEXP( r_cast<RTYPE>( proxy ) ) ;
+	}
+	
 	template <typename T>
 	Vector& operator=( const T& x){
 		Base::setSEXP( r_cast<RTYPE>( wrap(x) ) ) ;

Modified: pkg/Rcpp/inst/unitTests/runit.S4.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.S4.R	2010-05-05 10:08:33 UTC (rev 1169)
+++ pkg/Rcpp/inst/unitTests/runit.S4.R	2010-05-05 10:29:07 UTC (rev 1170)
@@ -109,3 +109,27 @@
 	checkTrue( fx( tr2 ), msg = 'trackCurve is trackCurve' )
 	
 }
+
+test.Vector.SlotProxy.ambiguity <- function(){
+	setClass("track", representation(x="numeric", y="numeric"))
+	setClass("trackCurve", representation(smooth = "numeric"), contains = "track")
+	
+	tr1 <- new( "track", x = 2, y = 3 )
+	fx <- cppfunction( signature(tr="ANY"), 
+		' S4 o(tr); return NumericVector(o.slot("x")); '
+	)
+	checkEquals( fx(tr1), 2, "Vector( SlotProxy ) ambiguity" )
+	
+}
+
+test.Vector.AttributeProxy.ambiguity <- function(){
+	x <- 1:10
+	attr( x, "foo" ) <- "bar"
+	
+	fx <- cppfunction( signature(tr="ANY"), 
+		' S4 o(tr); return CharacterVector(o.slot("foo")); '
+	)
+	checkEquals( fx(tr1), "bar", "Vector( AttributeProxy ) ambiguity" )
+	
+}
+