[Rcpp-commits] r4099 - in pkg/Rcpp: . inst/include inst/include/Rcpp inst/include/Rcpp/api/meat inst/unitTests inst/unitTests/cpp src
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Thu Dec 6 10:49:18 CET 2012
Author: romain
Date: 2012-12-06 10:49:18 +0100 (Thu, 06 Dec 2012)
New Revision: 4099
Added:
pkg/Rcpp/inst/include/Rcpp/api/meat/Environment.h
pkg/Rcpp/inst/unitTests/cpp/Environment.cpp
Modified:
pkg/Rcpp/ChangeLog
pkg/Rcpp/inst/include/Rcpp.h
pkg/Rcpp/inst/include/Rcpp/Environment.h
pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h
pkg/Rcpp/inst/unitTests/runit.DataFrame.R
pkg/Rcpp/inst/unitTests/runit.environments.R
pkg/Rcpp/src/exceptions.cpp
Log:
use sourceCpp for environment unit tests
Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog 2012-12-06 02:01:50 UTC (rev 4098)
+++ pkg/Rcpp/ChangeLog 2012-12-06 09:49:18 UTC (rev 4099)
@@ -1,3 +1,10 @@
+2012-12-06 Romain Francois <romain at r-enthusiasts.com>
+
+ * include/Rcpp/api/meat/Environment.h: meat for Environment
+ * src/exceptions.cpp: include config so that it knows that Rcpp can
+ demangle
+ * unitTests/runit.environments.R: using sourceCpp
+
2012-12-05 Romain Francois <romain at r-enthusiasts.com>
* src/cache.cpp: added get_cache
Modified: pkg/Rcpp/inst/include/Rcpp/Environment.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Environment.h 2012-12-06 02:01:50 UTC (rev 4098)
+++ pkg/Rcpp/inst/include/Rcpp/Environment.h 2012-12-06 09:49:18 UTC (rev 4099)
@@ -118,11 +118,7 @@
* with GCC4.4 :
* e["bla" ] = { 1,2,3};
*/
- template <typename WRAPPABLE>
- Binding& operator=(const WRAPPABLE& rhs){
- env.assign( name, rhs ) ;
- return *this ;
- }
+ template <typename WRAPPABLE> Binding& operator=(const WRAPPABLE& rhs) ;
/* rvalue */
/**
@@ -132,11 +128,7 @@
* which can either mean that a specialization exists
* or that T has a T(SEXP) constructor
*/
- template <typename T>
- operator T() const{
- SEXP x = env.get(name) ;
- return as<T>(x) ;
- }
+ template <typename T> operator T() const ;
private:
@@ -266,9 +258,7 @@
* @param x wrappable object. anything that has a wrap( WRAPPABLE ) is fine
*/
template <typename WRAPPABLE>
- bool assign( const std::string& name, const WRAPPABLE& x) const {
- return assign( name, wrap( x ) ) ;
- }
+ bool assign( const std::string& name, const WRAPPABLE& x) const ;
/**
* @return true if this environment is locked
Added: pkg/Rcpp/inst/include/Rcpp/api/meat/Environment.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/api/meat/Environment.h (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/api/meat/Environment.h 2012-12-06 09:49:18 UTC (rev 4099)
@@ -0,0 +1,46 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// Environment.h: Rcpp R/C++ interface class library --
+//
+// Copyright (C) 2012 Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+
+#ifndef Rcpp_api_meat_Environment_h
+#define Rcpp_api_meat_Environment_h
+
+namespace Rcpp{
+
+template <typename WRAPPABLE>
+bool Environment::assign( const std::string& name, const WRAPPABLE& x) const {
+ return assign( name, wrap( x ) ) ;
+}
+
+template <typename T>
+Environment::Binding::operator T() const{
+ SEXP x = env.get(name) ;
+ return as<T>(x) ;
+}
+
+template <typename WRAPPABLE>
+Environment::Binding& Environment::Binding::operator=(const WRAPPABLE& rhs){
+ env.assign( name, rhs ) ;
+ return *this ;
+}
+
+} // namespace Rcpp
+
+#endif
Modified: pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h 2012-12-06 02:01:50 UTC (rev 4098)
+++ pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h 2012-12-06 09:49:18 UTC (rev 4099)
@@ -23,6 +23,7 @@
#define Rcpp_api_meat_meat_h
#include <Rcpp/api/meat/RObject.h>
+#include <Rcpp/api/meat/Environment.h>
#include <Rcpp/api/meat/DottedPair.h>
#endif
Modified: pkg/Rcpp/inst/include/Rcpp.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp.h 2012-12-06 02:01:50 UTC (rev 4098)
+++ pkg/Rcpp/inst/include/Rcpp.h 2012-12-06 09:49:18 UTC (rev 4099)
@@ -65,8 +65,10 @@
#include <Rmath.h>
#include <Rcpp/sugar/undoRmath.h>
+#ifndef RCPP_NO_SUGAR
#include <Rcpp/sugar/sugar.h>
#include <Rcpp/stats/stats.h>
+#endif
// wrappers for R API 'scalar' functions
#include <Rcpp/Rmath.h>
Added: pkg/Rcpp/inst/unitTests/cpp/Environment.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/Environment.cpp (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/Environment.cpp 2012-12-06 09:49:18 UTC (rev 4099)
@@ -0,0 +1,153 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Environment.cpp: Rcpp R/C++ interface class library -- Environment unit tests
+//
+// Copyright (C) 2012 Dirk Eddelbuettel and Romain Francois
+//
+// This file is part of Rcpp.
+//
+// Rcpp is free software: you can redistribute it and/or modify it
+// under the terms of the GNU General Public License as published by
+// the Free Software Foundation, either version 2 of the License, or
+// (at your option) any later version.
+//
+// Rcpp is distributed in the hope that it will be useful, but
+// WITHOUT ANY WARRANTY; without even the implied warranty of
+// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+// GNU General Public License for more details.
+//
+// You should have received a copy of the GNU General Public License
+// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
+
+#include <Rcpp.h>
+using namespace Rcpp ;
+
+// [[Rcpp::export]]
+SEXP runit_ls( Environment env ){
+ return env.ls(true) ;
+}
+
+// [[Rcpp::export]]
+SEXP runit_ls2( Rcpp::Environment env){
+ return env.ls(false) ;
+}
+
+// [[Rcpp::export]]
+SEXP runit_get( Environment env, std::string name){
+ return env.get( name ) ;
+}
+
+// [[Rcpp::export]]
+bool runit_exists( Environment env, std::string st){
+ return env.exists( st ) ;
+}
+
+// [[Rcpp::export]]
+bool runit_assign( Environment env, std::string st, SEXP object ){
+ return env.assign(st, object) ;
+}
+
+// [[Rcpp::export]]
+void runit_islocked( Environment env ){
+ env.assign( "x1", 1 ) ;
+ env.assign( "x2", 10.0 ) ;
+ env.assign( "x3", std::string( "foobar" ) ) ;
+ env.assign( "x4", "foobar" ) ;
+ std::vector< std::string > aa(2) ; aa[0] = "foo" ; aa[1] = "bar" ;
+ env.assign( "x5", aa ) ;
+}
+
+// [[Rcpp::export]]
+bool runit_bindingIsActive( Environment env, std::string st ){
+ return env.bindingIsActive(st) ;
+}
+
+// [[Rcpp::export]]
+bool runit_bindingIsLocked( Environment env, std::string st ){
+ return env.bindingIsLocked(st) ;
+}
+
+// [[Rcpp::export]]
+void runit_notanenv( SEXP x){
+ Environment env(x) ;
+}
+
+// [[Rcpp::export]]
+void runit_lockbinding( Environment env, std::string st){
+ env.lockBinding( st ) ;
+}
+
+// [[Rcpp::export]]
+void runit_unlockbinding( Environment env, std::string st){
+ env.unlockBinding( st ) ;
+}
+
+// [[Rcpp::export]]
+Environment runit_globenv(){
+ return Rcpp::Environment::global_env();
+}
+
+// [[Rcpp::export]]
+Environment runit_emptyenv(){
+ return Rcpp::Environment::empty_env();
+}
+
+// [[Rcpp::export]]
+Environment runit_baseenv(){
+ return Rcpp::Environment::base_env();
+}
+
+// [[Rcpp::export]]
+Environment runit_namespace( std::string st){
+ return Environment::namespace_env(st);
+}
+
+// [[Rcpp::export]]
+Environment runit_env_SEXP(SEXP env){
+ return Environment( env ) ;
+}
+
+// [[Rcpp::export]]
+Environment runit_env_string( std::string st ){
+ return Environment( st ) ;
+}
+
+// [[Rcpp::export]]
+Environment runit_env_int( int pos ){
+ return Environment( pos ) ;
+}
+
+// [[Rcpp::export]]
+Environment runit_parent( Environment env ){
+ return env.parent() ;
+}
+
+// [[Rcpp::export]]
+bool runit_remove(Environment env, std::string name ){
+ bool res = env.remove( name ) ;
+ return wrap( res ) ;
+}
+
+// [[Rcpp::export]]
+List runit_square( Environment e ){
+ List out(3) ;
+ out[0] = e["x"] ;
+ e["y"] = 2 ;
+ out[1] = e["y"] ;
+ e["x"] = "foo";
+ out[2] = e["x"] ;
+ return out ;
+}
+
+// [[Rcpp::export]]
+Environment runit_Rcpp(){
+ return Environment::Rcpp_namespace() ;
+}
+
+// [[Rcpp::export]]
+Environment runit_child(){
+ Environment global_env = Environment::global_env() ;
+ return global_env.new_child(false) ;
+}
+
+
Modified: pkg/Rcpp/inst/unitTests/runit.DataFrame.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.DataFrame.R 2012-12-06 02:01:50 UTC (rev 4098)
+++ pkg/Rcpp/inst/unitTests/runit.DataFrame.R 2012-12-06 09:49:18 UTC (rev 4099)
@@ -25,7 +25,6 @@
.setUp <- function(){
suppressMessages( require( datasets ) )
data( iris )
- #sourceCpp( system.file( "unitTests/cpp/DataFrame.cpp" , package = "Rcpp" ) )
sourceCpp(file.path(pathRcppTests, "cpp/DataFrame.cpp"))
}
Modified: pkg/Rcpp/inst/unitTests/runit.environments.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.environments.R 2012-12-06 02:01:50 UTC (rev 4098)
+++ pkg/Rcpp/inst/unitTests/runit.environments.R 2012-12-06 09:49:18 UTC (rev 4099)
@@ -22,181 +22,12 @@
if (.runThisTest) {
-definitions <- function(){
- list(
- "runit_ls" = list(
- signature(x="environment"),
- '
- Rcpp::Environment env(x) ;
- return env.ls(true) ;
- ' ),
- "runit_ls2" = list(
- signature(x="environment"),
- '
- Rcpp::Environment env(x) ;
- return env.ls(false) ;
- '
- ),
- "runit_get" = list(
- signature(x="environment", name = "character" ),
- '
- Environment env(x) ;
- return env.get( as<std::string>(name) ) ;
- '
- ),
- "runit_exists" = list(
- signature(x="environment", name = "character" ),
- '
- Environment env(x) ;
- std::string st = as< std::string >(name) ;
- return wrap( env.exists( st ) ) ;
- '
- ),
- "runit_assign" =list(
- signature(x="environment", name = "character", object = "ANY" ),
- '
- Environment env(x) ;
- std::string st = as< std::string>(name) ;
- return wrap( env.assign(st, object) ) ;
- '
- ),
- "runit_islocked" = list(
- signature(x="environment" ),
- '
- Environment env(x) ;
- env.assign( "x1", 1 ) ;
- env.assign( "x2", 10.0 ) ;
- env.assign( "x3", std::string( "foobar" ) ) ;
- env.assign( "x4", "foobar" ) ;
- std::vector< std::string > aa(2) ; aa[0] = "foo" ; aa[1] = "bar" ;
- env.assign( "x5", aa ) ;
- return R_NilValue ;
- '
- ),
- "runit_bindingIsActive" = list(
- signature(x="environment", name = "character" ),
- '
- Environment env(x) ;
- std::string st = as<std::string>(name);
- return wrap( env.bindingIsActive(st) ) ;
- '
- ),
- "runit_bindingIsLocked" = list(
- signature(x="environment", name = "character" ),
- '
- Environment env(x) ;
- std::string st = as<std::string>(name) ;
- return wrap( env.bindingIsLocked(st) ) ;
- '
- ),
- "runit_notanenv" = list(
- signature(x="ANY"),
- 'Rcpp::Environment env(x) ;'
- ),
- "runit_lockbinding" = list(
- signature(x="environment", name = "character" ),
- '
- Environment env(x) ;
- std::string st = as<std::string>(name) ;
- env.lockBinding( st ) ;
- return R_NilValue ;
- '
- ),
- "runit_unlockbinding" = list(
- signature(x="environment", name = "character" ),
- '
- Environment env(x) ;
- std::string st = as<std::string>(name) ;
- env.unlockBinding( st ) ;
- return R_NilValue ;
- '
- ),
- "runit_globenv" = list(
- signature(),
- 'return Rcpp::Environment::global_env(); '
- ),
- "runit_emptyenv" = list(
- signature(),
- 'return Rcpp::Environment::empty_env(); '
- ),
- "runit_baseenv" = list(
- signature(),
- 'return Rcpp::Environment::base_env(); '
- ),
- "runit_namespace" = list(
- signature(env = "character" ),
- '
- std::string st = as<std::string>(env) ;
- return Environment::namespace_env(st);
- '
- ),
- "runit_env_SEXP" = list(
- signature( env = "ANY" ),
- 'return Environment( env ) ;'
- ),
- "runit_env_string" = list(
- signature( env = "character" ),
- '
- std::string st = as<std::string>( env ) ;
- return Environment( st ) ;
- '
- ),
- "runit_env_int" = list(
- signature( env = "integer" ),
- '
- int pos = as<int>(env) ;
- return Environment( pos ) ;
- '
- ),
- "runit_parent" = list(
- signature( env = "environment" ),
- '
- return Environment(env).parent() ;
- '
- ),
- "runit_remove" = list(
- signature( env = "environment", name = "character" ),
- '
- bool res = Environment(env).remove( as<std::string>(name) ) ;
- return wrap( res ) ;
- '
- ),
- "runit_square" = list(
- signature( env = "environment" ),
- '
- Environment e(env) ;
- List out(3) ;
- out[0] = e["x"] ;
- e["y"] = 2 ;
- out[1] = e["y"] ;
- e["x"] = "foo";
- out[2] = e["x"] ;
- return out ;
- '
- ),
- "runit_Rcpp" = list(
- signature(),
- 'return Environment::Rcpp_namespace() ; '
- ),
- "runit_child" = list(
- signature(),
- '
- Environment global_env = Environment::global_env() ;
- return global_env.new_child(false) ;
- '
- )
- )
-}
-
.setUp <- function(){
- if( ! exists( ".rcpp.environments", globalenv() ) ){
- fun <- Rcpp:::compile_unit_tests( definitions() )
- assign( ".rcpp.environments", fun, globalenv() )
- }
+ sourceCpp(file.path(pathRcppTests, "cpp/Environment.cpp"))
}
test.environment.ls <- function(){
- funx <- .rcpp.environments$runit_ls
+ funx <- runit_ls
e <- new.env( )
e$a <- 1:10
e$b <- "foo"
@@ -205,7 +36,7 @@
checkEquals( funx(asNamespace("Rcpp")), ls(envir=asNamespace("Rcpp"), all = TRUE),
msg = "Environment(namespace)::ls()" )
- funx <- .rcpp.environments$runit_ls2
+ funx <- runit_ls2
checkEquals( funx(e), c("a","b"), msg = "Environment::ls(false)" )
checkEquals( funx(asNamespace("Rcpp")), ls(envir=asNamespace("Rcpp"), all = FALSE),
msg = "Environment(namespace)::ls()" )
@@ -213,7 +44,7 @@
}
test.environment.get <- function(){
- funx <- .rcpp.environments$runit_get
+ funx <- runit_get
e <- new.env( )
e$a <- 1:10
@@ -227,7 +58,7 @@
}
test.environment.exists <- function(){
- funx <- .rcpp.environments$runit_exists
+ funx <- runit_exists
e <- new.env( )
e$a <- 1:10
e$b <- "foo"
@@ -239,7 +70,7 @@
}
test.environment.assign <- function(){
- funx <- .rcpp.environments$runit_assign
+ funx <- runit_assign
e <- new.env( )
checkTrue( funx(e, "a", 1:10 ), msg = "Environment::assign" )
checkTrue( funx(e, "b", Rcpp:::CxxFlags ), msg = "Environment::assign" )
@@ -261,7 +92,7 @@
}
test.environment.isLocked <- function(){
- funx <- .rcpp.environments$runit_islocked
+ funx <- runit_islocked
e <- new.env()
funx(e)
checkEquals( e[["x1"]], 1L , msg = "Environment::assign( int ) " )
@@ -272,7 +103,7 @@
}
test.environment.bindingIsActive <- function(){
- funx <- .rcpp.environments$runit_bindingIsActive
+ funx <- runit_bindingIsActive
e <- new.env()
e$a <- 1:10
makeActiveBinding( "b", function(x) 10, e )
@@ -293,7 +124,7 @@
}
test.environment.bindingIsLocked <- function(){
- funx <- .rcpp.environments$runit_bindingIsLocked
+ funx <- runit_bindingIsLocked
e <- new.env()
e$a <- 1:10
e$b <- letters
@@ -315,7 +146,7 @@
}
test.environment.NotAnEnvironment <- function(){
- funx <- .rcpp.environments$runit_notanenv
+ funx <- runit_notanenv
checkException( funx( funx ), msg = "not an environment" )
checkException( funx( letters ), msg = "not an environment" )
checkException( funx( NULL ), msg = "not an environment" )
@@ -323,7 +154,7 @@
test.environment.lockBinding <- function(){
- funx <- .rcpp.environments$runit_lockbinding
+ funx <- runit_lockbinding
e <- new.env()
e$a <- 1:10
e$b <- letters
@@ -343,7 +174,7 @@
}
test.environment.unlockBinding <- function(){
- funx <- .rcpp.environments$runit_unlockbinding
+ funx <- runit_unlockbinding
e <- new.env()
e$a <- 1:10
e$b <- letters
@@ -364,27 +195,27 @@
}
test.environment.global.env <- function(){
- funx <- .rcpp.environments$runit_globenv
+ funx <- runit_globenv
checkEquals( funx(), globalenv(), msg = "REnvironment::global_env" )
}
test.environment.empty.env <- function(){
- funx <- .rcpp.environments$runit_emptyenv
+ funx <- runit_emptyenv
checkEquals( funx(), emptyenv(), msg = "REnvironment::empty_env" )
}
test.environment.base.env <- function(){
- funx <- .rcpp.environments$runit_baseenv
+ funx <- runit_baseenv
checkEquals( funx(), baseenv(), msg = "REnvironment::base_env" )
}
test.environment.empty.env <- function(){
- funx <- .rcpp.environments$runit_emptyenv
+ funx <- runit_emptyenv
checkEquals( funx(), .BaseNamespaceEnv, msg = "REnvironment::base_namespace" )
}
test.environment.namespace.env <- function(){
- funx <- .rcpp.environments$runit_namespace
+ funx <- runit_namespace
checkEquals( funx("Rcpp"), asNamespace("Rcpp"), msg = "REnvironment::base_namespace" )
can.demangle <- Rcpp:::capabilities()[["demangling"]]
@@ -400,7 +231,7 @@
}
test.environment.constructor.SEXP <- function(){
- funx <- .rcpp.environments$runit_env_SEXP
+ funx <- runit_env_SEXP
checkEquals( funx( globalenv() ), globalenv(), msg = "Environment( environment ) - 1" )
checkEquals( funx( baseenv() ), baseenv(), msg = "Environment( environment ) - 2" )
checkEquals( funx( asNamespace("Rcpp") ), asNamespace("Rcpp"), msg = "Environment( environment ) - 3" )
@@ -413,7 +244,7 @@
}
test.environment.constructor.stdstring <- function(){
- funx <- .rcpp.environments$runit_env_string
+ funx <- runit_env_string
checkEquals( funx( ".GlobalEnv" ), globalenv(), msg = "Environment( std::string ) - 1" )
checkEquals( funx( "package:base" ), baseenv(), msg = "Environment( std::string ) - 2" )
checkEquals( funx( "package:Rcpp" ), as.environment("package:Rcpp") ,
@@ -422,14 +253,14 @@
}
test.environment.constructor.int <- function(){
- funx <- .rcpp.environments$runit_env_int
+ funx <- runit_env_int
for( i in 1:length(search())){
checkEquals( funx(i), as.environment(i), msg = sprintf("Environment(int) - %d", i) )
}
}
test.environment.remove <- function(){
- funx <- .rcpp.environments$runit_remove
+ funx <- runit_remove
e <- new.env( )
e$a <- 1
e$b <- 2
@@ -443,7 +274,7 @@
}
test.environment.parent <- function(){
- funx <- .rcpp.environments$runit_parent
+ funx <- runit_parent
e <- new.env( parent = emptyenv() )
f <- new.env( parent = e )
@@ -453,7 +284,7 @@
}
test.environment.square <- function(){
- funx <- .rcpp.environments$runit_square
+ funx <- runit_square
env <- new.env( )
env[["x"]] <- 10L
checkEquals( funx(env), list( 10L, 2L, "foo") )
@@ -461,12 +292,12 @@
}
test.environment.Rcpp <- function(){
- funx <- .rcpp.environments$runit_Rcpp
+ funx <- runit_Rcpp
checkEquals( funx(), asNamespace("Rcpp") , msg = "cached Rcpp namespace" )
}
test.environment.child <- function(){
- funx <- .rcpp.environments$runit_child
+ funx <- runit_child
checkEquals( parent.env(funx()), globalenv(),
msg = "" )
}
Modified: pkg/Rcpp/src/exceptions.cpp
===================================================================
--- pkg/Rcpp/src/exceptions.cpp 2012-12-06 02:01:50 UTC (rev 4098)
+++ pkg/Rcpp/src/exceptions.cpp 2012-12-06 09:49:18 UTC (rev 4099)
@@ -19,7 +19,7 @@
// You should have received a copy of the GNU General Public License
// along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
-// #include <Rcpp.h>
+#include <Rcpp/config.h>
#define R_NO_REMAP
#include <Rinternals.h>
#include <Rcpp/exceptions.h>
More information about the Rcpp-commits
mailing list