[Rcpp-commits] r2694 - in pkg/Rcpp: . inst/include/Rcpp inst/unitTests

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

Author: romain
Date: 2010-12-03 13:15:12 +0100 (Fri, 03 Dec 2010)
New Revision: 2694

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/RObject.h
   pkg/Rcpp/inst/unitTests/runit.RObject.R
Log:
added RObject::inherits

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2010-12-03 10:22:58 UTC (rev 2693)
+++ pkg/Rcpp/ChangeLog	2010-12-03 12:15:12 UTC (rev 2694)
@@ -1,3 +1,10 @@
+2010-12-03  Romain Francois <romain at r-enthusiasts.com>
+
+    * inst/include/Rcpp/RObject.h : new inline method inherits that checks if 
+    an object inherits from a given class (wrapper around Rf_inherits)
+    
+    * inst/unitTests/runit.RObject.R: unit test for the above
+
 2010-12-02  Douglas Bates  <bates at stat.wisc.edu>
 
 	* inst/include/Rcpp/generated/Function__operator.h,

Modified: pkg/Rcpp/inst/include/Rcpp/RObject.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/RObject.h	2010-12-03 10:22:58 UTC (rev 2693)
+++ pkg/Rcpp/inst/include/Rcpp/RObject.h	2010-12-03 12:15:12 UTC (rev 2694)
@@ -67,6 +67,11 @@
      */
     inline operator SEXP() const { return m_sexp ; }
 
+    /**
+     * Does this object inherit from a given class
+     */
+    inline bool inherits(const char* clazz) const { return ::Rf_inherits( m_sexp, clazz) ; }
+    
     /* attributes */
 
     /**

Modified: pkg/Rcpp/inst/unitTests/runit.RObject.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RObject.R	2010-12-03 10:22:58 UTC (rev 2693)
+++ pkg/Rcpp/inst/unitTests/runit.RObject.R	2010-12-03 12:15:12 UTC (rev 2694)
@@ -145,7 +145,13 @@
                   ,"isNULL"=list(
                    signature(x="ANY"),
                    'bool is_null = RObject(x).isNULL() ;
-					return wrap( is_null ) ; ' )
+					return wrap( is_null ) ; '
+				   ,"inherits" = list( x = "ANY" ), 
+				   '
+				   RObject xx(x) ;
+				   return wrap( xx.inherits( "foo" ) ) ;
+				   '
+					)
 
                   )
 
@@ -326,3 +332,12 @@
 	checkTrue( !funx(.GlobalEnv), msg = "RObject.isNULL(environment) -> false" )
 }
 
+test.RObject.isNULL <- function(){
+	funx <- .Rcpp.RObject$inherits
+	x <- 1:10
+	checkTrue( !fx(x) )
+	class(x) <- "foo"
+	checkTrue( fx(x) ) )
+	class(x) <- c("foo", "bar" )
+	checkTrue( fx(x) ) )
+}