[Rcpp-commits] r1405 - in pkg: Rcpp/R Rcpp/inst Rcpp/inst/include Rcpp/src RcppGSL/src

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Wed Jun 2 21:48:05 CEST 2010


Author: romain
Date: 2010-06-02 21:48:00 +0200 (Wed, 02 Jun 2010)
New Revision: 1405

Added:
   pkg/Rcpp/R/tools.R
Modified:
   pkg/Rcpp/inst/ChangeLog
   pkg/Rcpp/inst/include/RcppCommon.h
   pkg/Rcpp/src/RcppCommon.cpp
   pkg/RcppGSL/src/RcppGSL.cpp
Log:
+ as_character_externalptr (c++) and matching (unexported) externalptr_address R function (will use this for modules)

Added: pkg/Rcpp/R/tools.R
===================================================================
--- pkg/Rcpp/R/tools.R	                        (rev 0)
+++ pkg/Rcpp/R/tools.R	2010-06-02 19:48:00 UTC (rev 1405)
@@ -0,0 +1,21 @@
+# 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/>.
+
+externalptr_address <- function(xp){
+	.Call( "as_character_externalptr", xp, PACKAGE = "Rcpp" )	
+}
+

Modified: pkg/Rcpp/inst/ChangeLog
===================================================================
--- pkg/Rcpp/inst/ChangeLog	2010-06-02 14:27:25 UTC (rev 1404)
+++ pkg/Rcpp/inst/ChangeLog	2010-06-02 19:48:00 UTC (rev 1405)
@@ -1,8 +1,11 @@
-2010-06-01  Romain Francois <romain at r-enthusiasts.com>
+2010-06-02  Romain Francois <romain at r-enthusiasts.com>
 
 	* inst/include/Rcpp/traits/r_type_traits.h: added missing support for
 	std::complex<double>, needed by RcppArmadillo
 
+	* src/RcppCommon.cpp: added internal .Call function as_character_externalptr
+	to extract the address of the pointer wrapped by an external pointer
+	
 2010-06-01  Romain Francois <romain at r-enthusiasts.com>
 
 	* inst/doc/Rcpp-package*: new mini vignette "Rcpp-package" to improve the 

Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h	2010-06-02 14:27:25 UTC (rev 1404)
+++ pkg/Rcpp/inst/include/RcppCommon.h	2010-06-02 19:48:00 UTC (rev 1405)
@@ -149,6 +149,11 @@
 RcppExport SEXP test_named() ;
 RcppExport SEXP capabilities() ;
 
+/**
+ * the address of the pointer wrapped by an external pointer
+ */
+RcppExport SEXP as_character_externalptr(SEXP); 
+
 const char * sexp_to_name(int sexp_type); 
 
 #include <Rcpp/exceptions.h>

Modified: pkg/Rcpp/src/RcppCommon.cpp
===================================================================
--- pkg/Rcpp/src/RcppCommon.cpp	2010-06-02 14:27:25 UTC (rev 1404)
+++ pkg/Rcpp/src/RcppCommon.cpp	2010-06-02 19:48:00 UTC (rev 1405)
@@ -23,6 +23,7 @@
 
 #include <Rcpp.h>
 #include <cstring>
+#include <stdio.h>
 
 // Paul Roebuck has observed that the memory used by an exception message
 // is not reclaimed if error() is called inside of a catch block (due to
@@ -198,3 +199,9 @@
 	return Rf_ScalarInteger( p->back( ) ) ;
 }
 
+SEXP as_character_externalptr(SEXP xp){
+	char buffer[20] ;
+	sprintf( buffer, "<%p>", EXTPTR_PTR(x) ) ;
+	return wrap( (const char*)buffer ) ;
+}
+

Modified: pkg/RcppGSL/src/RcppGSL.cpp
===================================================================
--- pkg/RcppGSL/src/RcppGSL.cpp	2010-06-02 14:27:25 UTC (rev 1404)
+++ pkg/RcppGSL/src/RcppGSL.cpp	2010-06-02 19:48:00 UTC (rev 1405)
@@ -232,7 +232,7 @@
 	
 	double res = 0.0 ;
 	for( int i=0; i<nr; i++){
-		res += gsl_matrix_get( mat, i, 0 ) ;
+		res += mat( i, 0 ) ;
 	}   
 	mat.free() ;
 	return res ;



More information about the Rcpp-commits mailing list