[Rcpp-devel] [Rcpp-commits] r331 - in pkg: inst inst/unitTests src src/Rcpp

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

Author: romain
Date: 2010-01-09 23:31:01 +0100 (Sat, 09 Jan 2010)
New Revision: 331

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.RObject.R
   pkg/src/RObject.cpp
   pkg/src/Rcpp/RObject.h
Log:
attr can now read and write the attribute (proxy pattern again)

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-09 21:58:56 UTC (rev 330)
+++ pkg/inst/ChangeLog	2010-01-09 22:31:01 UTC (rev 331)
@@ -1,5 +1,12 @@
 2010-01-09  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp/RObject.h: attr can now be used to get or set the 
+	attribute (used to be read only). This is another manifestation
+	of the proxy pattern. The rhs can be anything wrap can handle
+
+	* inst/unitTests/runit.RObject.R: added test.RObject.attr.set
+	unit test (setting attribute).
+
 	* src/Rcpp/Function.h: Function::operator() now throws an 
 	exception if an R error occurs.
 

Modified: pkg/inst/unitTests/runit.RObject.R
===================================================================
--- pkg/inst/unitTests/runit.RObject.R	2010-01-09 21:58:56 UTC (rev 330)
+++ pkg/inst/unitTests/runit.RObject.R	2010-01-09 22:31:01 UTC (rev 331)
@@ -275,6 +275,14 @@
 	checkEquals( funx( iris ), 1:150, msg = "RObject.attr" )
 }
 
+test.RObject.attr.set <- function(){
+	funx <- cfunction(signature(), '
+	RObject y = wrap("blabla") ;
+	y.attr("foo") = 10 ;
+	return y ; ', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;")
+	checkEquals( attr(funx(), "foo"), 10L, msg = "RObject.attr() = " )
+}
+
 test.RObject.isNULL <- function(){
 	funx <- cfunction(signature(x="ANY"), '
 		bool is_null = Rcpp::wrap(x).isNULL() ;

Modified: pkg/src/RObject.cpp
===================================================================
--- pkg/src/RObject.cpp	2010-01-09 21:58:56 UTC (rev 330)
+++ pkg/src/RObject.cpp	2010-01-09 22:31:01 UTC (rev 331)
@@ -99,10 +99,27 @@
     return false; /* give up */
 }
 
-RObject RObject::attr( const std::string& name) const{
-	return wrap( Rf_getAttrib( m_sexp, Rf_install( name.c_str() ) ) );
+
+RObject::AttributeProxy::AttributeProxy( const RObject& v, const std::string& name) :
+	parent(v), attr_name(name) {};
+
+RObject::AttributeProxy& RObject::AttributeProxy::operator=(const AttributeProxy& rhs){
+	Rf_setAttrib( parent, Rf_install(attr_name.c_str()), parent.asSexp() ) ;
+	return *this ;
 }
 
+RObject::AttributeProxy::operator SEXP() const {
+	return Rf_getAttrib( parent , Rf_install( attr_name.c_str() ) ) ;
+}
+
+RObject::AttributeProxy::operator RObject() const {
+	return wrap( Rf_getAttrib( parent, Rf_install( attr_name.c_str() ) ) ) ;
+}
+
+RObject::AttributeProxy RObject::attr( const std::string& name) const{
+	return AttributeProxy( *this, name)  ;
+}
+
 /* S4 */
 
 bool RObject::hasSlot(const std::string& name) const throw(not_s4){

Modified: pkg/src/Rcpp/RObject.h
===================================================================
--- pkg/src/Rcpp/RObject.h	2010-01-09 21:58:56 UTC (rev 330)
+++ pkg/src/Rcpp/RObject.h	2010-01-09 22:31:01 UTC (rev 331)
@@ -59,7 +59,7 @@
    		const char* what() const throw() ;
    	} ;
    	
-   /**
+    /**
      * default constructor. uses R_NilValue
      */ 
     RObject() : m_sexp(R_NilValue) {} ;	
@@ -94,7 +94,7 @@
     virtual ~RObject() ;
 
     /**
-     * implicit conversion to SEXP
+     * implicit conversion to SEXP.
      */
     inline operator SEXP() const { return m_sexp ; }
 
@@ -126,12 +126,34 @@
      */
     bool hasAttribute( const std::string& attr) const ; 
 
+    class AttributeProxy {
+	public:
+		AttributeProxy( const RObject& v, const std::string& attr_name) ;
+		
+		/* lvalue uses */
+		AttributeProxy& operator=(const AttributeProxy& rhs) ;
+		
+		template <typename T>
+		AttributeProxy& operator=(const T& rhs){
+			Rf_setAttrib( parent, Rf_install(attr_name.c_str()), wrap(rhs) ) ;
+			return *this ;
+		}
+		
+		/* rvalue use */
+		operator SEXP() const ;
+		operator RObject() const ;
+		
+	private:
+		const RObject& parent; 
+		std::string attr_name ;
+	} ;
+    
     /**
      * extract the given attribute
      */
     /* TODO: implement a proxy pattern for attributes */
-    RObject attr( const std::string& name) const  ;
-
+    AttributeProxy attr( const std::string& name) const  ;
+    
     /**
      * is this object NULL
      */

_______________________________________________
Rcpp-commits mailing list
Rcpp-commits at lists.r-forge.r-project.org
https://lists.r-forge.r-project.org/cgi-bin/mailman/listinfo/rcpp-commits