[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