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

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

Author: romain
Date: 2010-01-04 19:28:49 +0100 (Mon, 04 Jan 2010)
New Revision: 268

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.environments.R
   pkg/src/Environment.cpp
   pkg/src/Rcpp/Environment.h
   pkg/src/Rcpp/wrap.h
Log:
no more wrap template and Environment gains remove

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-04 15:27:06 UTC (rev 267)
+++ pkg/inst/ChangeLog	2010-01-04 18:28:49 UTC (rev 268)
@@ -1,5 +1,15 @@
 2010-01-04  Dirk Eddelbuettel  <edd at debian.org>
 
+	* src/Rcpp/wrap.h: wrap no more a template. this was not a good
+	idea as it prevented implicit conversion to SEXP behavior when 
+	wrap'ing a RObject.
+
+	* src/Rcpp/Environment.h: added the remove method
+	
+	* src/unitTests/runit.environments.R: remove unit test
+
+2010-01-04  Dirk Eddelbuettel  <edd at debian.org>
+
 	* src/excections.cpp: Get rid of another unused variable
 	* src/RcppCommon.cpp: Idem
 

Modified: pkg/inst/unitTests/runit.environments.R
===================================================================
--- pkg/inst/unitTests/runit.environments.R	2010-01-04 15:27:06 UTC (rev 267)
+++ pkg/inst/unitTests/runit.environments.R	2010-01-04 18:28:49 UTC (rev 268)
@@ -275,3 +275,31 @@
 	}
 }
 
+test.environment.remove <- function(){
+	funx <- cfunction(signature( env = "environment", name = "character" ), '
+	return wrap( Environment(env).remove( as<std::string>(name) ) ) ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	
+	e <- new.env( )
+	e$a <- 1
+	e$b <- 2
+	checkTrue( funx( e, "a" ), msg = "Environment::remove" )
+	checkEquals( ls(envir=e), "b", msg = "check that the element was removed" )
+	checkException( funx(e, "xx"), msg = "Environment::remove no such binding" )
+	lockBinding( "b", e )
+	checkException( funx(e, "b"), msg = "Environment::remove binding is locked" )
+	checkEquals( ls(envir=e), "b", msg = "check that the element was not removed" )
+	
+}
+
+test.environment.parent <- function(){
+	funx <- cfunction(signature( env = "environment" ), '
+	return Environment(env).parent() ;
+	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	
+	e <- new.env( parent = emptyenv() )
+	f <- new.env( parent = e )
+	checkEquals( funx(f), e, msg = "Environment::parent" )
+	checkEquals( funx(e), emptyenv() , msg = "Environment::parent" )
+	
+}

Modified: pkg/src/Environment.cpp
===================================================================
--- pkg/src/Environment.cpp	2010-01-04 15:27:06 UTC (rev 267)
+++ pkg/src/Environment.cpp	2010-01-04 18:28:49 UTC (rev 268)
@@ -22,6 +22,7 @@
 #include <Rcpp/Environment.h>
 #include <Rcpp/Evaluator.h>
 #include <Rcpp/Symbol.h>
+#include <Rcpp/Language.h>
 
 namespace Rcpp {
 
@@ -145,6 +146,23 @@
     	return static_cast<bool>( R_ToplevelExec(safeAssign, (void*) &s) );
     }
     
+    bool Environment::remove( const std::string& name) throw(binding_is_locked){
+    	    if( exists(name) ){
+    	    	    if( bindingIsLocked(name) ){
+    	    	    	    throw binding_is_locked(name) ;
+    	    	    } else{
+    	    	    	    /* unless we want to copy all of do_remove, 
+    	    	    	       we have to go back to R to do this operation */
+    	    	    	    Language call( ".Internal", 
+    	    	    	    	    Language( "remove", name, m_sexp, false ) 
+    	    	    	    	    ) ;
+    	    	    	    Rf_eval( call, R_GlobalEnv ) ;
+    	    	    }
+    	    } else{
+    	    	throw no_such_binding(name) ;
+    	    }
+    }
+    
     bool Environment::isLocked() const{
     	return R_EnvironmentIsLocked(m_sexp);
     }

Modified: pkg/src/Rcpp/Environment.h
===================================================================
--- pkg/src/Rcpp/Environment.h	2010-01-04 15:27:06 UTC (rev 267)
+++ pkg/src/Rcpp/Environment.h	2010-01-04 18:28:49 UTC (rev 268)
@@ -223,6 +223,11 @@
     bool isLocked() const ;
     
     /**
+     * remove an object from this environment
+     */
+    bool remove( const std::string& name ) throw(binding_is_locked) ;
+    
+    /**
      * locks this environment. See ?lockEnvironment
      *
      * @param bindings also lock the bindings of this environment ?

Modified: pkg/src/Rcpp/wrap.h
===================================================================
--- pkg/src/Rcpp/wrap.h	2010-01-04 15:27:06 UTC (rev 267)
+++ pkg/src/Rcpp/wrap.h	2010-01-04 18:28:49 UTC (rev 268)
@@ -29,11 +29,6 @@
 namespace Rcpp{ 
 
 // factories
-template <typename T>
-RObject wrap(const T& v ){
-	Rf_warning( "not implemented" ) ;
-	return RObject(R_NilValue) ;
-}
 
 RObject wrap(SEXP m_sexp) ;
 

_______________________________________________
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