[Rcpp-commits] r4388 - in pkg/Rcpp: . inst/unitTests inst/unitTests/cpp

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

Author: romain
Date: 2013-07-02 19:38:03 +0200 (Tue, 02 Jul 2013)
New Revision: 4388

Added:
   pkg/Rcpp/inst/unitTests/cpp/XPtr.cpp
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.XPTr.R
Log:
convert runit.XPTr to use sourceCpp

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-02 17:26:25 UTC (rev 4387)
+++ pkg/Rcpp/ChangeLog	2013-07-02 17:38:03 UTC (rev 4388)
@@ -9,6 +9,7 @@
         * unitTests/runit.rmath.R: using sourceCpp
         * unitTests/runit.RObject.R: using sourceCpp
         * unitTests/runit.stats.R: using sourceCpp
+        * unitTests/runit.XPTr.R: using sourceCpp
         * unitTests/runit.Vector.R: testing List( int, IntegerVector ) which 
         eventually uses fill__dispatch
         * include/Rcpp/traits/r_type_traits.h: support for as<T&> and as<const T&>

Added: pkg/Rcpp/inst/unitTests/cpp/XPtr.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/XPtr.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/XPtr.cpp	2013-07-02 17:38:03 UTC (rev 4388)
@@ -0,0 +1,48 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// XPtr.cpp: Rcpp R/C++ interface class library -- external pointer unit tests
+//
+// Copyright (C) 2013 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]]
+XPtr< std::vector<int> > xptr_1(){
+		    /* creating a pointer to a vector<int> */
+		    std::vector<int>* v = new std::vector<int> ;
+		    v->push_back( 1 ) ;
+		    v->push_back( 2 ) ;
+        
+		    /* wrap the pointer as an external pointer */
+		    /* this automatically protected the external pointer from R garbage
+		       collection until p goes out of scope. */
+		    XPtr< std::vector<int> > p(v) ;
+        
+		    /* return it back to R, since p goes out of scope after the return
+		       the external pointer is no more protected by p, but it gets
+		       protected by being on the R side */
+		    return( p ) ;
+}
+
+// [[Rcpp::export]]
+int xptr_2( XPtr< std::vector<int> > p){
+    		/* just return the front of the vector as a SEXP */
+    		return p->front() ;
+}
+

Modified: pkg/Rcpp/inst/unitTests/runit.XPTr.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.XPTr.R	2013-07-02 17:26:25 UTC (rev 4387)
+++ pkg/Rcpp/inst/unitTests/runit.XPTr.R	2013-07-02 17:38:03 UTC (rev 4388)
@@ -1,7 +1,7 @@
 #!/usr/bin/r -t
 #       hey emacs, please make this use  -*- tab-width: 4 -*-
 #
-# Copyright (C) 2009 - 2012	 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2009 - 2013	 Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -22,44 +22,14 @@
 
 if (.runThisTest) {
 
-    test.XPtr <- function(){
+.setUp <- Rcpp:::unit_test_setup( "XPtr.cpp" )
+    
+test.XPtr <- function(){
+    xp <- xptr_1()
+    checkEquals(typeof( xp ), "externalptr", msg = "checking external pointer creation" )
+    
+    front <- xptr_2(xp)
+    checkEquals( front, 1L, msg = "check usage of external pointer" )
+}
 
-        funx <- cxxfunction(signature(), '
-		    /* creating a pointer to a vector<int> */
-		    std::vector<int>* v = new std::vector<int> ;
-		    v->push_back( 1 ) ;
-		    v->push_back( 2 ) ;
-        
-		    /* wrap the pointer as an external pointer */
-		    /* this automatically protected the external pointer from R garbage
-		       collection until p goes out of scope. */
-		    Rcpp::XPtr< std::vector<int> > p(v) ;
-        
-		    /* return it back to R, since p goes out of scope after the return
-		       the external pointer is no more protected by p, but it gets
-		       protected by being on the R side */
-		    return( p ) ;
-	    ', plugin = "Rcpp" )
-        xp <- funx()
-        checkEquals(typeof( xp ), "externalptr",
-                    msg = "checking external pointer creation" )
-
-        ## passing the pointer back to C++
-        funx <- cxxfunction(signature(x = "externalptr" ), '
-		    /* wrapping x as smart external pointer */
-		    /* The SEXP based constructor does not protect the SEXP from
-		       garbage collection automatically, it is already protected
-		       because it comes from the R side, however if you want to keep
-		       the Rcpp::XPtr object on the C(++) side
-		       and return something else to R, you need to protect the external
-		       pointer, by using the protect member function */
-		    Rcpp::XPtr< std::vector<int> > p(x) ;
-        
-    		/* just return the front of the vector as a SEXP */
-    		return( Rcpp::wrap( p->front() ) ) ;
-    	', plugin = "Rcpp" )
-        front <- funx(xp)
-        checkEquals( front, 1L, msg = "check usage of external pointer" )
-    }
-
 }