[Rcpp-devel] [Rcpp-commits] r236 - in pkg: . inst inst/unitTests src src/Rcpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Wed Dec 30 15:40:36 CET 2009
Author: romain
Date: 2009-12-30 15:40:36 +0100 (Wed, 30 Dec 2009)
New Revision: 236
Added:
pkg/inst/unitTests/runit.environments.R
pkg/src/Environment.cpp
pkg/src/Rcpp/Environment.h
Modified:
pkg/cleanup
pkg/inst/ChangeLog
pkg/src/Rcpp.h
pkg/src/RcppCommon.h
Log:
support for environments
Modified: pkg/cleanup
===================================================================
--- pkg/cleanup 2009-12-30 13:48:14 UTC (rev 235)
+++ pkg/cleanup 2009-12-30 14:40:36 UTC (rev 236)
@@ -2,6 +2,7 @@
rm -f confdefs.h config.log config.status \
src/*.o src/*.so src/*.a src/*.d src/*.dll src/*.rc \
RcppSrc/*.o RcppSrc/*.a inst/Rcpp-version.txt \
+ inst/lib/Rcpp/* \
inst/lib/libRcpp.so inst/lib/Rcpp*.h inst/lib/libRcpp.a \
inst/doc/*.cpp inst/doc/*.hpp \
inst/doc/*.Rd inst/doc/*.aux inst/doc/*.log inst/doc/*.tex \
@@ -9,6 +10,7 @@
inst/doc/auto \
src/Makedeps \
autom4te.cache
+test -d inst/lib/Rcpp && rmdir inst/lib/Rcpp
test -d inst/lib && rmdir inst/lib
find . -name \*~ -exec rm {} \;
find . -name \*.flc -exec rm {} \;
Modified: pkg/inst/ChangeLog
===================================================================
--- pkg/inst/ChangeLog 2009-12-30 13:48:14 UTC (rev 235)
+++ pkg/inst/ChangeLog 2009-12-30 14:40:36 UTC (rev 236)
@@ -1,5 +1,16 @@
2009-12-30 Romain Francois <francoisromain at free.fr>
+ * src/Rcpp/Environment.h : added minimal support for environment
+
+ * src/Environment.cpp: idem
+
+ * inst/unitTests/runit.environments.R: testing the above
+
+ * src/RcppCommon.h: now includes <R_ext/Callbacks.h>, needed for the
+ environment support
+
+2009-12-30 Romain Francois <francoisromain at free.fr>
+
* src/Makevars* : adapt for allowong copy of the Rcpp directory
* src/Rcpp_RObject.h: replace by src/Rcpp/RObject.h
@@ -7,6 +18,8 @@
* src/Rcpp_XPtr.h: replaced by src/Rcpp/XPtr.h
* src/*.cpp: adapt to the Rcpp directory
+
+ * cleanup: idem
2009-12-30 Romain Francois <francoisromain at free.fr>
Added: pkg/inst/unitTests/runit.environments.R
===================================================================
--- pkg/inst/unitTests/runit.environments.R (rev 0)
+++ pkg/inst/unitTests/runit.environments.R 2009-12-30 14:40:36 UTC (rev 236)
@@ -0,0 +1,50 @@
+#!/usr/bin/r -t
+#
+# Copyright (C) 2009 - 2010 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/>.
+
+.setUp <- function(){
+ suppressMessages( require( inline ) )
+}
+
+test.environment.ls <- function(){
+ funx <- cfunction(signature(x="environment"), '
+ Rcpp::Environment env(x) ;
+ return env.ls(true) ;
+ ', Rcpp=TRUE, verbose=FALSE)
+
+ e <- new.env( )
+ e$a <- 1:10
+ e$b <- "foo"
+ e$.c <- "hidden"
+ checkEquals( funx(e), c("a","b", ".c"), msg = "Environment::ls(true)" )
+ checkEquals( funx(asNamespace("Rcpp")), ls(envir=asNamespace("Rcpp"), all = TRUE),
+ msg = "Environment(namespace)::ls()" )
+
+ funx <- cfunction(signature(x="environment"), '
+ Rcpp::Environment env(x) ;
+ return env.ls(false) ;
+ ', Rcpp=TRUE, verbose=FALSE)
+ checkEquals( funx(e), c("a","b"), msg = "Environment::ls(false)" )
+ checkEquals( funx(asNamespace("Rcpp")), ls(envir=asNamespace("Rcpp"), all = FALSE),
+ msg = "Environment(namespace)::ls()" )
+
+}
+
+
+
+
Added: pkg/src/Environment.cpp
===================================================================
--- pkg/src/Environment.cpp (rev 0)
+++ pkg/src/Environment.cpp 2009-12-30 14:40:36 UTC (rev 236)
@@ -0,0 +1,50 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Environment.cpp: Rcpp R/C++ interface class library -- Environments
+//
+// Copyright (C) 2009 - 2010 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/Environment.h>
+
+namespace Rcpp {
+
+ Environment::Environment( SEXP m_sexp = R_GlobalEnv) : RObject::RObject(m_sexp){
+ if( TYPEOF(m_sexp) != ENVSXP ){
+ throw std::runtime_error( "not an environment" ) ;
+ }
+ is_user_database = IS_USER_DATABASE(m_sexp) ;
+ }
+
+ Environment::~Environment(){
+ logTxt( "~Environment" ) ;
+ }
+
+ SEXP Environment::ls( bool all = true) const {
+ if( is_user_database ){
+ R_ObjectTable *tb = (R_ObjectTable*)
+ R_ExternalPtrAddr(HASHTAB(m_sexp));
+ return tb->objects(tb) ;
+ } else{
+ Rboolean get_all = all ? TRUE : FALSE ;
+ return R_lsInternal( m_sexp, get_all ) ;
+ }
+ return R_NilValue ;
+ }
+
+} // namespace Rcpp
+
Added: pkg/src/Rcpp/Environment.h
===================================================================
--- pkg/src/Rcpp/Environment.h (rev 0)
+++ pkg/src/Rcpp/Environment.h 2009-12-30 14:40:36 UTC (rev 236)
@@ -0,0 +1,67 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Rcpp_RObject.h: Rcpp R/C++ interface class library -- super class of all R objects wrapped in C++ classes
+//
+// Copyright (C) 2009 - 2010 Dirk Eddelbuettel
+// Copyright (C) 2009 - 2010 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_Environment_h
+#define Rcpp_Environment_h
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+
+#define IS_USER_DATABASE(rho) OBJECT((rho)) && Rf_inherits((rho), "UserDefinedDatabase")
+
+namespace Rcpp{
+
+class Environment: public RObject{
+public:
+
+ /**
+ * wraps the given environment
+ *
+ * if the SEXP is not an environment, and exception is thrown
+ */
+ Environment(SEXP m_sexp) ;
+
+ /**
+ * Nothing specific
+ */
+ ~Environment() ;
+
+ /**
+ * The list of objects in the environment
+ *
+ * the same as calling this from R:
+ * > ls( envir = this, all = all )
+ */
+ SEXP ls(bool all) const ;
+
+protected:
+
+ /**
+ * we cache whether this environment is a user defined database
+ * or a standard environment
+ */
+ bool is_user_database ;
+};
+
+} // namespace Rcpp
+
+#endif
Modified: pkg/src/Rcpp.h
===================================================================
--- pkg/src/Rcpp.h 2009-12-30 13:48:14 UTC (rev 235)
+++ pkg/src/Rcpp.h 2009-12-30 14:40:36 UTC (rev 236)
@@ -43,6 +43,7 @@
/* new api */
#include <Rcpp/RObject.h>
-#include <Rcpp/XPtr.h>
+#include <Rcpp/XPtr.h>
+#include <Rcpp/Environment.h>
#endif
Modified: pkg/src/RcppCommon.h
===================================================================
--- pkg/src/RcppCommon.h 2009-12-30 13:48:14 UTC (rev 235)
+++ pkg/src/RcppCommon.h 2009-12-30 14:40:36 UTC (rev 236)
@@ -38,6 +38,7 @@
#include <R.h>
#include <Rinternals.h>
+#include <R_ext/Callbacks.h>
// #ifdef BUILDING_DLL
// #define RcppExport extern "C" __declspec(dllexport)
_______________________________________________
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
More information about the Rcpp-devel
mailing list