[Rcpp-commits] r3043 - in pkg/Rcpp: . R inst man

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

Author: romain
Date: 2011-05-31 10:17:13 +0200 (Tue, 31 May 2011)
New Revision: 3043

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/DESCRIPTION
   pkg/Rcpp/R/loadRcppModules.R
   pkg/Rcpp/R/populate.R
   pkg/Rcpp/R/tools.R
   pkg/Rcpp/inst/NEWS
   pkg/Rcpp/man/loadRcppModules.Rd
Log:
new argument direct in loadRcppModules

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2011-05-31 07:49:20 UTC (rev 3042)
+++ pkg/Rcpp/ChangeLog	2011-05-31 08:17:13 UTC (rev 3043)
@@ -1,3 +1,9 @@
+2011-05-31  Romain Francois  <romain at r-enthusiasts.com>
+
+	* R/loadRcppModules.R: New argument "direct" in loadRcppModules
+
+	* R/tools.R: New unexported function forceAssignInNamespace
+
 2011-05-29  Dirk Eddelbuettel  <edd at debian.org>
 
 	* inst/include/Rcpp/stats/random/rlnorm.h: Repaired accidental header

Modified: pkg/Rcpp/DESCRIPTION
===================================================================
--- pkg/Rcpp/DESCRIPTION	2011-05-31 07:49:20 UTC (rev 3042)
+++ pkg/Rcpp/DESCRIPTION	2011-05-31 08:17:13 UTC (rev 3043)
@@ -1,6 +1,6 @@
 Package: Rcpp
 Title: Seamless R and C++ Integration
-Version: 0.9.4.1
+Version: 0.9.4.2
 Date: $Date$
 Author: Dirk Eddelbuettel and Romain Francois, 
  with contributions by Douglas Bates and John Chambers

Modified: pkg/Rcpp/R/loadRcppModules.R
===================================================================
--- pkg/Rcpp/R/loadRcppModules.R	2011-05-31 07:49:20 UTC (rev 3042)
+++ pkg/Rcpp/R/loadRcppModules.R	2011-05-31 08:17:13 UTC (rev 3043)
@@ -1,5 +1,5 @@
 
-loadRcppModules <- function(){
+loadRcppModules <- function(direct=TRUE){
    # hunt for the namespace of the package that calls this
    calls <- sys.calls()
    w <- which( sapply( calls, function(call){
@@ -25,9 +25,13 @@
         for( m in modules ){
             tryCatch( {
                 mod <- Module( m, pkg, mustStart = TRUE)
-                populate( mod, ns )
+                if(isTRUE(direct)){
+                   populate( mod, ns )
+                } else {
+                    forceAssignInNamespace( m, mod, ns ) 
+                }
             }, error = function(e){
-                stop( sprintf( "failed to load module %s from package %s", m, pkg ) )  
+                stop( sprintf( "failed to load module %s from package %s\n%s", m, pkg, conditionMessage(e) ) )  
             })
         }
    }

Modified: pkg/Rcpp/R/populate.R
===================================================================
--- pkg/Rcpp/R/populate.R	2011-05-31 07:49:20 UTC (rev 3042)
+++ pkg/Rcpp/R/populate.R	2011-05-31 08:17:13 UTC (rev 3043)
@@ -25,15 +25,7 @@
     
     is_ns <- isNamespace( env )
     for( x in symbols ){
-        if( is_ns && exists( x, env ) && bindingIsLocked(x, env ) ){
-            unlockBinding( x, env )
-        }
-        
-        assign( x, storage[[x]], env )
-        
-        if( is_ns ){
-            lockBinding( x, env )
-        }
+        forceAssignInNamespace( x, storage[[x]], env )
     }
 }
 

Modified: pkg/Rcpp/R/tools.R
===================================================================
--- pkg/Rcpp/R/tools.R	2011-05-31 07:49:20 UTC (rev 3042)
+++ pkg/Rcpp/R/tools.R	2011-05-31 08:17:13 UTC (rev 3043)
@@ -19,3 +19,16 @@
 	.Call( as_character_externalptr, xp )	
 }
 
+# just like assignInNamespace but first checks that the binding exists             
+forceAssignInNamespace <- function( x, value, env ){
+    is_ns <- isNamespace( env )
+    if( is_ns && exists( x, env ) && bindingIsLocked(x, env ) ){
+        unlockBinding( x, env )
+    }
+    
+    assign( x, value, env )
+    
+    if( is_ns ){
+        lockBinding( x, env )
+    }    
+}

Modified: pkg/Rcpp/inst/NEWS
===================================================================
--- pkg/Rcpp/inst/NEWS	2011-05-31 07:49:20 UTC (rev 3042)
+++ pkg/Rcpp/inst/NEWS	2011-05-31 08:17:13 UTC (rev 3043)
@@ -7,7 +7,10 @@
 
     o   Minor correction and extension to STL documentation in Rcpp-quickref
 
-    o   wrap() is now resilient to NULL pointers passed as in const char * 
+    o   wrap() is now resilient to NULL pointers passed as in const char *
+    
+    o   loadRcppModules() gains a "direct" argument to expose the module instead
+        of exposing what is inside it
 
 0.9.4   2011-04-12
 

Modified: pkg/Rcpp/man/loadRcppModules.Rd
===================================================================
--- pkg/Rcpp/man/loadRcppModules.Rd	2011-05-31 07:49:20 UTC (rev 3042)
+++ pkg/Rcpp/man/loadRcppModules.Rd	2011-05-31 08:17:13 UTC (rev 3043)
@@ -11,8 +11,12 @@
 and \code{\link{populate}} each module into the package NAMESPACE.
 }
 \usage{
-loadRcppModules()
+loadRcppModules(direct=TRUE)
 }
+\arguments{
+    \item{direct}{if \code{TRUE} the content of the module is exposed in the
+    namespace. Otherwise, the module is exposed. }
+}
 \seealso{
     \code{\link{populate}}
 }