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

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

Author: romain
Date: 2010-01-16 11:50:53 +0100 (Sat, 16 Jan 2010)
New Revision: 382

Modified:
   pkg/inst/ChangeLog
   pkg/inst/unitTests/runit.ExpressionVector.R
   pkg/src/ExpressionVector.cpp
   pkg/src/Rcpp/ExpressionVector.h
   pkg/src/RcppCommon.h
Log:
new constructor ExpressionVector( string ) that parses the string

Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog	2010-01-16 09:57:32 UTC (rev 381)
+++ pkg/inst/ChangeLog	2010-01-16 10:50:53 UTC (rev 382)
@@ -1,5 +1,11 @@
 2010-01-16  Romain Francois <francoisromain at free.fr>
 
+	* src/Rcpp/ExpressionVector.h: ExpressionVector gains a
+	constructor ExpressionVector( const std::string& ) that 
+	parses the string as R code
+	* inst/unitTests/runit.ExpressionVector.R: added unit tests
+	to cover the new constructor
+
 	* src/Rcpp/Environment.h : the Rcpp namespace is cached because
 	we use it in many places and retrieving it is an "expensive"
 	operation that requires a round trip to the R side

Modified: pkg/inst/unitTests/runit.ExpressionVector.R
===================================================================
--- pkg/inst/unitTests/runit.ExpressionVector.R	2010-01-16 09:57:32 UTC (rev 381)
+++ pkg/inst/unitTests/runit.ExpressionVector.R	2010-01-16 10:50:53 UTC (rev 382)
@@ -49,4 +49,21 @@
 	}
 }
 
+test.ExpressionVector.parse <- function( ){
+	funx <- cfunction(signature(), '
+	ExpressionVector code( "local( { y <- sample(1:10); sort(y) })" ) ;
+	return code ;', 
+	Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	code <- funx()
+	results <- eval( code )
+	checkEquals( results, 1:10, msg = "ExpressionVector parsing" )
+}
 
+test.ExpressionVector.parse.error <- function(){
+	funx <- cfunction(signature(), '
+	ExpressionVector code( "rnorm(" ) ;
+	return code ;', 
+	Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
+	checkException( funx(), msg = "parse error" )
+	
+}

Modified: pkg/src/ExpressionVector.cpp
===================================================================
--- pkg/src/ExpressionVector.cpp	2010-01-16 09:57:32 UTC (rev 381)
+++ pkg/src/ExpressionVector.cpp	2010-01-16 10:50:53 UTC (rev 382)
@@ -28,6 +28,10 @@
 
 namespace Rcpp{
 	
+	ExpressionVector::parse_error::parse_error() throw(){}
+	ExpressionVector::parse_error::~parse_error() throw(){}
+	const char* const ExpressionVector::parse_error::what() throw(){ return "parse error" ; }
+	
 	ExpressionVector::ExpressionVector(SEXP x) throw(not_compatible) : VectorBase() {
 		switch( TYPEOF( x ) ){
 			case EXPRSXP:
@@ -50,6 +54,21 @@
 		setSEXP( Rf_allocVector(EXPRSXP, size) ) ;
 	}
 
+	ExpressionVector::ExpressionVector(const std::string& code) throw(parse_error){
+		ParseStatus status;
+		SEXP expr = PROTECT( Rf_mkString( code.c_str() ) );
+		SEXP res  = PROTECT( R_ParseVector(expr, -1, &status, R_NilValue));
+		switch( status ){
+		case PARSE_OK:
+			setSEXP( res) ;
+			UNPROTECT( 2) ;
+			break;
+		default:
+			UNPROTECT(2) ;
+			throw parse_error() ;
+		}
+	}
+	
 #ifdef HAS_INIT_LISTS
 	ExpressionVector::ExpressionVector( std::initializer_list<RObject> list ) : VectorBase() {
 		SEXP x = PROTECT( Rf_allocVector( EXPRSXP, list.size() ) ) ;

Modified: pkg/src/Rcpp/ExpressionVector.h
===================================================================
--- pkg/src/Rcpp/ExpressionVector.h	2010-01-16 09:57:32 UTC (rev 381)
+++ pkg/src/Rcpp/ExpressionVector.h	2010-01-16 10:50:53 UTC (rev 382)
@@ -36,6 +36,13 @@
 class ExpressionVector : public VectorBase {     
 public:
 
+	class parse_error : public std::exception{
+	public:
+		parse_error() throw();
+		~parse_error() throw();
+		const char* const what() throw() ;
+	} ;
+	
 	/* much inspired from item 30 of more effective C++ */
 	class Proxy {
 	public:
@@ -60,7 +67,8 @@
 	} ;
 
 	ExpressionVector(SEXP x) throw(not_compatible);
-	ExpressionVector( int size) ;
+	ExpressionVector(int size) ;
+	ExpressionVector(const std::string& code) throw(parse_error) ;
 	
 #ifdef HAS_INIT_LISTS	
 	ExpressionVector( std::initializer_list<RObject> list ) ;

Modified: pkg/src/RcppCommon.h
===================================================================
--- pkg/src/RcppCommon.h	2010-01-16 09:57:32 UTC (rev 381)
+++ pkg/src/RcppCommon.h	2010-01-16 10:50:53 UTC (rev 382)
@@ -49,6 +49,7 @@
 #include <Rinternals.h>
 #include <R_ext/Callbacks.h>
 #include <R_ext/Complex.h>
+#include <R_ext/Parse.h>
 #include <Rversion.h>
 #define RCPP_GET_NAMES(x)	Rf_getAttrib(x, R_NamesSymbol)