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

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

Author: romain
Date: 2010-01-16 12:26:48 +0100 (Sat, 16 Jan 2010)
New Revision: 384

Modified:
   pkg/inst/unitTests/runit.ExpressionVector.R
   pkg/src/ExpressionVector.cpp
Log:
correct code for ExpressionVector::eval( env ) and extra unit test

Modified: pkg/inst/unitTests/runit.ExpressionVector.R
===================================================================
--- pkg/inst/unitTests/runit.ExpressionVector.R	2010-01-16 11:14:38 UTC (rev 383)
+++ pkg/inst/unitTests/runit.ExpressionVector.R	2010-01-16 11:26:48 UTC (rev 384)
@@ -75,3 +75,17 @@
 	checkEquals( funx(), 1:10, msg = "ExpressionVector::eval" )
 }
 
+test.ExpressionVector.eval.env <- function(){
+	funx <- cfunction(signature(env = "environment"), '
+	ExpressionVector code( "sort(x)" ) ;
+	return code.eval(env) ;', 
+	Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	
+	e <- new.env()
+	e[["x"]] <- sample(1:10)
+	checkEquals( funx(e), 1:10, msg = "ExpressionVector::eval" )
+}
+
+
+
+

Modified: pkg/src/ExpressionVector.cpp
===================================================================
--- pkg/src/ExpressionVector.cpp	2010-01-16 11:14:38 UTC (rev 383)
+++ pkg/src/ExpressionVector.cpp	2010-01-16 11:26:48 UTC (rev 384)
@@ -109,12 +109,11 @@
 }
 
 SEXP ExpressionVector::eval() throw(Evaluator::eval_error){
-	return eval( R_GlobalEnv ) ;
-	
+	return Evaluator::run( Rf_lcons( Rf_install( "eval" ) , Rf_cons( m_sexp, R_NilValue) )) ;
 }
 
 SEXP ExpressionVector::eval(const Environment& env) throw(Evaluator::eval_error){
-	return Evaluator::run( Rf_lcons( Rf_install( "eval" ) , Rf_cons( m_sexp, R_NilValue) ) , R_GlobalEnv ) ;
+	return Evaluator::run( Rf_lcons( Rf_install( "eval" ) , Rf_cons( m_sexp, Rf_cons(env.asSexp(), R_NilValue)) ) ) ;
 }
 
 } // namespace