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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sat Mar 13 09:59:42 CET 2010


Author: romain
Date: 2010-03-13 09:59:42 +0100 (Sat, 13 Mar 2010)
New Revision: 888

Added:
   pkg/Rcpp/src/Rcpp/S4.h
   pkg/Rcpp/src/S4.cpp
Modified:
   pkg/Rcpp/NEWS
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.S4.R
   pkg/Rcpp/src/Rcpp.h
Log:
new class Rcpp::S4 whose construtor checks that the object is an S4 object

Modified: pkg/Rcpp/NEWS
===================================================================
--- pkg/Rcpp/NEWS	2010-03-13 00:25:52 UTC (rev 887)
+++ pkg/Rcpp/NEWS	2010-03-13 08:59:42 UTC (rev 888)
@@ -1,3 +1,8 @@
+
+0.7.10  (under development)
+
+	o	new class Rcpp::S4 whose constructor checks if the object is an S4 object
+
 0.7.9   2010-03-12
 
     o	Another small improvement to Windows build flags
@@ -3,10 +8,10 @@
 
     o	bugfix on 64 bit platforms. The traits classes (wrap_type_traits, etc)
-	used size_t when they needed to actually use unsigned int
+		used size_t when they needed to actually use unsigned int
 
     o	fixed pre gcc 4.3 compatibility. The trait class that was used to 
-	identify if a type is convertible to another had too many false positives
-	on pre gcc 4.3 (no tr1 or c++0x features). fixed by implementing the 
-	section 2.7 of "Modern C++ Design" book. 
+		identify if a type is convertible to another had too many false positives
+		on pre gcc 4.3 (no tr1 or c++0x features). fixed by implementing the 
+		section 2.7 of "Modern C++ Design" book. 
 
 0.7.8   2010-03-09

Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-03-13 00:25:52 UTC (rev 887)
+++ pkg/Rcpp/inst/ChangeLog	2010-03-13 08:59:42 UTC (rev 888)
@@ -1,3 +1,7 @@
+2010-03-13  Romain Francois <romain at r-enthusiasts.com>
+
+	* src/Rcpp/S4.h : new class Rcpp::S4
+
 2010-03-12  Dirk Eddelbuettel  <edd at debian.org>
 
 	* DESCRIPTION: Release 0.7.9

Modified: pkg/Rcpp/inst/unitTests/runit.S4.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.S4.R	2010-03-13 00:25:52 UTC (rev 887)
+++ pkg/Rcpp/inst/unitTests/runit.S4.R	2010-03-13 08:59:42 UTC (rev 888)
@@ -21,7 +21,7 @@
 	suppressMessages( require( inline ) )
 }
 
-test.S4 <- function(){
+test.RObject.S4methods <- function(){
 	funx <- cfunction(signature(x = "ANY" ), '
 	RObject y(x) ;
 	List res(5) ;
@@ -63,6 +63,19 @@
 	', Rcpp=TRUE, verbose=FALSE, includes = "using namespace Rcpp;" )
 	checkException( funx( tr ), msg = "slot does not exist" )
 	
+}
+
+test.S4 <- function(){
+		
+	setClass("track",
+           representation(x="numeric", y="numeric"))
+	tr <- new( "track", x = 2, y = 3 )
+	fx <- cfunction( signature( x = "ANY" ) 'S4 o(x); return o.slot( "x" ) ;', 
+		Rcpp = TRUE, includes = "using namespace Rcpp;" )
+	checkEquals( fx( tr ), 2, msg = "S4( SEXP )" )
 	
+	checkExecption( fx( list( x = 2, y = 3 ) ), msg = "not S4" )
+	checkException( fx( structure( list( x = 2, y = 3 ), class = "track" ) ), msg = "S3 is not S4" )
+	
 }
 

Added: pkg/Rcpp/src/Rcpp/S4.h
===================================================================
--- pkg/Rcpp/src/Rcpp/S4.h	                        (rev 0)
+++ pkg/Rcpp/src/Rcpp/S4.h	2010-03-13 08:59:42 UTC (rev 888)
@@ -0,0 +1,44 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// S4.h: Rcpp R/C++ interface class library -- S4 objects
+//
+// Copyright (C) 2010	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_S4_h
+#define Rcpp_S4_h                     
+
+#include <RcppCommon.h>
+#include <Rcpp/RObject.h>
+
+namespace Rcpp{ 
+
+class S4 : public RObject{
+public:
+	S4() ;
+	S4(SEXP x); 
+	S4(const S4& other) ;
+	S4& operator=( const S4& other);
+	
+	// TODO : 
+	// S4( const& std::string klass ) ; ...
+	
+} ;
+
+} // namespace Rcpp
+
+#endif

Modified: pkg/Rcpp/src/Rcpp.h
===================================================================
--- pkg/Rcpp/src/Rcpp.h	2010-03-13 00:25:52 UTC (rev 887)
+++ pkg/Rcpp/src/Rcpp.h	2010-03-13 08:59:42 UTC (rev 888)
@@ -49,6 +49,7 @@
 
 #include <Rcpp/RObject.h>
 
+#include <Rcpp/S4.h>
 #include <Rcpp/exceptions.h>
 #include <Rcpp/clone.h>
 #include <Rcpp/grow.h>

Added: pkg/Rcpp/src/S4.cpp
===================================================================
--- pkg/Rcpp/src/S4.cpp	                        (rev 0)
+++ pkg/Rcpp/src/S4.cpp	2010-03-13 08:59:42 UTC (rev 888)
@@ -0,0 +1,45 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// S4.cpp: Rcpp R/C++ interface class library -- S4 objects
+//
+// Copyright (C) 2010	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/S4.h>
+
+namespace Rcpp {
+
+	S4::S4() : RObject(){}
+	
+	S4::S4(SEXP x) : RObject(){
+		if( ! ::Rf_isS4(x) ){
+			throw not_s4() ;
+		} else{
+			setSEXP( x) ;
+		}
+	}
+	
+	S4::S4( const S4& other) : RObject(){
+		setSEXP( other.asSexp() ) ;	
+	}
+	
+	S4& S4::operator=( const S4& other){
+		setSEXP( other.asSexp() ) ;
+		return *this ;
+	}
+	
+} // namespace Rcpp



More information about the Rcpp-commits mailing list