[Rcpp-commits] r1047 - in pkg/Rcpp: . R

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

Author: romain
Date: 2010-04-15 10:54:15 +0200 (Thu, 15 Apr 2010)
New Revision: 1047

Modified:
   pkg/Rcpp/NAMESPACE
   pkg/Rcpp/R/cppfunction.R
   pkg/Rcpp/R/zzz.R
Log:
deal with locked bindings, etc ... 

Modified: pkg/Rcpp/NAMESPACE
===================================================================
--- pkg/Rcpp/NAMESPACE	2010-04-15 08:37:10 UTC (rev 1046)
+++ pkg/Rcpp/NAMESPACE	2010-04-15 08:54:15 UTC (rev 1047)
@@ -2,6 +2,7 @@
 
 export(Rcpp.package.skeleton)
 export(.Cpp)
+export(cppfunction)
 
 importFrom( utils, capture.output )
 

Modified: pkg/Rcpp/R/cppfunction.R
===================================================================
--- pkg/Rcpp/R/cppfunction.R	2010-04-15 08:37:10 UTC (rev 1046)
+++ pkg/Rcpp/R/cppfunction.R	2010-04-15 08:54:15 UTC (rev 1047)
@@ -15,9 +15,19 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
+NAMESPACE <- environment()
 HAVEINLINE <- FALSE
 cfunction <- function(...) stop( "inline not available" ) 
 
+init.inline <- function(){
+	unlockBinding( "HAVEINLINE", NAMESPACE )
+	unlockBinding( "cfunction", NAMESPACE )
+	assignInNamespace( "HAVEINLINE", TRUE, NAMESPACE )
+	assignInNamespace( "cfunction" , get( "cfunction", asNamespace( "inline" )), NAMESPACE )   
+	lockBinding( "HAVEINLINE", NAMESPACE )
+	lockBinding( "cfunction", NAMESPACE )
+}
+
 cppfunction <- function (sig = character(), body = character(), includes = character(), 
     otherdefs = character(), verbose = FALSE, 
     cppargs = character(), cxxargs = character(), libargs = character(), 
@@ -29,15 +39,14 @@
 			ok <- TRUE
 		} else{
 			ok <- tryCatch( {
-				require( "inline" )
+				require( "inline", character.only = TRUE, quietly = TRUE )
 				TRUE 
 			} , error = function(e) FALSE )
 		}
 		if( ! ok ){
 			stop( "package inline is not available" )	
 		}
-		HAVEINLINE <<- TRUE
-		cfunction <<- get( "cfunction", asNamespace( "inline" ) )
+		init.inline()
 	}
 	if( isTRUE( namespace ) ){
 		includes <- c( includes, "using namespace Rcpp;" )

Modified: pkg/Rcpp/R/zzz.R
===================================================================
--- pkg/Rcpp/R/zzz.R	2010-04-15 08:37:10 UTC (rev 1046)
+++ pkg/Rcpp/R/zzz.R	2010-04-15 08:54:15 UTC (rev 1047)
@@ -18,8 +18,7 @@
 .onLoad <- function(libname, pkgname){
 	.Call( "initRcpp", PACKAGE = pkgname )
 	if( "package:inline" %in% search() ){
-		HAVEINLINE <<- TRUE	
-		cfunction <<- get( "cfunction", asNamespace( "inline" ) )
+		init.inline()
 	}
 }