From noreply at r-forge.r-project.org  Tue Jul  2 10:35:37 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 10:35:37 +0200 (CEST)
Subject: [Rcpp-commits] r4377 - in pkg/Rcpp: . R inst inst/include/Rcpp
	inst/include/Rcpp/macros inst/include/Rcpp/module
	inst/include/Rcpp/traits inst/include/Rcpp/vector
	inst/unitTests inst/unitTests/cpp
Message-ID: <20130702083537.76E71180603@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 10:35:37 +0200 (Tue, 02 Jul 2013)
New Revision: 4377

Added:
   pkg/Rcpp/inst/unitTests/cpp/Function.cpp
   pkg/Rcpp/inst/unitTests/cpp/Matrix.cpp
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/R/unit.tests.R
   pkg/Rcpp/inst/NEWS.Rd
   pkg/Rcpp/inst/include/Rcpp/as.h
   pkg/Rcpp/inst/include/Rcpp/macros/module.h
   pkg/Rcpp/inst/include/Rcpp/module/Module_generated_CppFunction.h
   pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h
   pkg/Rcpp/inst/include/Rcpp/vector/Vector.h
   pkg/Rcpp/inst/unitTests/cpp/Vector.cpp
   pkg/Rcpp/inst/unitTests/runit.DataFrame.R
   pkg/Rcpp/inst/unitTests/runit.Function.R
   pkg/Rcpp/inst/unitTests/runit.Language.R
   pkg/Rcpp/inst/unitTests/runit.Matrix.R
   pkg/Rcpp/inst/unitTests/runit.Vector.R
   pkg/Rcpp/inst/unitTests/runit.as.R
   pkg/Rcpp/inst/unitTests/runit.environments.R
Log:
supporting as<T&> and as<const T&> when T is module exposed

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-06-30 20:12:33 UTC (rev 4376)
+++ pkg/Rcpp/ChangeLog	2013-07-02 08:35:37 UTC (rev 4377)
@@ -1,3 +1,25 @@
+2013-07-02  Romain Francois <romain at r-enthusiasts.com>
+
+        * include/Rcpp/vector/Vector.h: fill__dispatch was mispelled (as
+        fill_dispatch) for the non trivial case, so it did not work
+        * unitTests/runit.Matrix.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&>
+        when T is module exposed
+        * include/Rcpp/as.h: as<T&> and as<const T&> when T is module exposed
+        * include/Rcpp/module/Module_generated_CppFunction.h: removed the 
+        remove_const_and_reference since as<T&> and as<const T&> is supported
+
+2013-07-01  Romain Francois <romain at r-enthusiasts.com>
+
+        * R/unit.test.R: added helper function Rcpp:::unit_test_setup to avoid
+        some boiler plate code in unit test files. See e.g. runit.Function.R for
+        an example
+        * unitTests/runit.as.R: using sourceCpp
+        * unitTests/runit.Function.R: using sourceCpp
+        * unitTests/runit.DataFrame.R: remove dependency on datasets
+
 2013-06-25  Dirk Eddelbuettel  <edd at debian.org>
 
 	* src/api.cpp: Also test for #defined(__sun) when checking for system

Modified: pkg/Rcpp/R/unit.tests.R
===================================================================
--- pkg/Rcpp/R/unit.tests.R	2013-06-30 20:12:33 UTC (rev 4376)
+++ pkg/Rcpp/R/unit.tests.R	2013-07-02 08:35:37 UTC (rev 4377)
@@ -1,4 +1,4 @@
-# Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2013 Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -37,3 +37,16 @@
     )
     fun
 }
+
+unit_test_setup <- function(file, packages = NULL) {
+	function(){
+	    if( !is.null(packages) ){
+	        for( p in packages ){
+	            suppressMessages( require( p, character.only = TRUE ) )
+	        }
+	    }
+	    if (!exists("pathRcppTests")) pathRcppTests <- getwd()
+        sourceCpp(file.path(pathRcppTests, "cpp", file ))
+    }
+}
+

Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd	2013-06-30 20:12:33 UTC (rev 4376)
+++ pkg/Rcpp/inst/NEWS.Rd	2013-07-02 08:35:37 UTC (rev 4377)
@@ -10,8 +10,17 @@
       \item Add \code{#defined(__sun)} to lists of operating systems to
       test for when checking for lack of \code{backtrace()} needed for
       stack traces.
+      \item \code{as<T&>} and \code{as<const T&>} is now supported, when 
+      T is a class exposed by modules, i.e. with \code{RCPP_EXPOSED_CLASS}
     }
 
+    \item Changes in Modules:
+    \itemize{
+      \item We can now expose functions and methods that take
+      \code{T&} or \code{const T&} as arguments. In these situations
+      objects are no longer copied as they used to be. 
+    }
+
     \item Deprecation of \code{RCPP_FUNCTION_*}:
     \itemize{
       \item The macros from the \code{preprocessor_generated.h} 

Modified: pkg/Rcpp/inst/include/Rcpp/as.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/as.h	2013-06-30 20:12:33 UTC (rev 4376)
+++ pkg/Rcpp/inst/include/Rcpp/as.h	2013-07-02 08:35:37 UTC (rev 4377)
@@ -99,6 +99,20 @@
             return *obj ;
         }
         
+        /** handling T such that T is a reference of a class handled by a module */
+        template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_reference_tag ){
+            typedef typename traits::remove_reference<T>::type KLASS ;
+            KLASS* obj = as_module_object<KLASS>(x) ;
+            return *obj ;
+        }
+        
+        /** handling T such that T is a reference of a class handled by a module */
+        template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_const_reference_tag ){
+            typedef typename traits::remove_const_and_reference<T>::type KLASS ;
+            KLASS* obj = as_module_object<KLASS>(x) ;
+            return const_cast<T>( *obj ) ;
+        }
+        
         /** handling enums by converting to int first */
         template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_enum_tag ){
             return T( primitive_as<int>(x) ) ;

Modified: pkg/Rcpp/inst/include/Rcpp/macros/module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/macros/module.h	2013-06-30 20:12:33 UTC (rev 4376)
+++ pkg/Rcpp/inst/include/Rcpp/macros/module.h	2013-07-02 08:35:37 UTC (rev 4377)
@@ -2,7 +2,8 @@
 //
 // macros.h: Rcpp R/C++ interface class library -- helper macros for Rcpp modules
 //
-// Copyright (C) 2012   Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2012-2013  Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2013       Rice University
 //
 // This file is part of Rcpp.
 //
@@ -26,7 +27,19 @@
  *  as a parameter of a function or method exposed by modules. This defines
  *  the necessary trait that makes the class as<>'able
  */
-#define RCPP_EXPOSED_AS(CLASS)   namespace Rcpp{ namespace traits{ template<> struct r_type_traits< CLASS >{ typedef r_type_module_object_tag r_category ; } ; }}
+#define RCPP_EXPOSED_AS(CLASS)                                         \
+    namespace Rcpp{ namespace traits{                                  \
+    template<> struct r_type_traits< CLASS >{                          \
+        typedef r_type_module_object_tag r_category ;                  \
+    } ;                                                                \
+    template<> struct r_type_traits< CLASS& >{                         \
+        typedef r_type_module_object_reference_tag r_category ;        \
+    } ;                                                                \
+    template<> struct r_type_traits< const CLASS& >{                   \
+        typedef r_type_module_object_const_reference_tag r_category ;  \
+    } ;                                                                \
+    }}
+    
 #define RCPP_EXPOSED_WRAP(CLASS) namespace Rcpp{ namespace traits{ template<> struct wrap_type_traits< CLASS >{typedef wrap_type_module_object_tag wrap_category ; } ; }}
 
 #define RCPP_EXPOSED_CLASS_NODECL(CLASS) \

Modified: pkg/Rcpp/inst/include/Rcpp/module/Module_generated_CppFunction.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/module/Module_generated_CppFunction.h	2013-06-30 20:12:33 UTC (rev 4376)
+++ pkg/Rcpp/inst/include/Rcpp/module/Module_generated_CppFunction.h	2013-07-02 08:35:37 UTC (rev 4377)
@@ -27,9 +27,7 @@
     public:
         CppFunction0(OUT (*fun)(void), const char* docstring = 0 ) : CppFunction(docstring), ptr_fun(fun){}
         SEXP operator()(SEXP*) {
-            BEGIN_RCPP
             return Rcpp::module_wrap<OUT>( ptr_fun() ) ;
-            END_RCPP
         }
 
         inline int nargs(){ return 0; }
@@ -47,9 +45,8 @@
         CppFunction0(void (*fun)(void), const char* docstring = 0 ) : CppFunction(docstring), ptr_fun(fun){} ;
 
         SEXP operator()(SEXP*) {
-            BEGIN_RCPP
             ptr_fun() ;
-            END_RCPP
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 0; }
@@ -67,9 +64,7 @@
     public:
         CppFunction_WithFormals0(OUT (*fun)(void), Rcpp::List,  const char* docstring = 0 ) : CppFunction(docstring), ptr_fun(fun){}
         SEXP operator()(SEXP*) {
-            BEGIN_RCPP
             return Rcpp::module_wrap<OUT>( ptr_fun() ) ;
-            END_RCPP
         }
 
         inline int nargs(){ return 0; }
@@ -87,9 +82,8 @@
         CppFunction_WithFormals0(void (*fun)(void), Rcpp::List, const char* docstring = 0 ) : CppFunction(docstring), ptr_fun(fun){} ;
 
         SEXP operator()(SEXP*) {
-            BEGIN_RCPP
             ptr_fun() ;
-            END_RCPP
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 0; }
@@ -108,9 +102,7 @@
         CppFunction1(OUT (*fun)(U0) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ) ) ) ;
         }
 
         inline int nargs(){ return 1; }
@@ -127,9 +119,8 @@
         CppFunction1(void (*fun)(U0) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 1; }
@@ -151,9 +142,7 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ) ) ) ;
         }
 
         inline int nargs(){ return 1; }
@@ -173,9 +162,8 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 1; }
@@ -197,9 +185,7 @@
         CppFunction2(OUT (*fun)(U0, U1) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ) ) ) ;
         }
 
         inline int nargs(){ return 2; }
@@ -216,9 +202,8 @@
         CppFunction2(void (*fun)(U0, U1) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 2; }
@@ -240,9 +225,7 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ) ) ) ;
         }
 
         inline int nargs(){ return 2; }
@@ -262,9 +245,8 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 2; }
@@ -286,9 +268,7 @@
         CppFunction3(OUT (*fun)(U0, U1, U2) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ) ) ) ;
         }
 
         inline int nargs(){ return 3; }
@@ -305,9 +285,8 @@
         CppFunction3(void (*fun)(U0, U1, U2) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 3; }
@@ -329,9 +308,7 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ) ) ) ;
         }
 
         inline int nargs(){ return 3; }
@@ -351,9 +328,8 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 3; }
@@ -375,9 +351,7 @@
         CppFunction4(OUT (*fun)(U0, U1, U2, U3) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3 >::type >( args[3] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ) ) ) ;
         }
 
         inline int nargs(){ return 4; }
@@ -394,9 +368,8 @@
         CppFunction4(void (*fun)(U0, U1, U2, U3) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3>::type >( args[3] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 4; }
@@ -418,9 +391,7 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3 >::type >( args[3] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ) ) ) ;
         }
 
         inline int nargs(){ return 4; }
@@ -440,9 +411,8 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3>::type >( args[3] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 4; }
@@ -464,9 +434,7 @@
         CppFunction5(OUT (*fun)(U0, U1, U2, U3, U4) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3 >::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4 >::type >( args[4] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ) ) ) ;
         }
 
         inline int nargs(){ return 5; }
@@ -483,9 +451,8 @@
         CppFunction5(void (*fun)(U0, U1, U2, U3, U4) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3>::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4>::type >( args[4] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 5; }
@@ -507,9 +474,7 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3 >::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4 >::type >( args[4] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ) ) ) ;
         }
 
         inline int nargs(){ return 5; }
@@ -529,9 +494,8 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3>::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4>::type >( args[4] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 5; }
@@ -553,9 +517,7 @@
         CppFunction6(OUT (*fun)(U0, U1, U2, U3, U4, U5) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3 >::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4 >::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5 >::type >( args[5] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ) ) ) ;
         }
 
         inline int nargs(){ return 6; }
@@ -572,9 +534,8 @@
         CppFunction6(void (*fun)(U0, U1, U2, U3, U4, U5) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3>::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4>::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5>::type >( args[5] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 6; }
@@ -596,9 +557,7 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3 >::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4 >::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5 >::type >( args[5] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ) ) ) ;
         }
 
         inline int nargs(){ return 6; }
@@ -618,9 +577,8 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3>::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4>::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5>::type >( args[5] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 6; }
@@ -642,9 +600,7 @@
         CppFunction7(OUT (*fun)(U0, U1, U2, U3, U4, U5, U6) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3 >::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4 >::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5 >::type >( args[5] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U6 >::type >( args[6] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ), Rcpp::as< U6 >( args[6] ) ) ) ;
         }
 
         inline int nargs(){ return 7; }
@@ -661,9 +617,8 @@
         CppFunction7(void (*fun)(U0, U1, U2, U3, U4, U5, U6) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3>::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4>::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5>::type >( args[5] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U6>::type >( args[6] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ), Rcpp::as< U6 >( args[6] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 7; }
@@ -685,9 +640,7 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3 >::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4 >::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5 >::type >( args[5] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U6 >::type >( args[6] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ), Rcpp::as< U6 >( args[6] ) ) ) ;
         }
 
         inline int nargs(){ return 7; }
@@ -707,9 +660,8 @@
             CppFunction(docstring), formals(formals_), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3>::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4>::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5>::type >( args[5] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U6>::type >( args[6] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ), Rcpp::as< U6 >( args[6] ) ) ;
+            return R_NilValue ;
         }
 
         inline int nargs(){ return 7; }
@@ -731,9 +683,7 @@
         CppFunction8(OUT (*fun)(U0, U1, U2, U3, U4, U5, U6, U7) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0 >::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1 >::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2 >::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3 >::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4 >::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5 >::type >( args[5] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U6 >::type >( args[6] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U7 >::type >( args[7] ) ) ) ;
-            END_RCPP
+            return Rcpp::module_wrap<OUT>( ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ), Rcpp::as< U6 >( args[6] ), Rcpp::as< U7 >( args[7] ) ) ) ;
         }
 
         inline int nargs(){ return 8; }
@@ -750,9 +700,8 @@
         CppFunction8(void (*fun)(U0, U1, U2, U3, U4, U5, U6, U7) , const char* docstring = 0) : CppFunction(docstring), ptr_fun(fun){}
 
         SEXP operator()(SEXP* args) {
-            BEGIN_RCPP
-            ptr_fun( Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U0>::type >( args[0] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U1>::type >( args[1] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U2>::type >( args[2] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U3>::type >( args[3] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U4>::type >( args[4] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U5>::type >( args[5] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U6>::type >( args[6] ), Rcpp::as< typename Rcpp::traits::remove_const_and_reference< U7>::type >( args[7] ) ) ;
-            END_RCPP
+            ptr_fun( Rcpp::as< U0 >( args[0] ), Rcpp::as< U1 >( args[1] ), Rcpp::as< U2 >( args[2] ), Rcpp::as< U3 >( args[3] ), Rcpp::as< U4 >( args[4] ), Rcpp::as< U5 >( args[5] ), Rcpp::as< U6 >( args[6] ), Rcpp::as< U7 >( args[7] ) ) ;
+            return R_NilValue ;
         }
 
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/rcpp -r 4377

From noreply at r-forge.r-project.org  Tue Jul  2 11:00:31 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 11:00:31 +0200 (CEST)
Subject: [Rcpp-commits] r4378 - in pkg/Rcpp: . inst/unitTests
	inst/unitTests/cpp
Message-ID: <20130702090031.BE091184468@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 11:00:31 +0200 (Tue, 02 Jul 2013)
New Revision: 4378

Added:
   pkg/Rcpp/inst/unitTests/cpp/misc.cpp
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.misc.R
Log:
using sourceCpp in testing

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-02 08:35:37 UTC (rev 4377)
+++ pkg/Rcpp/ChangeLog	2013-07-02 09:00:31 UTC (rev 4378)
@@ -3,6 +3,7 @@
         * include/Rcpp/vector/Vector.h: fill__dispatch was mispelled (as
         fill_dispatch) for the non trivial case, so it did not work
         * unitTests/runit.Matrix.R: using sourceCpp
+        * unitTests/runit.misc.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/misc.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/misc.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/misc.cpp	2013-07-02 09:00:31 UTC (rev 4378)
@@ -0,0 +1,86 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// misc.cpp: Rcpp R/C++ interface class library -- misc 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 ;
+using namespace std;
+
+class simple {
+    Rcpp::Dimension dd;
+public:
+    simple(SEXP xp) : dd(xp) {}
+    int nrow() const { return dd[0]; }
+    int ncol() const { return dd[1]; }
+};
+
+// [[Rcpp::export]]
+SEXP symbol_(){
+    return LogicalVector::create( 
+        Symbol( Rf_install("foobar") ).asSexp() == Rf_install("foobar"), 
+        Symbol( Rf_mkChar("foobar") ).asSexp() == Rf_install("foobar"), 
+        Symbol( Rf_mkString("foobar") ).asSexp() == Rf_install("foobar"), 
+        Symbol( "foobar" ).asSexp() == Rf_install("foobar") 
+    ) ;
+}
+
+// [[Rcpp::export]]
+Symbol symbol_ctor(SEXP x){ return Symbol(x); }
+
+// [[Rcpp::export]]
+List Argument_(){
+    Argument x("x"), y("y");
+    return List::create( x = 2, y = 3 );
+}
+
+// [[Rcpp::export]]
+int Dimension_const( SEXP ia ){
+    simple ss(ia);
+	return ss.nrow();
+}
+
+// [[Rcpp::export]] 
+SEXP evaluator_error(){
+    return Rcpp::Evaluator::run( Rf_lang2( Rf_install("stop"), Rf_mkString( "boom" ) ) ) ;
+}
+
+// [[Rcpp::export]]
+SEXP evaluator_ok(SEXP x){
+    return Rcpp::Evaluator::run( Rf_lang2( Rf_install("sample"), x ) ) ;
+}
+
+// [[Rcpp::export]]
+void exceptions_(){
+    throw std::range_error("boom") ;
+}
+
+// [[Rcpp::export]]
+LogicalVector has_iterator_( ){
+    return LogicalVector::create( 
+        (bool)Rcpp::traits::has_iterator< std::vector<int> >::value, 
+        (bool)Rcpp::traits::has_iterator< std::list<int> >::value, 
+        (bool)Rcpp::traits::has_iterator< std::deque<int> >::value, 
+        (bool)Rcpp::traits::has_iterator< std::set<int> >::value, 
+        (bool)Rcpp::traits::has_iterator< std::map<std::string,int> >::value, 
+        (bool)Rcpp::traits::has_iterator< std::pair<std::string,int> >::value, 
+        (bool)Rcpp::traits::has_iterator< Rcpp::Symbol >::value 
+        );
+}
+

Modified: pkg/Rcpp/inst/unitTests/runit.misc.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.misc.R	2013-07-02 08:35:37 UTC (rev 4377)
+++ pkg/Rcpp/inst/unitTests/runit.misc.R	2013-07-02 09:00:31 UTC (rev 4378)
@@ -1,6 +1,6 @@
 #!/usr/bin/r -t
 #
-# Copyright (C) 2010 - 2012  Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2013  Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -21,102 +21,10 @@
 
 if (.runThisTest) {
 
-definitions <- function(){
-    list(
-        	"symbol_" = list(
-        		signature(),
-        		'
-				SEXP res = PROTECT( Rf_allocVector( LGLSXP, 4) ) ;
-				/* SYMSXP */
-				LOGICAL(res)[0] = Symbol( Rf_install("foobar") ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
+.setUp <- Rcpp:::unit_test_setup( "misc.cpp" )
 
-				/* CHARSXP */
-				LOGICAL(res)[1] = Symbol( Rf_mkChar("foobar") ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
-
-				/* STRSXP */
-				LOGICAL(res)[2] = Symbol( Rf_mkString("foobar") ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
-
-				/* std::string */
-				LOGICAL(res)[3] = Symbol( "foobar" ).asSexp() == Rf_install("foobar") ? TRUE : FALSE ;
-
-				UNPROTECT(1) ; /* res */
-				return res ;
-				'
-        	),
-        	"symbol_ctor" = list(
-        		signature(x="ANY"),
-        		'return Symbol(x);'
-        	),
-        	"Argument_" = list(
-        		signature(),
-        		'
-				Argument x("x");
-				Argument y("y");
-
-				return List::create( x = 2, y = 3 );
-    			'
-        	),
-        	"Dimension_const" = list(
-        		signature( ia = "integer" ),
-        		'
-				simple ss(ia);
-				return wrap(ss.nrow());
-				'
-        	),
-        	"evaluator_error" = list(
-        		signature(),
-        		'
-				return Rcpp::Evaluator::run( Rf_lang2( Rf_install("stop"), Rf_mkString( "boom" ) ) ) ;
-				'
-        	),
-        	"evaluator_ok" = list(
-        		signature(x="integer"),  '
-				return Rcpp::Evaluator::run( Rf_lang2( Rf_install("sample"), x ) ) ;
-				'
-        	),
-        	"exceptions_" = list(
-        		signature(), '
-				throw std::range_error("boom") ;
-				return R_NilValue ;
-				'
-        	)
-        )
-}
-
-includes <- function(){
-    "
-
-    using namespace std;
-
-	class simple {
-	    Rcpp::Dimension dd;
-	public:
-	    simple(SEXP xp) : dd(xp) {}
-	    int nrow() const { return dd[0]; }
-	    int ncol() const { return dd[1]; }
-	};
-	"
-}
-
-cxxargs <- function() {
-    ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x","")
-}
-
-.setUp <- function() {
-    tests <- ".rcpp.misc"
-    if( ! exists( tests, globalenv() )) {
-        fun <- Rcpp:::compile_unit_tests(
-            definitions(),
-            includes = includes(),
-            cxxargs = cxxargs()
-        )
-        assign( tests, fun, globalenv() )
-    }
-}
-
 test.Symbol <- function(){
-	funx <- .rcpp.misc$symbol_
-	res <- funx()
+	res <- symbol_()
 	checkTrue( res[1L], msg = "Symbol creation - SYMSXP " )
 	checkTrue( res[2L], msg = "Symbol creation - CHARSXP " )
 	checkTrue( res[3L], msg = "Symbol creation - STRSXP " )
@@ -124,44 +32,35 @@
 }
 
 test.Symbol.notcompatible <- function(){
-	funx <- .rcpp.misc$symbol_ctor
-	checkException( funx(funx), msg = "Symbol not compatible with function" )
-	checkException( funx(asNamespace("Rcpp")), msg = "Symbol not compatible with environment" )
-	checkException( funx(1:10), msg = "Symbol not compatible with integer" )
-	checkException( funx(TRUE), msg = "Symbol not compatible with logical" )
-	checkException( funx(1.3), msg = "Symbol not compatible with numeric" )
-	checkException( funx(as.raw(1) ), msg = "Symbol not compatible with raw" )
+	checkException( symbol_ctor(symbol_ctor), msg = "Symbol not compatible with function" )
+	checkException( symbol_ctor(asNamespace("Rcpp")), msg = "Symbol not compatible with environment" )
+	checkException( symbol_ctor(1:10), msg = "Symbol not compatible with integer" )
+	checkException( symbol_ctor(TRUE), msg = "Symbol not compatible with logical" )
+	checkException( symbol_ctor(1.3), msg = "Symbol not compatible with numeric" )
+	checkException( symbol_ctor(as.raw(1) ), msg = "Symbol not compatible with raw" )
 }
 
 
 test.Argument <- function(){
-   funx <- .rcpp.misc$Argument_
-   checkEquals( funx(), list( x = 2L, y = 3L ) , msg = "Argument")
+   checkEquals( Argument_(), list( x = 2L, y = 3L ) , msg = "Argument")
 }
 
 test.Dimension.const <- function(){
-	# from the Rcpp-devel thread
-	# http://article.gmane.org/gmane.comp.lang.r.rcpp/327
-	funx <- .rcpp.misc$Dimension_const
-   checkEquals( funx( c(2L, 2L)) , 2L, msg = "testing const operator[]" )
-
+   checkEquals( Dimension_const( c(2L, 2L)) , 2L, msg = "testing const operator[]" )
 }
 
 test.evaluator.error <- function(){
-   funx <- .rcpp.misc$evaluator_error
-   checkException( funx(), msg = "Evaluator::run( stop() )" )
+   checkException( evaluator_error(), msg = "Evaluator::run( stop() )" )
 }
 
 test.evaluator.ok <- function(){
-	funx <- .rcpp.misc$evaluator_ok
-	checkEquals( sort(funx(1:10)), 1:10, msg = "Evaluator running fine" )
+	checkEquals( sort(evaluator_ok(1:10)), 1:10, msg = "Evaluator running fine" )
 }
 
 test.exceptions <- function(){
 	can.demangle <- Rcpp:::capabilities()[["demangling"]]
 
-	funx <- .rcpp.misc$exceptions_
-	e <- tryCatch(  funx(), "C++Error" = function(e) e )
+	e <- tryCatch(  exceptions_(), "C++Error" = function(e) e )
 	checkTrue( "C++Error" %in% class(e), msg = "exception class C++Error" )
 
 	if( can.demangle ){
@@ -171,47 +70,31 @@
 
 	if( can.demangle ){
 		# same with direct handler
-		e <- tryCatch(  funx(), "std::range_error" = function(e) e )
+		e <- tryCatch(  exceptions_(), "std::range_error" = function(e) e )
 		checkTrue( "C++Error" %in% class(e), msg = "(direct handler) exception class C++Error" )
 		checkTrue( "std::range_error" %in% class(e), msg = "(direct handler) exception class std::range_error" )
 		checkEquals( e$message, "boom", msg = "(direct handler) exception message" )
 	}
 	f <- function(){
-		try( funx(), silent = TRUE)
+		try( exceptions_(), silent = TRUE)
 		"hello world"
 	}
 	checkEquals( f(), "hello world", msg = "life continues after an exception" )
 
 }
 
-
-
 test.has.iterator <- function(){
 
-	classes <- c( "std::vector<int>", "std::list<int>", "std::deque<int>",
-		"std::set<int>", "std::map<std::string,int>",
-		"std::pair<std::string,int>",
-		"Rcpp::Symbol"
-		)
-	code <- lapply( classes, function(.){
-			sprintf( '
-			bool ok = Rcpp::traits::has_iterator< %s >::value ;
-			return wrap(ok) ;
-			', . )
-		} )
-	signatures <- rep( list(signature()), 7 )
-	names( code ) <- names( signatures ) <- sprintf( "runit_has_iterator_%d", 1:7 )
-	fx <- cxxfunction( signatures, code, plugin = "Rcpp" )
+    has_it <- has_iterator_()
+	checkTrue( has_it[1L] , msg = "has_iterator< std::vector<int> >" )
+	checkTrue( has_it[2L] , msg = "has_iterator< std::ist<int> >" )
+	checkTrue( has_it[3L] , msg = "has_iterator< std::deque<int> >" )
+	checkTrue( has_it[4L] , msg = "has_iterator< std::set<int> >" )
+	checkTrue( has_it[5L] , msg = "has_iterator< std::map<string,int> >" )
 
-	checkTrue( fx$runit_has_iterator_1() , msg = "has_iterator< std::vector<int> >" )
-	checkTrue( fx$runit_has_iterator_2() , msg = "has_iterator< std::ist<int> >" )
-	checkTrue( fx$runit_has_iterator_3() , msg = "has_iterator< std::deque<int> >" )
-	checkTrue( fx$runit_has_iterator_4() , msg = "has_iterator< std::set<int> >" )
-	checkTrue( fx$runit_has_iterator_5() , msg = "has_iterator< std::map<string,int> >" )
+	checkTrue( ! has_it[6L] , msg = "has_iterator< std::pair<string,int> >" )
+	checkTrue( ! has_it[7L] , msg = "Rcpp::Symbol" )
 
-	checkTrue( ! fx$runit_has_iterator_6(), msg = "has_iterator< std::pair<string,int> >" )
-	checkTrue( ! fx$runit_has_iterator_7(), msg = "Rcpp::Symbol" )
-
 }
 
 test.AreMacrosDefined <- function(){


From noreply at r-forge.r-project.org  Tue Jul  2 11:11:36 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 11:11:36 +0200 (CEST)
Subject: [Rcpp-commits] r4379 - in pkg/Rcpp/inst/unitTests: . cpp
Message-ID: <20130702091136.58A92184468@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 11:11:35 +0200 (Tue, 02 Jul 2013)
New Revision: 4379

Removed:
   pkg/Rcpp/inst/unitTests/runit.rcout.R
Modified:
   pkg/Rcpp/inst/unitTests/cpp/misc.cpp
   pkg/Rcpp/inst/unitTests/runit.misc.R
Log:
move runit.rcout to runit.misc

Modified: pkg/Rcpp/inst/unitTests/cpp/misc.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/misc.cpp	2013-07-02 09:00:31 UTC (rev 4378)
+++ pkg/Rcpp/inst/unitTests/cpp/misc.cpp	2013-07-02 09:11:35 UTC (rev 4379)
@@ -22,6 +22,8 @@
 #include <Rcpp.h>
 using namespace Rcpp ;
 using namespace std;
+#include <iostream>
+#include <fstream>
 
 class simple {
     Rcpp::Dimension dd;
@@ -84,3 +86,24 @@
         );
 }
 
+// [[Rcpp::export]]
+void test_rcout(std::string tfile, std::string teststring){
+    // define and open testfile
+    std::ofstream testfile(tfile.c_str());
+    
+    // save output buffer of the Rcout stream
+    std::streambuf* Rcout_buffer = Rcout.rdbuf();
+    
+    // redirect ouput into testfile
+    Rcout.rdbuf( testfile.rdbuf() );
+    
+    // write a test string to the file
+    Rcout << teststring << std::endl;
+    
+    // restore old output buffer
+    Rcout.rdbuf(Rcout_buffer);
+    
+    // close testfile
+    testfile.close();
+}
+

Modified: pkg/Rcpp/inst/unitTests/runit.misc.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.misc.R	2013-07-02 09:00:31 UTC (rev 4378)
+++ pkg/Rcpp/inst/unitTests/runit.misc.R	2013-07-02 09:11:35 UTC (rev 4379)
@@ -100,5 +100,22 @@
 test.AreMacrosDefined <- function(){
     checkTrue( Rcpp:::areMacrosDefined( "__cplusplus" ) )    
 }
+    
+test.rcout <- function(){
+    ## define test string that is written to two files
+    teststr <- "First line.\nSecond line."
 
+    rcppfile <- tempfile()
+    rfile <- tempfile()
+    
+    ## write to test_rcpp.txt from Rcpp
+    test_rcout(rcppfile,  teststr )
+    
+    ## write to test_r.txt from R
+    cat( teststr, file=rfile, sep='\n' )
+    
+    ## compare whether the two files have the same data
+    checkEquals( readLines(rcppfile), readLines(rfile), msg="Rcout output")    
 }
+
+}

Deleted: pkg/Rcpp/inst/unitTests/runit.rcout.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.rcout.R	2013-07-02 09:00:31 UTC (rev 4378)
+++ pkg/Rcpp/inst/unitTests/runit.rcout.R	2013-07-02 09:11:35 UTC (rev 4379)
@@ -1,71 +0,0 @@
-#!/usr/bin/r -t
-#
-# Copyright (C) 2011 - 2012  Dirk Eddelbuettel, Romain Francois and Jelmer Ypma
-#
-# 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/>.
-
-.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
-
-if (.runThisTest) {
-
-    test.rcout <- function() {
-
-        src <- '
-        std::string tfile = as<std::string>(tmpfile);
-
-	// define and open testfile
-        std::ofstream testfile(tfile.c_str());
-
-        // save output buffer of the Rcout stream
-        std::streambuf* Rcout_buffer = Rcout.rdbuf();
-
-        // redirect ouput into testfile
-        Rcout.rdbuf( testfile.rdbuf() );
-
-	// write a test string to the file
-        Rcout << as<std::string>( teststring ) << std::endl;
-
-        // restore old output buffer
-        Rcout.rdbuf(Rcout_buffer);
-
-	// close testfile
-	testfile.close();
-
-        return Rcpp::wrap<int>( 0 );
-'
-
-        fun <- cxxfunction(signature(tmpfile="character",
-                                     teststring = "character" ),
-                           includes = "#include <iostream>\n#include <fstream>",
-                           body = src, plugin="Rcpp")
-
-        ## define test string that is written to two files
-        teststr <- "First line.\nSecond line."
-
-        rcppfile <- tempfile()
-        rfile <- tempfile()
-
-        ## write to test_rcpp.txt from Rcpp
-        fun(rcppfile,  teststr )
-
-        ## write to test_r.txt from R
-        cat( teststr, file=rfile, sep='\n' )
-
-        ## compare whether the two files have the same data
-        checkEquals( readLines(rcppfile), readLines(rfile), msg="Rcout output")
-
-    }
-}


From noreply at r-forge.r-project.org  Tue Jul  2 12:23:44 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 12:23:44 +0200 (CEST)
Subject: [Rcpp-commits] r4380 - in pkg/Rcpp: . inst/unitTests
	inst/unitTests/cpp
Message-ID: <20130702102344.E993B1847A9@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 12:23:44 +0200 (Tue, 02 Jul 2013)
New Revision: 4380

Added:
   pkg/Rcpp/inst/unitTests/cpp/wrap.cpp
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.Reference.R
   pkg/Rcpp/inst/unitTests/runit.wrap.R
Log:
using sourceCpp in runit.wrap

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-02 09:11:35 UTC (rev 4379)
+++ pkg/Rcpp/ChangeLog	2013-07-02 10:23:44 UTC (rev 4380)
@@ -4,6 +4,7 @@
         fill_dispatch) for the non trivial case, so it did not work
         * unitTests/runit.Matrix.R: using sourceCpp
         * unitTests/runit.misc.R: using sourceCpp
+        * unitTests/runit.wrap.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/wrap.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/wrap.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/wrap.cpp	2013-07-02 10:23:44 UTC (rev 4380)
@@ -0,0 +1,198 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// wrap.cpp: Rcpp R/C++ interface class library -- wrap 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]]
+IntegerVector map_string_int(){
+    std::map< std::string, int > m ;
+   	m["b"] = 100;
+  	m["a"] = 200;
+  	m["c"] = 300;
+  	return wrap(m);
+}
+
+// [[Rcpp::export]]
+NumericVector map_string_double(){
+    std::map<std::string,double> m ;
+    m["b"] = 100;
+    m["a"] = 200;
+    m["c"] = 300;
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+LogicalVector map_string_bool(){
+    std::map<std::string,bool> m ;
+    m["b"] = true;
+    m["a"] = false;
+    m["c"] = true;
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+RawVector map_string_Rbyte(){
+    std::map<std::string,Rbyte> m ;
+	m["b"] = (Rbyte)0;
+  	m["a"] = (Rbyte)1;
+  	m["c"] = (Rbyte)2;
+  	return wrap(m);
+}
+
+// [[Rcpp::export]]
+CharacterVector map_string_string(){
+    std::map<std::string,std::string> m ;
+    m["b"] = "foo" ;
+    m["a"] = "bar" ;
+    m["c"] = "bling" ;
+  	return wrap(m);
+}
+
+// [[Rcpp::export]]
+List map_string_generic(){
+    std::map< std::string,std::vector<int> > m ;
+    std::vector<int> b; b.push_back(1); b.push_back(2); m["b"] = b;
+    std::vector<int> a; a.push_back(1); a.push_back(2); a.push_back(2); m["a"] = a;
+    std::vector<int> c; c.push_back(1); c.push_back(2); c.push_back(2); c.push_back(2); m["c"] = c;
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+IntegerVector multimap_string_int(){
+    std::multimap< std::string, int > m;
+    m.insert( std::pair<std::string,int>("b", 100));
+    m.insert( std::pair<std::string,int>("a", 200));
+    m.insert( std::pair<std::string,int>("c", 300));
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+NumericVector multimap_string_double(){
+    std::multimap<std::string,double> m ;
+    m.insert( std::pair<std::string,double>("b", 100) );
+    m.insert( std::pair<std::string,double>("a", 200) );
+    m.insert( std::pair<std::string,double>("c", 300) );
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+LogicalVector multimap_string_bool(){
+    std::multimap<std::string,bool> m ;
+    m.insert( std::pair<std::string,bool>("b", true ) ) ;
+    m.insert( std::pair<std::string,bool>("a", false) ) ;
+    m.insert( std::pair<std::string,bool>("c", true ) ) ;
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+RawVector multimap_string_Rbyte(){
+    std::multimap<std::string,Rbyte> m ;
+    m.insert( std::pair<std::string,Rbyte>("b", (Rbyte)0) );
+    m.insert( std::pair<std::string,Rbyte>("a", (Rbyte)1) );
+    m.insert( std::pair<std::string,Rbyte>("c", (Rbyte)2) );
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+CharacterVector multimap_string_string(){
+    std::multimap<std::string,std::string> m ;
+    m.insert( std::pair<std::string,std::string>( "b", "foo"  ) ) ;
+    m.insert( std::pair<std::string,std::string>( "a", "bar"  ) ) ;
+    m.insert( std::pair<std::string,std::string>( "c", "bling") ) ;
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+List multimap_string_generic(){
+    typedef std::pair<std::string,std::vector<int> > _pair ;
+    std::multimap< std::string,std::vector<int> > m ;
+    std::vector<int> b ; b.push_back(1) ; b.push_back(2) ;
+    m.insert( _pair("b", b) );
+    
+    std::vector<int> a ; a.push_back(1) ; a.push_back(2) ; a.push_back(2) ;
+    m.insert( _pair("a", a) );
+    
+    std::vector<int> c ; c.push_back(1) ; c.push_back(2) ; c.push_back(2) ; c.push_back(2) ;
+    m.insert( _pair("c",  c) );
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+SEXP null_const_char(){ const char *p = NULL; return wrap(p); }
+
+// [[Rcpp::export]]
+SEXP nonnull_const_char(){ const char *p = "foo"; return wrap(p) ; }
+
+// [[Rcpp::export]]
+IntegerVector unordered_map_string_int(){
+    RCPP_UNORDERED_MAP< std::string, int > m ;
+    m["b"] = 100;
+    m["a"] = 200;
+    m["c"] = 300;
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+NumericVector unordered_map_string_double(){
+    RCPP_UNORDERED_MAP<std::string,double> m ;
+    m["b"] = 100;
+    m["a"] = 200;
+    m["c"] = 300;
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+LogicalVector unordered_map_string_bool(){
+    RCPP_UNORDERED_MAP<std::string,bool> m ;
+    m["b"] = true;
+    m["a"] = false;
+    m["c"] = true;
+    return wrap(m) ;
+}
+
+// [[Rcpp::export]]
+RawVector unordered_map_string_Rbyte(){
+    RCPP_UNORDERED_MAP<std::string,Rbyte> m ;
+    m["b"] = (Rbyte)0;
+    m["a"] = (Rbyte)1;
+    m["c"] = (Rbyte)2;
+    return wrap(m);
+}
+
+// [[Rcpp::export]]
+CharacterVector unordered_map_string_string(){
+    RCPP_UNORDERED_MAP<std::string,std::string> m ;
+	m["b"] = "foo" ;
+  	m["a"] = "bar" ;
+  	m["c"] = "bling" ;
+  	return wrap(m) ;
+}
+
+// [[Rcpp::export]]
+List unordered_map_string_generic(){
+    RCPP_UNORDERED_MAP< std::string,std::vector<int> > m ;
+    std::vector<int> b; b.push_back(1); b.push_back(2); m["b"] = b ;
+    std::vector<int> a; a.push_back(1); a.push_back(2); a.push_back(2); m["a"] = a;
+    std::vector<int> c; c.push_back(1); c.push_back(2); c.push_back(2); c.push_back(2); m["c"] = c;
+    return wrap(m);
+}
+

Modified: pkg/Rcpp/inst/unitTests/runit.Reference.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Reference.R	2013-07-02 09:11:35 UTC (rev 4379)
+++ pkg/Rcpp/inst/unitTests/runit.Reference.R	2013-07-02 10:23:44 UTC (rev 4380)
@@ -21,12 +21,10 @@
 
 if (.runThisTest) {
 
-.setUp <- function() {
-    sourceCpp(file.path(pathRcppTests, "cpp/Reference.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup( "Reference.cpp" )
 
 test.Reference <- function(){
-    Instrument <-setRefClass(
+    Instrument <- setRefClass(
        Class="Instrument",
        fields=list("id"="character", "description"="character")
     )
@@ -37,5 +35,4 @@
     checkEquals( runit_Reference_getId(instrument), "AAPL", msg = ".field" )
 }
 
-
 }

Modified: pkg/Rcpp/inst/unitTests/runit.wrap.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.wrap.R	2013-07-02 09:11:35 UTC (rev 4379)
+++ pkg/Rcpp/inst/unitTests/runit.wrap.R	2013-07-02 10:23:44 UTC (rev 4380)
@@ -21,342 +21,133 @@
 
 if (.runThisTest) {
 
-definitions <- function(){
+.setUp <- Rcpp:::unit_test_setup( "wrap.cpp" ) 
 
-    f <- list("map_string_int"=list(
-                  signature(),
-                  'std::map< std::string, int > m ;
-   	           m["b"] = 100;
-  	           m["a"] = 200;
-  	           m["c"] = 300;
-  	           return wrap(m);')
-
-                  ,"map_string_double"=list(
-                   signature(),
-                   'std::map<std::string,double> m ;
-	            m["b"] = 100;
-  	            m["a"] = 200;
-  	            m["c"] = 300;
-  	            return wrap(m);')
-
-
-                  ,"map_string_bool"=list(
-                   signature(),
-                   'std::map<std::string,bool> m ;
-	            m["b"] = true;
-  		    m["a"] = false;
-  		    m["c"] = true;
-  	            return wrap(m);')
-
-                  ,"map_string_Rbyte"=list(
-                   signature(),
-                   'std::map<std::string,Rbyte> m ;
-	            m["b"] = (Rbyte)0;
-  	            m["a"] = (Rbyte)1;
-  	            m["c"] = (Rbyte)2;
-  	            return wrap(m);')
-
-                  ,"map_string_string"=list(
-                   signature(),
-                   'std::map<std::string,std::string> m ;
-	            m["b"] = "foo" ;
-  	            m["a"] = "bar" ;
-  	            m["c"] = "bling" ;
-  		    return wrap(m);')
-
-                  ,"map_string_generic"=list(
-                   signature(),
-                   'std::map< std::string,std::vector<int> > m ;
-	            std::vector<int> b; b.push_back(1); b.push_back(2); m["b"] = b;
-  	            std::vector<int> a; a.push_back(1); a.push_back(2); a.push_back(2); m["a"] = a;
-  	            std::vector<int> c; c.push_back(1); c.push_back(2); c.push_back(2); c.push_back(2); m["c"] = c;
-  	            return wrap(m);')
-
-                  ,"multimap_string_int"=list(
-                   signature(),
-                   'std::multimap< std::string, int > m;
- 		    m.insert( std::pair<std::string,int>("b", 100));
-  		    m.insert( std::pair<std::string,int>("a", 200));
-  		    m.insert( std::pair<std::string,int>("c", 300));
-  		    return wrap(m);')
-
-                  ,"multimap_string_double"=list(
-                   signature(),
-                   'std::multimap<std::string,double> m ;
-		    m.insert( std::pair<std::string,double>("b", 100) );
-  		    m.insert( std::pair<std::string,double>("a", 200) );
-  		    m.insert( std::pair<std::string,double>("c", 300) );
-  		    return wrap(m);')
-
-                  ,"multimap_string_bool"=list(
-                   signature(),
-                   'std::multimap<std::string,bool> m ;
-	            m.insert( std::pair<std::string,bool>("b", true ) ) ;
-  	            m.insert( std::pair<std::string,bool>("a", false) ) ;
-  	            m.insert( std::pair<std::string,bool>("c", true ) ) ;
-  	            return wrap(m);')
-
-                  ,"multimap_string_Rbyte"=list(
-                   signature(),
-                   'std::multimap<std::string,Rbyte> m ;
-            	    m.insert( std::pair<std::string,Rbyte>("b", (Rbyte)0) );
-  	            m.insert( std::pair<std::string,Rbyte>("a", (Rbyte)1) );
-  	            m.insert( std::pair<std::string,Rbyte>("c", (Rbyte)2) );
-  	            return wrap(m);')
-
-                  ,"multimap_string_string"=list(
-                   signature(),
-                   'std::multimap<std::string,std::string> m ;
-	            m.insert( std::pair<std::string,std::string>( "b", "foo"  ) ) ;
-  	            m.insert( std::pair<std::string,std::string>( "a", "bar"  ) ) ;
-  	            m.insert( std::pair<std::string,std::string>( "c", "bling") ) ;
-  	            return wrap(m);')
-
-                  ,"multimap_string_generic"=list(
-                   signature(),
-                   'typedef std::pair<std::string,std::vector<int> > _pair ;
-	            std::multimap< std::string,std::vector<int> > m ;
-	            std::vector<int> b ; b.push_back(1) ; b.push_back(2) ;
-	            m.insert( _pair("b", b) );
-
-	            std::vector<int> a ; a.push_back(1) ; a.push_back(2) ; a.push_back(2) ;
-  	            m.insert( _pair("a", a) );
-
-  	            std::vector<int> c ; c.push_back(1) ; c.push_back(2) ; c.push_back(2) ; c.push_back(2) ;
-  	            m.insert( _pair("c",  c) );
-  	            return wrap(m);')
-
-                  ,"null_const_char"=list(
-                   signature(),
-                   'const char *p = NULL;
-  	            return wrap(p);')
-
-                   ,"nonnull_const_char"=list(
-                   signature(),
-                   'const char *p = "foo";
-  	            return wrap(p);')
-
-                  )
-
-
-        ## definition of all the tr1 functions at once, appended to existing list
-        g <- list("unordered_map_string_int"=list(
-                  signature(),
-                  'RCPP_UNORDERED_MAP< std::string, int > m ;
-	           m["b"] = 100;
-  	           m["a"] = 200;
-  	           m["c"] = 300;
-  	           return wrap(m);')
-
-                  ,"unordered_map_string_double"=list(
-                   signature(),
-                   'RCPP_UNORDERED_MAP<std::string,double> m ;
-	            m["b"] = 100;
-  	            m["a"] = 200;
-  	            m["c"] = 300;
-  	            return wrap(m);')
-
-                  ,"unordered_map_string_bool"=list(
-                   signature(),
-                   'RCPP_UNORDERED_MAP<std::string,bool> m ;
-            	    m["b"] = true;
-              	    m["a"] = false;
-              	    m["c"] = true;
-              	    return wrap(m) ;
-	           ')
-
-                  ,"unordered_map_string_Rbyte"=list(
-                   signature(),
-                   'RCPP_UNORDERED_MAP<std::string,Rbyte> m ;
-	            m["b"] = (Rbyte)0;
-  	            m["a"] = (Rbyte)1;
-  	            m["c"] = (Rbyte)2;
-  	            return wrap(m);')
-
-                  ,"unordered_map_string_string"=list(
-                   signature(),
-                   'RCPP_UNORDERED_MAP<std::string,std::string> m ;
-	            m["b"] = "foo" ;
-  	            m["a"] = "bar" ;
-  	            m["c"] = "bling" ;
-  	            return wrap(m) ;
-	           ')
-
-                  ,"unordered_map_string_generic"=list(
-                   signature(),
-                   'RCPP_UNORDERED_MAP< std::string,std::vector<int> > m ;
-	            std::vector<int> b; b.push_back(1); b.push_back(2); m["b"] = b ;
-  	            std::vector<int> a; a.push_back(1); a.push_back(2); a.push_back(2); m["a"] = a;
-  	            std::vector<int> c; c.push_back(1); c.push_back(2); c.push_back(2); c.push_back(2); m["c"] = c;
-  	            return wrap(m);')
-
-                  )
-
-        if (Rcpp:::capabilities()[["tr1 unordered maps"]]) {
-            f <- c(f,g)
-        }
-        f
-}
-
-.setUp <- function() {
-    if( ! exists( ".rcpp.wrap", globalenv() )) {
-       fun <- Rcpp:::compile_unit_tests( definitions() )
-       assign( ".rcpp.wrap", fun, globalenv() )
-    }
-}
-
-
 test.wrap.map.string.int <- function(){
-    fun <- .rcpp.wrap$map_string_int
-    checkEquals(fun(),
+    checkEquals(map_string_int(),
                 c( a = 200L, b = 100L, c = 300L),
                 msg = "wrap( map<string,int>) " )
 }
 
 test.wrap.map.string.double <- function(){
-    fun <- .rcpp.wrap$map_string_double
-    checkEquals(fun(),
+    checkEquals(map_string_double(),
                 c( a = 200, b = 100, c = 300),
                 msg = "wrap( map<string,double>) " )
 }
 
 test.wrap.map.string.bool <- function(){
-    fun <- .rcpp.wrap$map_string_bool
-    checkEquals(fun(),
+    checkEquals(map_string_bool(),
                 c( a = FALSE, b = TRUE, c = TRUE ),
                 msg = "wrap( map<string,bool>) " )
 }
 
 test.wrap.map.string.Rbyte <- function(){
-    fun <- .rcpp.wrap$map_string_Rbyte
-    checkEquals(fun(),
+    checkEquals(map_string_Rbyte(),
                 c( a = as.raw(1), b = as.raw(0), c = as.raw(2) ),
                 msg = "wrap( map<string,Rbyte>) " )
 }
 
 test.wrap.map.string.string <- function(){
-    fun <- .rcpp.wrap$map_string_string
-    checkEquals(fun(),
+    checkEquals(map_string_string(),
                 c( a = "bar", b = "foo", c = "bling" ),
                 msg = "wrap( map<string,string>) " )
 }
 
 test.wrap.map.string.generic <- function(){
-    fun <- .rcpp.wrap$map_string_generic
-    checkEquals(fun(),
+    checkEquals(map_string_generic(),
                 list( a = c(1L, 2L, 2L), b = c(1L, 2L), c = c(1L,2L,2L,2L) ) ,
 		msg = "wrap( map<string,vector<int>>) " )
 }
 
 test.wrap.multimap.string.int <- function(){
-    fun <- .rcpp.wrap$multimap_string_int
-    checkEquals(fun(),
+    checkEquals(multimap_string_int(),
                 c( a = 200L, b = 100L, c = 300L),
 		msg = "wrap( multimap<string,int>) ")
 }
 
 test.wrap.multimap.string.double <- function(){
-    fun <- .rcpp.wrap$multimap_string_double
-    checkEquals(fun(),
+    checkEquals(multimap_string_double(),
                 c( a = 200, b = 100, c = 300),
 		msg = "wrap( multimap<string,double>) " )
 }
 
 test.wrap.multimap.string.bool <- function(){
-    fun <- .rcpp.wrap$multimap_string_bool
-    checkEquals(fun(),
+    checkEquals(multimap_string_bool(),
                 c( a = FALSE, b = TRUE, c = TRUE ),
 		msg = "wrap( multimap<string,bool>)")
 }
 
 test.wrap.multimap.string.Rbyte <- function(){
-    fun <- .rcpp.wrap$multimap_string_Rbyte
-    checkEquals(fun(),
+    checkEquals(multimap_string_Rbyte(),
                 c( a = as.raw(1), b = as.raw(0), c = as.raw(2) ),
 		msg = "wrap( multimap<string,Rbyte>) " )
 }
 
 test.wrap.multimap.string.string <- function(){
-    fun <- .rcpp.wrap$multimap_string_string
-    checkEquals(fun(),
+    checkEquals(multimap_string_string(),
                 c( a = "bar", b = "foo", c = "bling" ),
 		msg = "wrap( multimap<string,string>) " )
 }
 
 test.wrap.multimap.string.generic <- function(){
-    fun <- .rcpp.wrap$multimap_string_generic
-    checkEquals(fun(),
+    checkEquals(multimap_string_generic(),
                 list( a = c(1L, 2L, 2L), b = c(1L, 2L), c = c(1L,2L,2L,2L) ) ,
 		msg = "wrap( multimap<string,vector<int>>) " )
 }
 
 test.null.const.char <- function() {
-    fun <- .rcpp.wrap$null_const_char
-    checkEquals(fun(),
+    checkEquals(null_const_char(),
                 NULL,
                 msg = "null const char*")
 }
 
 test.nonnull.const.char <- function() {
-    fun <- .rcpp.wrap$nonnull_const_char
-    checkEquals(fun(),
+    checkEquals(nonnull_const_char(),
                 "foo",
                 msg = "null const char*")
 }
 
-## tr1::unordered_map
-if (Rcpp:::capabilities()[["tr1 unordered maps"]]) {
+test.wrap.unordered.map.string.int <- function(){
+    res <- unordered_map_string_int()
+    checkEquals( res[["a"]], 200L,  msg = "wrap( tr1::unordered_map<string,int>) " )
+    checkEquals( res[["b"]], 100L,  msg = "wrap( tr1::unordered_map<string,int>) " )
+    checkEquals( res[["c"]], 300L,  msg = "wrap( tr1::unordered_map<string,int>) " )
+}
 
-    test.wrap.unordered.map.string.int <- function(){
-        fun <- .rcpp.wrap$unordered_map_string_int
-        res <- fun()
-        checkEquals( res[["a"]], 200L,  msg = "wrap( tr1::unordered_map<string,int>) " )
-        checkEquals( res[["b"]], 100L,  msg = "wrap( tr1::unordered_map<string,int>) " )
-        checkEquals( res[["c"]], 300L,  msg = "wrap( tr1::unordered_map<string,int>) " )
-    }
+test.wrap.unordered.map.string.double <- function(){
+    res <- unordered_map_string_double()
+    checkEquals( res[["a"]], 200,  msg = "wrap( tr1::unordered_map<string,double>) " )
+    checkEquals( res[["b"]], 100,  msg = "wrap( tr1::unordered_map<string,double>) " )
+    checkEquals( res[["c"]], 300,  msg = "wrap( tr1::unordered_map<string,double>) " )
+}
 
-    test.wrap.unordered.map.string.double <- function(){
-        fun <- .rcpp.wrap$unordered_map_string_double
-        res <- fun()
-        checkEquals( res[["a"]], 200,  msg = "wrap( tr1::unordered_map<string,double>) " )
-        checkEquals( res[["b"]], 100,  msg = "wrap( tr1::unordered_map<string,double>) " )
-        checkEquals( res[["c"]], 300,  msg = "wrap( tr1::unordered_map<string,double>) " )
-    }
+test.wrap.unordered.map.string.bool <- function(){
+    res <- unordered_map_string_bool()
+    checkEquals( res[["a"]], FALSE,  msg = "wrap( tr1::unordered_map<string,bool>) " )
+    checkEquals( res[["b"]], TRUE ,  msg = "wrap( tr1::unordered_map<string,bool>) " )
+    checkEquals( res[["c"]], TRUE ,  msg = "wrap( tr1::unordered_map<string,bool>) " )
+}
 
-    test.wrap.unordered.map.string.bool <- function(){
-        fun <- .rcpp.wrap$unordered_map_string_bool
-        res <- fun()
-        checkEquals( res[["a"]], FALSE,  msg = "wrap( tr1::unordered_map<string,bool>) " )
-        checkEquals( res[["b"]], TRUE ,  msg = "wrap( tr1::unordered_map<string,bool>) " )
-        checkEquals( res[["c"]], TRUE ,  msg = "wrap( tr1::unordered_map<string,bool>) " )
-    }
+test.wrap.unordered.map.string.Rbyte <- function(){
+    res <- unordered_map_string_Rbyte()
+    checkEquals( res[["a"]], as.raw(1),  msg = "wrap( tr1::unordered_map<string,Rbyte>) " )
+    checkEquals( res[["b"]], as.raw(0),  msg = "wrap( tr1::unordered_map<string,Rbyte>) " )
+    checkEquals( res[["c"]], as.raw(2),  msg = "wrap( tr1::unordered_map<string,Rbyte>) " )
+}
 
-    test.wrap.unordered.map.string.Rbyte <- function(){
-        fun <- .rcpp.wrap$unordered_map_string_Rbyte
-        res <- fun()
-        checkEquals( res[["a"]], as.raw(1),  msg = "wrap( tr1::unordered_map<string,Rbyte>) " )
-        checkEquals( res[["b"]], as.raw(0),  msg = "wrap( tr1::unordered_map<string,Rbyte>) " )
-        checkEquals( res[["c"]], as.raw(2),  msg = "wrap( tr1::unordered_map<string,Rbyte>) " )
-    }
+test.wrap.unordered.map.string.string <- function(){
+    res <- unordered_map_string_string()
+    checkEquals( res[["a"]], "bar"   ,  msg = "wrap( tr1::unordered_map<string,string>) " )
+    checkEquals( res[["b"]], "foo"   ,  msg = "wrap( tr1::unordered_map<string,string>) " )
+    checkEquals( res[["c"]], "bling" ,  msg = "wrap( tr1::unordered_map<string,string>) " )
+}
 
-    test.wrap.unordered.map.string.string <- function(){
-        fun <- .rcpp.wrap$unordered_map_string_string
-        res <- fun()
-        checkEquals( res[["a"]], "bar"   ,  msg = "wrap( tr1::unordered_map<string,string>) " )
-        checkEquals( res[["b"]], "foo"   ,  msg = "wrap( tr1::unordered_map<string,string>) " )
-        checkEquals( res[["c"]], "bling" ,  msg = "wrap( tr1::unordered_map<string,string>) " )
-    }
+test.wrap.unordered.map.string.generic <- function(){
+    res <- unordered_map_string_generic()
+    checkEquals( res[["a"]], c(1L,2L,2L) ,  msg = "wrap( tr1::unordered_map<string,vector<int>>) " )
+    checkEquals( res[["b"]], c(1L,2L) ,  msg = "wrap( tr1::unordered_map<string,vector<int>>) " )
+    checkEquals( res[["c"]], c(1L,2L,2L,2L) ,  msg = "wrap( tr1::unordered_map<string,vector<int>>) " )
+}
 
-    test.wrap.unordered.map.string.generic <- function(){
-        fun <- .rcpp.wrap$unordered_map_string_generic
-        res <- fun()
-        checkEquals( res[["a"]], c(1L,2L,2L) ,  msg = "wrap( tr1::unordered_map<string,vector<int>>) " )
-        checkEquals( res[["b"]], c(1L,2L) ,  msg = "wrap( tr1::unordered_map<string,vector<int>>) " )
-        checkEquals( res[["c"]], c(1L,2L,2L,2L) ,  msg = "wrap( tr1::unordered_map<string,vector<int>>) " )
-    }
-
-} # if( Rcpp:::capabilities("tr1 unordered maps") )
-
-
 }
 


From noreply at r-forge.r-project.org  Tue Jul  2 12:49:12 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 12:49:12 +0200 (CEST)
Subject: [Rcpp-commits] r4381 - pkg/Rcpp/inst/unitTests/cpp
Message-ID: <20130702104912.DFF3318473E@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 12:49:12 +0200 (Tue, 02 Jul 2013)
New Revision: 4381

Modified:
   pkg/Rcpp/inst/unitTests/cpp/as.cpp
Log:
typo

Modified: pkg/Rcpp/inst/unitTests/cpp/as.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/as.cpp	2013-07-02 10:23:44 UTC (rev 4380)
+++ pkg/Rcpp/inst/unitTests/cpp/as.cpp	2013-07-02 10:49:12 UTC (rev 4381)
@@ -29,7 +29,7 @@
 double as_double( SEXP x){ return as<double>( x ); }
 
 // [[Rcpp::export]]
-Rbyte as_Rbyte( SEXP x){ return as<Rbyte>( x ); }
+Rbyte as_raw( SEXP x){ return as<Rbyte>( x ); }
 
 // [[Rcpp::export]]
 bool as_bool( SEXP x){ return as<bool>( x ); }


From noreply at r-forge.r-project.org  Tue Jul  2 12:56:35 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 12:56:35 +0200 (CEST)
Subject: [Rcpp-commits] r4382 - in pkg/Rcpp/inst/unitTests: . cpp
Message-ID: <20130702105635.5B30718473E@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 12:56:34 +0200 (Tue, 02 Jul 2013)
New Revision: 4382

Modified:
   pkg/Rcpp/inst/unitTests/cpp/Matrix.cpp
   pkg/Rcpp/inst/unitTests/runit.Matrix.R
Log:
using sourceCpp

Modified: pkg/Rcpp/inst/unitTests/cpp/Matrix.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/Matrix.cpp	2013-07-02 10:49:12 UTC (rev 4381)
+++ pkg/Rcpp/inst/unitTests/cpp/Matrix.cpp	2013-07-02 10:56:34 UTC (rev 4382)
@@ -37,7 +37,7 @@
     for( size_t i=0 ; i<4; i++){
         	trace += m(i,i) ;
     }
-    return wrap( trace ) ;
+    return trace;
 }
 
 // [[Rcpp::export]]
@@ -66,7 +66,7 @@
 
 // [[Rcpp::export]]
 NumericMatrix matrix_numeric_ctor2(){
-    return NumericMatrix m(3,3);
+    return NumericMatrix(3,3);
 }
 
 // [[Rcpp::export]]
@@ -89,7 +89,7 @@
 // [[Rcpp::export]]
 double runit_NumericMatrix_row( NumericMatrix m){
     NumericMatrix::Row first_row = m.row(0) ;
-    return wrap( std::accumulate( first_row.begin(), first_row.end(), 0.0 ) ) ;
+    return std::accumulate( first_row.begin(), first_row.end(), 0.0 ) ;
 }
 
 // [[Rcpp::export]]
@@ -115,7 +115,7 @@
 // [[Rcpp::export]]
 double runit_NumericMatrix_column( NumericMatrix m ){
     NumericMatrix::Column col = m.column(0) ;
-    return wrap( std::accumulate( col.begin(), col.end(), 0.0 ) ) ;
+    return std::accumulate( col.begin(), col.end(), 0.0 ) ;
 }
 
 // [[Rcpp::export]]
@@ -135,9 +135,9 @@
 std::string runit_CharacterMatrix_column( CharacterMatrix m){
     CharacterMatrix::Column col = m.column(0) ;
     std::string res(
-    	std::accumulate(
-    		col.begin(), col.end(), std::string() ) ) ;
-    return wrap(res) ;
+        std::accumulate( col.begin(), col.end(), std::string() )
+    ) ;
+    return res ;
 }
 
 // [[Rcpp::export]]

Modified: pkg/Rcpp/inst/unitTests/runit.Matrix.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Matrix.R	2013-07-02 10:49:12 UTC (rev 4381)
+++ pkg/Rcpp/inst/unitTests/runit.Matrix.R	2013-07-02 10:56:34 UTC (rev 4382)
@@ -23,11 +23,9 @@
 
 .setUp <- Rcpp:::unit_test_setup("Matrix.cpp")
 
-
 test.List.column <- function(){
-	funx <- .rcpp.Matrix$runit_Row_Column_sugar
 	x <- matrix( 1:16+.5, nc = 4 )
-	res <- funx( x )
+	res <- runit_Row_Column_sugar( x )
 	target <- list(
 	    x[1,],
 	    x[,1],
@@ -40,129 +38,107 @@
 }
 
 test.NumericMatrix <- function(){
-	funx <- .rcpp.Matrix$matrix_numeric
 	x <- matrix( 1:16 + .5, ncol = 4 )
-	checkEquals( funx(x), sum(diag(x)), msg = "matrix indexing" )
+	checkEquals( matrix_numeric(x), sum(diag(x)), msg = "matrix indexing" )
 
 	y <- as.vector( x )
-	checkException( funx(y) , msg = "not a matrix" )
+	checkException( matrix_numeric(y) , msg = "not a matrix" )
 
 }
 
 test.CharacterMatrix <- function(){
-	funx <- .rcpp.Matrix$matrix_character
 	x <- matrix( letters[1:16], ncol = 4 )
-	checkEquals( funx(x), paste( diag(x), collapse = "" ) )
+	checkEquals( matrix_character(x), paste( diag(x), collapse = "" ) )
 }
 
 test.GenericMatrix <- function( ){
-	funx <- .rcpp.Matrix$matrix_generic
 	g <- function(y){
 		sapply( y, function(x) seq(from=x, to = 16) )
 	}
 	x <- matrix( g(1:16), ncol = 4 )
-	checkEquals( funx(x), g(diag(matrix(1:16,ncol=4))), msg = "GenericMatrix" )
+	checkEquals( matrix_generic(x), g(diag(matrix(1:16,ncol=4))), msg = "GenericMatrix" )
 }
 
 test.IntegerMatrix.diag <- function(){
-	funx <- .rcpp.Matrix$matrix_integer_diag
 	expected <- matrix( 0L, nrow = 5, ncol = 5 )
 	diag( expected ) <- 1L
-	checkEquals( funx(), expected, msg = "IntegerMatrix::diag" )
+	checkEquals( matrix_integer_diag(), expected, msg = "IntegerMatrix::diag" )
 }
 
 test.CharacterMatrix.diag <- function(){
-	funx <- .rcpp.Matrix$matrix_character_diag
 	expected <- matrix( "", nrow = 5, ncol = 5 )
 	diag( expected ) <- "foo"
-	checkEquals( funx(), expected, msg = "CharacterMatrix::diag" )
+	checkEquals( matrix_character_diag(), expected, msg = "CharacterMatrix::diag" )
 }
 
 test.NumericMatrix.Ctors <- function(){
-	funx <- .rcpp.Matrix$matrix_numeric_ctor1
 	x <- matrix(0, 3, 3)
-	checkEquals( funx(), x, msg = "matrix from single int" )
+	checkEquals( matrix_numeric_ctor1(), x, msg = "matrix from single int" )
 
-	funx <- .rcpp.Matrix$matrix_numeric_ctor2
 	x <- matrix(0, 3, 3)
-	checkEquals( funx(), x, msg = "matrix from two int" )
+	checkEquals( matrix_numeric_ctor2(), x, msg = "matrix from two int" )
 }
 
 test.IntegerVector.matrix.indexing <- function(){
-    fun <- .rcpp.Matrix$integer_matrix_indexing
     x <- matrix( 1:16, ncol = 4 )
-    checkEquals( fun(x), sum(diag(x)), msg = "matrix indexing" )
+    checkEquals( integer_matrix_indexing(x), sum(diag(x)), msg = "matrix indexing" )
 
-    fun <- .rcpp.Matrix$integer_matrix_indexing_lhs
-    checkEquals( diag(fun(x)), 2*0:3, msg = "matrix indexing lhs" )
+    checkEquals( diag(integer_matrix_indexing_lhs(x)), 2*0:3, msg = "matrix indexing lhs" )
 
     y <- as.vector( x )
-    checkException( fun(y) , msg = "not a matrix" )
+    checkException( integer_matrix_indexing_lhs(y) , msg = "not a matrix" )
 }
 
-
-
 test.NumericMatrix.row <- function(){
-	funx <- .rcpp.Matrix$runit_NumericMatrix_row
 	x <- matrix( 1:16 + .5, ncol = 4 )
-	checkEquals( funx( x ), sum( x[1,] ), msg = "iterating over a row" )
+	checkEquals( runit_NumericMatrix_row( x ), sum( x[1,] ), msg = "iterating over a row" )
 }
 
 test.CharacterMatrix.row <- function(){
-	funx <- .rcpp.Matrix$runit_CharacterMatrix_row
 	m <- matrix( letters, ncol = 2 )
-	checkEquals( funx(m), paste( m[1,], collapse = "" ), msg = "CharacterVector::Row" )
+	checkEquals( runit_CharacterMatrix_row(m), paste( m[1,], collapse = "" ), msg = "CharacterVector::Row" )
 }
 
 test.List.row <- function(){
-	funx <- .rcpp.Matrix$runit_GenericMatrix_row
 	m <- lapply( 1:16, function(i) seq(from=1, to = i ) )
 	dim( m ) <- c( 4, 4 )
-	checkEquals( funx( m ), 1 + 0:3*4, msg = "List::Row" )
-
+	checkEquals( runit_GenericMatrix_row( m ), 1 + 0:3*4, msg = "List::Row" )
 }
 
 test.NumericMatrix.column <- function(){
-	funx <- .rcpp.Matrix$runit_NumericMatrix_column
 	x <- matrix( 1:16 + .5, ncol = 4 )
-	checkEquals( funx( x ), sum( x[,1] ) , msg = "iterating over a column" )
+	checkEquals( runit_NumericMatrix_column( x ), sum( x[,1] ) , msg = "iterating over a column" )
 }
 
 test.NumericMatrix.cumsum <- function(){
-	funx <- .rcpp.Matrix$runit_NumericMatrix_cumsum
 	x <- matrix( 1:8 + .5, ncol = 2 )
-	checkEquals( funx( x ), t(apply(x, 1, cumsum)) , msg = "cumsum" )
+	checkEquals( runit_NumericMatrix_cumsum( x ), t(apply(x, 1, cumsum)) , msg = "cumsum" )
 }
 
 test.CharacterMatrix.column <- function(){
-	funx <- .rcpp.Matrix$runit_CharacterMatrix_column
 	m <- matrix( letters, ncol = 2 )
-	checkEquals( funx(m), paste( m[,1], collapse = "" ), msg = "CharacterVector::Column" )
+	checkEquals( runit_CharacterMatrix_column(m), paste( m[,1], collapse = "" ), msg = "CharacterVector::Column" )
 }
 
 test.List.column <- function(){
-	funx <- .rcpp.Matrix$runit_GenericMatrix_column
 	m <- lapply( 1:16, function(i) seq(from=1, to = i ) )
 	dim( m ) <- c( 4, 4 )
-	checkEquals( funx( m ), 1:4, msg = "List::Column" )
+	checkEquals( runit_GenericMatrix_column( m ), 1:4, msg = "List::Column" )
 }
 
 test.NumericMatrix.colsum <- function( ){
-    funx <- .rcpp.Matrix$runit_NumericMatrix_colsum
     probs <- matrix(1:12,nrow=3)
-    checkEquals( funx( probs ), t(apply(probs,1,cumsum)) )
+    checkEquals( runit_NumericMatrix_colsum( probs ), t(apply(probs,1,cumsum)) )
 }
 
 test.NumericMatrix.rowsum <- function( ){
-    funx <- .rcpp.Matrix$runit_NumericMatrix_rowsum
     probs <- matrix(1:12,nrow=3)
-    checkEquals( funx( probs ), apply(probs,2,cumsum) )
+    checkEquals( runit_NumericMatrix_rowsum( probs ), apply(probs,2,cumsum) )
 }
 
 test.NumericMatrix.SubMatrix <- function( ){
-    funx <- .rcpp.Matrix$runit_SubMatrix
     target <- rbind( c(3,4,5,5), c(3,4,5,5), 0 )
-    checkEquals( funx(), target, msg = "SubMatrix" )
+    checkEquals( runit_SubMatrix(), target, msg = "SubMatrix" )
 }
 
 


From noreply at r-forge.r-project.org  Tue Jul  2 16:45:24 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 16:45:24 +0200 (CEST)
Subject: [Rcpp-commits] r4383 - in pkg/Rcpp: . inst inst/unitTests
	inst/unitTests/cpp man src
Message-ID: <20130702144524.5E036184E39@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 16:45:24 +0200 (Tue, 02 Jul 2013)
New Revision: 4383

Added:
   pkg/Rcpp/inst/unitTests/cpp/support.cpp
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/NEWS.Rd
   pkg/Rcpp/inst/unitTests/runit.Module.R
   pkg/Rcpp/inst/unitTests/runit.support.R
   pkg/Rcpp/man/sourceCpp.Rd
   pkg/Rcpp/src/attributes.cpp
Log:
populate the environment with the module content

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-02 10:56:34 UTC (rev 4382)
+++ pkg/Rcpp/ChangeLog	2013-07-02 14:45:24 UTC (rev 4383)
@@ -5,6 +5,7 @@
         * unitTests/runit.Matrix.R: using sourceCpp
         * unitTests/runit.misc.R: using sourceCpp
         * unitTests/runit.wrap.R: using sourceCpp
+        * unitTests/runit.support.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&>
@@ -12,6 +13,9 @@
         * include/Rcpp/as.h: as<T&> and as<const T&> when T is module exposed
         * include/Rcpp/module/Module_generated_CppFunction.h: removed the 
         remove_const_and_reference since as<T&> and as<const T&> is supported
+        * src/attributes.cpp: automatically populating the environment with 
+        the content of a module, rather than make the module object available
+        in the environment
 
 2013-07-01  Romain Francois <romain at r-enthusiasts.com>
 

Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd	2013-07-02 10:56:34 UTC (rev 4382)
+++ pkg/Rcpp/inst/NEWS.Rd	2013-07-02 14:45:24 UTC (rev 4383)
@@ -14,6 +14,14 @@
       T is a class exposed by modules, i.e. with \code{RCPP_EXPOSED_CLASS}
     }
 
+    \item Changes in Attributes:
+    \itemize{
+        \item Objects exported by a module (i.e. by a \code{RCPP_MODULE} call
+        in a file that is processed by \code{sourceCpp}) are now ditectly 
+        available in the environment. We used to make the module object
+        available, which was less useful. 
+    }
+
     \item Changes in Modules:
     \itemize{
       \item We can now expose functions and methods that take

Added: pkg/Rcpp/inst/unitTests/cpp/support.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/support.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/support.cpp	2013-07-02 14:45:24 UTC (rev 4383)
@@ -0,0 +1,94 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// support.cpp: Rcpp R/C++ interface class library -- 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]]
+List plus_REALSXP(){
+    return List::create(
+        NA_REAL + NA_REAL,
+        NA_REAL + 1.0,
+        1.0 + NA_REAL
+    );
+}
+
+// [[Rcpp::export]]
+List times_REALSXP(){
+    return List::create(
+        NA_REAL * NA_REAL,
+        NA_REAL * 1.0,
+        1.0 * NA_REAL
+    );
+}
+
+// [[Rcpp::export]]
+List divides_REALSXP(){
+    return List::create(
+       NA_REAL / NA_REAL,
+       NA_REAL / 1.0,
+       1.0 / NA_REAL
+       );
+}
+
+// [[Rcpp::export]]
+List minus_REALSXP(){
+    return List::create(
+       NA_REAL - NA_REAL,
+       NA_REAL - 1.0,
+       1.0 - NA_REAL
+       );
+}
+
+// [[Rcpp::export]]
+List functions_REALSXP(){
+    return List::create(
+        NumericVector::create(
+           exp( NA_REAL ),
+           acos( NA_REAL ),
+           asin( NA_REAL ),
+           atan( NA_REAL ),
+           ceil( NA_REAL ),
+           cos( NA_REAL ),
+           cosh( NA_REAL ),
+           floor( NA_REAL ),
+           log( NA_REAL ),
+           log10( NA_REAL ),
+           sqrt( NA_REAL),
+           sin( NA_REAL ),
+           sinh( NA_REAL ),
+           tan( NA_REAL ),
+           tanh( NA_REAL ),
+           fabs( NA_REAL ),
+           Rf_gammafn( NA_REAL),
+           Rf_lgammafn( NA_REAL ),
+           Rf_digamma( NA_REAL ),
+           Rf_trigamma( NA_REAL )
+        ) , NumericVector::create(
+           Rf_tetragamma( NA_REAL) ,
+           Rf_pentagamma( NA_REAL) ,
+           expm1( NA_REAL ),
+           log1p( NA_REAL ),
+           Rcpp::internal::factorial( NA_REAL ),
+           Rcpp::internal::lfactorial( NA_REAL )
+        )
+     );
+}

Modified: pkg/Rcpp/inst/unitTests/runit.Module.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Module.R	2013-07-02 10:56:34 UTC (rev 4382)
+++ pkg/Rcpp/inst/unitTests/runit.Module.R	2013-07-02 14:45:24 UTC (rev 4383)
@@ -22,8 +22,8 @@
 	gc()
 }
 
-# .runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
-.runThisTest <- FALSE 
+.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
+# .runThisTest <- FALSE 
 
 if( .runThisTest && Rcpp:::capabilities()[["Rcpp modules"]] ) {
 

Modified: pkg/Rcpp/inst/unitTests/runit.support.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.support.R	2013-07-02 10:56:34 UTC (rev 4382)
+++ pkg/Rcpp/inst/unitTests/runit.support.R	2013-07-02 14:45:24 UTC (rev 4383)
@@ -21,128 +21,39 @@
 
 if (.runThisTest) {
 
-definitions <- function() {
-    list(
-    "plus_REALSXP"=list(
-         signature(),
-         '
-         return List::create(
-           NA_REAL + NA_REAL,
-           NA_REAL + 1.0,
-           1.0 + NA_REAL
-           );
-         '),
-    "times_REALSXP" = list(
-       signature(),
-       '
-        return List::create(
-           NA_REAL * NA_REAL,
-           NA_REAL * 1.0,
-           1.0 * NA_REAL
-           );
-       '),
-     "divides_REALSXP" = list(
-        signature(),
-        '
-        return List::create(
-           NA_REAL / NA_REAL,
-           NA_REAL / 1.0,
-           1.0 / NA_REAL
-           );
-        '
-     ),
-     "minus_REALSXP" = list(
-        signature(),
-        '
-        return List::create(
-           NA_REAL - NA_REAL,
-           NA_REAL - 1.0,
-           1.0 - NA_REAL
-           );
-        '
-     ),
-     "functions_REALSXP" = list(
-        signature(),
-        '
-        return List::create(
-            NumericVector::create(
-               exp( NA_REAL ),
-               acos( NA_REAL ),
-               asin( NA_REAL ),
-               atan( NA_REAL ),
-               ceil( NA_REAL ),
-               cos( NA_REAL ),
-               cosh( NA_REAL ),
-               floor( NA_REAL ),
-               log( NA_REAL ),
-               log10( NA_REAL ),
-               sqrt( NA_REAL),
-               sin( NA_REAL ),
-               sinh( NA_REAL ),
-               tan( NA_REAL ),
-               tanh( NA_REAL ),
-               fabs( NA_REAL ),
-               Rf_gammafn( NA_REAL),
-               Rf_lgammafn( NA_REAL ),
-               Rf_digamma( NA_REAL ),
-               Rf_trigamma( NA_REAL )
-            ) , NumericVector::create(
-               Rf_tetragamma( NA_REAL) ,
-               Rf_pentagamma( NA_REAL) ,
-               expm1( NA_REAL ),
-               log1p( NA_REAL ),
-               Rcpp::internal::factorial( NA_REAL ),
-               Rcpp::internal::lfactorial( NA_REAL )
-            )
-         );
-        '
-     )
-    )
-}
-.setUp <- function() {
-    tests <- ".rcpp.support"
-    if( ! exists( tests, globalenv() )) {
-        fun <- Rcpp:::compile_unit_tests(definitions())
-        assign( tests, fun, globalenv() )
-    }
-}
+.setUp <- Rcpp:::unit_test_setup( "support.cpp" )
 
 test.plus.REALSXP <- function(){
-    fun <- .rcpp.support$plus_REALSXP
     checkEquals(
-        fun(),
+        plus_REALSXP(),
         list(NA_real_,NA_real_,NA_real_) ,
         msg = " REALSXP + REALSXP" )
 }
 
 test.times.REALSXP <- function(){
-    fun <- .rcpp.support$times_REALSXP
     checkEquals(
-        fun(),
+        times_REALSXP(),
         list(NA_real_,NA_real_,NA_real_) ,
         msg = " REALSXP * REALSXP" )
 }
 
 test.divides.REALSXP <- function(){
-    fun <- .rcpp.support$divides_REALSXP
     checkEquals(
-        fun(),
+        divides_REALSXP(),
         list(NA_real_,NA_real_,NA_real_) ,
         msg = " REALSXP / REALSXP" )
 }
 
 test.minus.REALSXP <- function(){
-    fun <- .rcpp.support$minus_REALSXP
     checkEquals(
-        fun(),
+        minus_REALSXP(),
         list(NA_real_,NA_real_,NA_real_) ,
         msg = " REALSXP - REALSXP" )
 }
 
 test.functions.REALSXP <- function(){
-    fun <- .rcpp.support$functions_REALSXP
     checkEquals(
-        fun(),
+        functions_REALSXP(),
         list( rep(NA_real_, 20L), rep(NA_real_, 6L) ) ,
         msg = "function(NA_REAL)" )
 }

Modified: pkg/Rcpp/man/sourceCpp.Rd
===================================================================
--- pkg/Rcpp/man/sourceCpp.Rd	2013-07-02 10:56:34 UTC (rev 4382)
+++ pkg/Rcpp/man/sourceCpp.Rd	2013-07-02 14:45:24 UTC (rev 4383)
@@ -12,7 +12,6 @@
           rebuild = FALSE, showOutput = verbose, 
           verbose = getOption("verbose"))
 }
-%- maybe also 'usage' for other objects documented here.
 \arguments{
   \item{file}{
     A character string giving the path name of a file
@@ -36,13 +35,24 @@
 \details{
     If the \code{code} parameter is provided then the \code{file} parameter is ignored.
 
-    Functions exported using \code{sourceCpp} must meet several conditions, including being defined in the global namespace and having return types that are compatible with \code{Rcpp::wrap} and parameter types that are compatible with \code{Rcpp::as}. See the \code{\link[=exportAttribute]{Rcpp::export}} documentation for more details.
+    Functions exported using \code{sourceCpp} must meet several conditions, 
+    including being defined in the global namespace and having return types 
+    that are compatible with \code{Rcpp::wrap} and parameter types that are 
+    compatible with \code{Rcpp::as}. 
+    See the \code{\link[=exportAttribute]{Rcpp::export}} documentation for more details.
     
-    Rcpp Modules will be automatically loaded into the specified environment using the \code{\link[=Module]{Module}} function. the name of the loaded module object will be the same as the name specified in the \code{RCPP_MODULE} declaration.
+    Content of Rcpp Modules will be automatically loaded into the specified 
+    environment using the \code{\link[=Module]{Module}} and 
+    \code{\link[=populate]{populate}} functions. 
     
-    If the source file has compilation dependencies on other packages (e.g. \pkg{Matrix}, \pkg{RcppArmadillo}) then an \code{\link[=dependsAttribute]{Rcpp::depends}} attribute should be provided naming these dependencies. 
+    If the source file has compilation dependencies on other 
+    packages (e.g. \pkg{Matrix}, \pkg{RcppArmadillo}) then an 
+    \code{\link[=dependsAttribute]{Rcpp::depends}} attribute 
+    should be provided naming these dependencies. 
     
-	It's possible to embed chunks of R code within a C++ source file by including the R code within a block comment with the prefix of \code{/*** R}. For example:
+	It's possible to embed chunks of R code within a C++ source file by 
+	including the R code within a block comment with the 
+	prefix of \code{/*** R}. For example:
     
 \preformatted{
 /*** R

Modified: pkg/Rcpp/src/attributes.cpp
===================================================================
--- pkg/Rcpp/src/attributes.cpp	2013-07-02 10:56:34 UTC (rev 4382)
+++ pkg/Rcpp/src/attributes.cpp	2013-07-02 14:45:24 UTC (rev 4383)
@@ -2550,8 +2550,8 @@
                 for (std::vector<std::string>::const_iterator 
                     it = modules.begin(); it != modules.end(); ++it)
                 {
-                    ostr << *it << " <- Rcpp::Module(\"" << *it << "\"," 
-                         << dllInfo << ")" << std::endl;
+                    ostr << " populate( Rcpp::Module(\"" << *it << "\"," 
+                         << dllInfo << "), environment() ) " << std::endl;
                 }
             }
                            


From noreply at r-forge.r-project.org  Tue Jul  2 17:41:13 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 17:41:13 +0200 (CEST)
Subject: [Rcpp-commits] r4384 - in pkg/Rcpp: . inst/unitTests
	inst/unitTests/cpp
Message-ID: <20130702154113.7C9E6183263@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 17:41:13 +0200 (Tue, 02 Jul 2013)
New Revision: 4384

Added:
   pkg/Rcpp/inst/unitTests/cpp/rmath.cpp
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.rmath.R
Log:
using sourceCpp in runit.rmath

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-02 14:45:24 UTC (rev 4383)
+++ pkg/Rcpp/ChangeLog	2013-07-02 15:41:13 UTC (rev 4384)
@@ -6,6 +6,7 @@
         * unitTests/runit.misc.R: using sourceCpp
         * unitTests/runit.wrap.R: using sourceCpp
         * unitTests/runit.support.R: using sourceCpp
+        * unitTests/runit.rmath.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/rmath.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/rmath.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/rmath.cpp	2013-07-02 15:41:13 UTC (rev 4384)
@@ -0,0 +1,398 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// rmath.cpp: Rcpp R/C++ interface class library -- rmath 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]]
+NumericVector runit_dnorm( double x, double a, double b ){
+	     return NumericVector::create(R::dnorm(x, a, b, 0), R::dnorm(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pnorm( double x, double a, double b ){
+	     return NumericVector::create(R::pnorm(x, a, b, 1, 0), R::pnorm(log(x), a, b, 1, 1),
+                                          R::pnorm(x, a, b, 0, 0), R::pnorm(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qnorm( double x, double a, double b ){
+	     return NumericVector::create(R::qnorm(x, a, b, 1, 0), R::qnorm(log(x), a, b, 1, 1),
+                                          R::qnorm(x, a, b, 0, 0), R::qnorm(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dunif( double x, double a, double b ){
+	     return NumericVector::create(R::dunif(x, a, b, 0), R::dunif(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_punif( double x, double a, double b ){
+	     return NumericVector::create(R::punif(x, a, b, 1, 0), R::punif(log(x), a, b, 1, 1),
+                                          R::punif(x, a, b, 0, 0), R::punif(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qunif( double x, double a, double b ){
+	     return NumericVector::create(R::qunif(x, a, b, 1, 0), R::qunif(log(x), a, b, 1, 1),
+                                          R::qunif(x, a, b, 0, 0), R::qunif(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dgamma( double x, double a, double b ){
+	     return NumericVector::create(R::dgamma(x, a, b, 0), R::dgamma(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pgamma( double x, double a, double b ){
+	     return NumericVector::create(R::pgamma(x, a, b, 1, 0), R::pgamma(log(x), a, b, 1, 1),
+                                          R::pgamma(x, a, b, 0, 0), R::pgamma(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qgamma( double x, double a, double b ){
+	     return NumericVector::create(R::qgamma(x, a, b, 1, 0), R::qgamma(log(x), a, b, 1, 1),
+                                          R::qgamma(x, a, b, 0, 0), R::qgamma(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dbeta( double x, double a, double b ){
+	     return NumericVector::create(R::dbeta(x, a, b, 0), R::dbeta(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pbeta( double x, double a, double b ){
+	     return NumericVector::create(R::pbeta(x, a, b, 1, 0), R::pbeta(log(x), a, b, 1, 1),
+                                          R::pbeta(x, a, b, 0, 0), R::pbeta(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qbeta( double x, double a, double b ){
+	     return NumericVector::create(R::qbeta(x, a, b, 1, 0), R::qbeta(log(x), a, b, 1, 1),
+                                          R::qbeta(x, a, b, 0, 0), R::qbeta(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dlnorm( double x, double a, double b ){
+	     return NumericVector::create(R::dlnorm(x, a, b, 0), R::dlnorm(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_plnorm( double x, double a, double b ){
+	     return NumericVector::create(R::plnorm(x, a, b, 1, 0), R::plnorm(log(x), a, b, 1, 1),
+                                          R::plnorm(x, a, b, 0, 0), R::plnorm(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qlnorm( double x, double a, double b ){
+	     return NumericVector::create(R::qlnorm(x, a, b, 1, 0), R::qlnorm(log(x), a, b, 1, 1),
+                                          R::qlnorm(x, a, b, 0, 0), R::qlnorm(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dchisq( double x, double a ){
+	     return NumericVector::create(R::dchisq(x, a, 0), R::dchisq(x, a, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pchisq( double x, double a ){
+	     return NumericVector::create(R::pchisq(x, a, 1, 0), R::pchisq(log(x), a, 1, 1),
+                                          R::pchisq(x, a, 0, 0), R::pchisq(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qchisq( double x, double a ){
+	     return NumericVector::create(R::qchisq(x, a, 1, 0), R::qchisq(log(x), a, 1, 1),
+                                          R::qchisq(x, a, 0, 0), R::qchisq(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dnchisq( double x, double a, double b ){
+	     return NumericVector::create(R::dnchisq(x, a, b, 0), R::dnchisq(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pnchisq( double x, double a, double b ){
+	     return NumericVector::create(R::pnchisq(x, a, b, 1, 0), R::pnchisq(log(x), a, b, 1, 1),
+                                          R::pnchisq(x, a, b, 0, 0), R::pnchisq(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qnchisq( double x, double a, double b ){
+	     return NumericVector::create(R::qnchisq(x, a, b, 1, 0), R::qnchisq(log(x), a, b, 1, 1),
+                                          R::qnchisq(x, a, b, 0, 0), R::qnchisq(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_df( double x, double a, double b ){
+	     return NumericVector::create(R::df(x, a, b, 0), R::df(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pf( double x, double a, double b ){
+	     return NumericVector::create(R::pf(x, a, b, 1, 0), R::pf(log(x), a, b, 1, 1),
+                                          R::pf(x, a, b, 0, 0), R::pf(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qf( double x, double a, double b ){
+	     return NumericVector::create(R::qf(x, a, b, 1, 0), R::qf(log(x), a, b, 1, 1),
+                                          R::qf(x, a, b, 0, 0), R::qf(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dt( double x, double a ){
+	     return NumericVector::create(R::dt(x, a, 0), R::dt(x, a, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pt( double x, double a ){
+	     return NumericVector::create(R::pt(x, a, 1, 0), R::pt(log(x), a, 1, 1),
+                                          R::pt(x, a, 0, 0), R::pt(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qt( double x, double a ){
+	     return NumericVector::create(R::qt(x, a, 1, 0), R::qt(log(x), a, 1, 1),
+                                          R::qt(x, a, 0, 0), R::qt(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dbinom( double x, double a, double b ){
+	     return NumericVector::create(R::dbinom(x, a, b, 0), R::dbinom(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pbinom( double x, double a, double b ){
+	     return NumericVector::create(R::pbinom(x, a, b, 1, 0), R::pbinom(log(x), a, b, 1, 1),
+                                          R::pbinom(x, a, b, 0, 0), R::pbinom(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qbinom( double x, double a, double b ){
+	     return NumericVector::create(R::qbinom(x, a, b, 1, 0), R::qbinom(log(x), a, b, 1, 1),
+                                          R::qbinom(x, a, b, 0, 0), R::qbinom(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dcauchy( double x, double a, double b ){
+	     return NumericVector::create(R::dcauchy(x, a, b, 0), R::dcauchy(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pcauchy( double x, double a, double b ){
+	     return NumericVector::create(R::pcauchy(x, a, b, 1, 0), R::pcauchy(log(x), a, b, 1, 1),
+                                          R::pcauchy(x, a, b, 0, 0), R::pcauchy(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qcauchy( double x, double a, double b ){
+	     return NumericVector::create(R::qcauchy(x, a, b, 1, 0), R::qcauchy(log(x), a, b, 1, 1),
+                                          R::qcauchy(x, a, b, 0, 0), R::qcauchy(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dexp( double x, double a ){
+	     return NumericVector::create(R::dexp(x, a, 0), R::dexp(x, a, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pexp( double x, double a ){
+	     return NumericVector::create(R::pexp(x, a, 1, 0), R::pexp(log(x), a, 1, 1),
+                                          R::pexp(x, a, 0, 0), R::pexp(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qexp( double x, double a ){
+	     return NumericVector::create(R::qexp(x, a, 1, 0), R::qexp(log(x), a, 1, 1),
+                                          R::qexp(x, a, 0, 0), R::qexp(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dgeom( double x, double a ){
+	     return NumericVector::create(R::dgeom(x, a, 0), R::dgeom(x, a, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pgeom( double x, double a ){
+	     return NumericVector::create(R::pgeom(x, a, 1, 0), R::pgeom(log(x), a, 1, 1),
+                                          R::pgeom(x, a, 0, 0), R::pgeom(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qgeom( double x, double a ){
+	     return NumericVector::create(R::qgeom(x, a, 1, 0), R::qgeom(log(x), a, 1, 1),
+                                          R::qgeom(x, a, 0, 0), R::qgeom(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dhyper( double x, double a, double b, double c ){
+	     return NumericVector::create(R::dhyper(x, a, b, c, 0), R::dhyper(x, a, b, c, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_phyper( double x, double a, double b, double c ){
+	     return NumericVector::create(R::phyper(x, a, b, c, 1, 0), R::phyper(log(x), a, b, c, 1, 1),
+                                          R::phyper(x, a, b, c, 0, 0), R::phyper(log(x), a, b, c, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qhyper( double x, double a, double b, double c ){
+	     return NumericVector::create(R::qhyper(x, a, b, c, 1, 0), R::qhyper(log(x), a, b, c, 1, 1),
+                                          R::qhyper(x, a, b, c, 0, 0), R::qhyper(log(x), a, b, c, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dnbinom( double x, double a, double b ){
+	     return NumericVector::create(R::dnbinom(x, a, b, 0), R::dnbinom(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pnbinom( double x, double a, double b ){
+	     return NumericVector::create(R::pnbinom(x, a, b, 1, 0), R::pnbinom(log(x), a, b, 1, 1),
+                                          R::pnbinom(x, a, b, 0, 0), R::pnbinom(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qnbinom( double x, double a, double b ){
+	     return NumericVector::create(R::qnbinom(x, a, b, 1, 0), R::qnbinom(log(x), a, b, 1, 1),
+                                          R::qnbinom(x, a, b, 0, 0), R::qnbinom(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dpois( double x, double a ){
+	     return NumericVector::create(R::dpois(x, a, 0), R::dpois(x, a, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_ppois( double x, double a ){
+	     return NumericVector::create(R::ppois(x, a, 1, 0), R::ppois(log(x), a, 1, 1),
+                                          R::ppois(x, a, 0, 0), R::ppois(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qpois( double x, double a ){
+	     return NumericVector::create(R::qpois(x, a, 1, 0), R::qpois(log(x), a, 1, 1),
+                                          R::qpois(x, a, 0, 0), R::qpois(log(x), a, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dweibull( double x, double a, double b ){
+	     return NumericVector::create(R::dweibull(x, a, b, 0), R::dweibull(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pweibull( double x, double a, double b ){
+	     return NumericVector::create(R::pweibull(x, a, b, 1, 0), R::pweibull(log(x), a, b, 1, 1),
+                                          R::pweibull(x, a, b, 0, 0), R::pweibull(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qweibull( double x, double a, double b ){
+	     return NumericVector::create(R::qweibull(x, a, b, 1, 0), R::qweibull(log(x), a, b, 1, 1),
+                                          R::qweibull(x, a, b, 0, 0), R::qweibull(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dlogis( double x, double a, double b ){
+	     return NumericVector::create(R::dlogis(x, a, b, 0), R::dlogis(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_plogis( double x, double a, double b ){
+	     return NumericVector::create(R::plogis(x, a, b, 1, 0), R::plogis(log(x), a, b, 1, 1),
+                                          R::plogis(x, a, b, 0, 0), R::plogis(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qlogis( double x, double a, double b ){
+	     return NumericVector::create(R::qlogis(x, a, b, 1, 0), R::qlogis(log(x), a, b, 1, 1),
+                                          R::qlogis(x, a, b, 0, 0), R::qlogis(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dnbeta( double x, double a, double b, double c ){
+	     return NumericVector::create(R::dnbeta(x, a, b, c, 0), R::dnbeta(x, a, b, c, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pnbeta( double x, double a, double b, double c ){
+	     return NumericVector::create(R::pnbeta(x, a, b, c, 1, 0), R::pnbeta(log(x), a, b, c, 1, 1),
+                                          R::pnbeta(x, a, b, c, 0, 0), R::pnbeta(log(x), a, b, c, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qnbeta( double x, double a, double b, double c ){
+	     return NumericVector::create(R::qnbeta(x, a, b, c, 1, 0), R::qnbeta(log(x), a, b, c, 1, 1),
+                                          R::qnbeta(x, a, b, c, 0, 0), R::qnbeta(log(x), a, b, c, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dnf( double x, double a, double b, double c ){
+	     return NumericVector::create(R::dnf(x, a, b, c, 0), R::dnf(x, a, b, c, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pnf( double x, double a, double b, double c ){
+	     return NumericVector::create(R::pnf(x, a, b, c, 1, 0), R::pnf(log(x), a, b, c, 1, 1),
+                                          R::pnf(x, a, b, c, 0, 0), R::pnf(log(x), a, b, c, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qnf( double x, double a, double b, double c ){
+	     return NumericVector::create(R::qnf(x, a, b, c, 1, 0), R::qnf(log(x), a, b, c, 1, 1),
+                                          R::qnf(x, a, b, c, 0, 0), R::qnf(log(x), a, b, c, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dnt( double x, double a, double b ){
+	     return NumericVector::create(R::dnt(x, a, b, 0), R::dnt(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pnt( double x, double a, double b ){
+	     return NumericVector::create(R::pnt(x, a, b, 1, 0), R::pnt(log(x), a, b, 1, 1),
+                                          R::pnt(x, a, b, 0, 0), R::pnt(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qnt( double x, double a, double b ){
+	     return NumericVector::create(R::qnt(x, a, b, 1, 0), R::qnt(log(x), a, b, 1, 1),
+                                          R::qnt(x, a, b, 0, 0), R::qnt(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_dwilcox( double x, double a, double b ){
+	     return NumericVector::create(R::dwilcox(x, a, b, 0), R::dwilcox(x, a, b, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_pwilcox( double x, double a, double b ){
+	     return NumericVector::create(R::pwilcox(x, a, b, 1, 0), R::pwilcox(log(x), a, b, 1, 1),
+                                          R::pwilcox(x, a, b, 0, 0), R::pwilcox(log(x), a, b, 0, 1));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qwilcox( double x, double a, double b ){
+	     return NumericVector::create(R::qwilcox(x, a, b, 1, 0), R::qwilcox(log(x), a, b, 1, 1),
+                                          R::qwilcox(x, a, b, 0, 0), R::qwilcox(log(x), a, b, 0, 1));
+}
+

Modified: pkg/Rcpp/inst/unitTests/runit.rmath.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.rmath.R	2013-07-02 14:45:24 UTC (rev 4383)
+++ pkg/Rcpp/inst/unitTests/runit.rmath.R	2013-07-02 15:41:13 UTC (rev 4384)
@@ -1,7 +1,7 @@
 #!/usr/bin/r -t
 # -*- mode: R; ess-indent-level: 4; tab-width: 4; indent-tabs-mode: nil; -*
 #
-# Copyright (C) 2012  Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2012 - 2013 Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -22,318 +22,22 @@
 
 if (.runThisTest) {
 
-definitions <- function() {
-    list("runit_dnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::dnorm(x, a, b, 0), R::dnorm(x, a, b, 1));')
-         ,"runit_pnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::pnorm(x, a, b, 1, 0), R::pnorm(log(x), a, b, 1, 1),
-                                          R::pnorm(x, a, b, 0, 0), R::pnorm(log(x), a, b, 0, 1));')
-         ,"runit_qnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qnorm(x, a, b, 1, 0), R::qnorm(log(x), a, b, 1, 1),
-                                          R::qnorm(x, a, b, 0, 0), R::qnorm(log(x), a, b, 0, 1));')
+.setUp <- Rcpp:::unit_test_setup( "rmath.cpp" )
 
-
-         ,"runit_dunif" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::dunif(x, a, b, 0), R::dunif(x, a, b, 1));')
-         ,"runit_punif" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::punif(x, a, b, 1, 0), R::punif(log(x), a, b, 1, 1),
-                                          R::punif(x, a, b, 0, 0), R::punif(log(x), a, b, 0, 1));')
-         ,"runit_qunif" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qunif(x, a, b, 1, 0), R::qunif(log(x), a, b, 1, 1),
-                                          R::qunif(x, a, b, 0, 0), R::qunif(log(x), a, b, 0, 1));')
-
-
-         ,"runit_dgamma" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::dgamma(x, a, b, 0), R::dgamma(x, a, b, 1));')
-         ,"runit_pgamma" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::pgamma(x, a, b, 1, 0), R::pgamma(log(x), a, b, 1, 1),
-                                          R::pgamma(x, a, b, 0, 0), R::pgamma(log(x), a, b, 0, 1));')
-         ,"runit_qgamma" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qgamma(x, a, b, 1, 0), R::qgamma(log(x), a, b, 1, 1),
-                                          R::qgamma(x, a, b, 0, 0), R::qgamma(log(x), a, b, 0, 1));')
-
-
-         ,"runit_dbeta" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::dbeta(x, a, b, 0), R::dbeta(x, a, b, 1));')
-         ,"runit_pbeta" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::pbeta(x, a, b, 1, 0), R::pbeta(log(x), a, b, 1, 1),
-                                          R::pbeta(x, a, b, 0, 0), R::pbeta(log(x), a, b, 0, 1));')
-         ,"runit_qbeta" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qbeta(x, a, b, 1, 0), R::qbeta(log(x), a, b, 1, 1),
-                                          R::qbeta(x, a, b, 0, 0), R::qbeta(log(x), a, b, 0, 1));')
-
-
-         ,"runit_dlnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::dlnorm(x, a, b, 0), R::dlnorm(x, a, b, 1));')
-         ,"runit_plnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::plnorm(x, a, b, 1, 0), R::plnorm(log(x), a, b, 1, 1),
-                                          R::plnorm(x, a, b, 0, 0), R::plnorm(log(x), a, b, 0, 1));')
-         ,"runit_qlnorm" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qlnorm(x, a, b, 1, 0), R::qlnorm(log(x), a, b, 1, 1),
-                                          R::qlnorm(x, a, b, 0, 0), R::qlnorm(log(x), a, b, 0, 1));')
-
-
-         ,"runit_dchisq" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::dchisq(x, a, 0), R::dchisq(x, a, 1));')
-         ,"runit_pchisq" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::pchisq(x, a, 1, 0), R::pchisq(log(x), a, 1, 1),
-                                          R::pchisq(x, a, 0, 0), R::pchisq(log(x), a, 0, 1));')
-         ,"runit_qchisq" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::qchisq(x, a, 1, 0), R::qchisq(log(x), a, 1, 1),
-                                          R::qchisq(x, a, 0, 0), R::qchisq(log(x), a, 0, 1));')
-
-
-         ,"runit_dnchisq" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::dnchisq(x, a, b, 0), R::dnchisq(x, a, b, 1));')
-         ,"runit_pnchisq" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::pnchisq(x, a, b, 1, 0), R::pnchisq(log(x), a, b, 1, 1),
-                                          R::pnchisq(x, a, b, 0, 0), R::pnchisq(log(x), a, b, 0, 1));')
-         ,"runit_qnchisq" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qnchisq(x, a, b, 1, 0), R::qnchisq(log(x), a, b, 1, 1),
-                                          R::qnchisq(x, a, b, 0, 0), R::qnchisq(log(x), a, b, 0, 1));')
-
-
-         ,"runit_df" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::df(x, a, b, 0), R::df(x, a, b, 1));')
-         ,"runit_pf" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::pf(x, a, b, 1, 0), R::pf(log(x), a, b, 1, 1),
-                                          R::pf(x, a, b, 0, 0), R::pf(log(x), a, b, 0, 1));')
-         ,"runit_qf" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qf(x, a, b, 1, 0), R::qf(log(x), a, b, 1, 1),
-                                          R::qf(x, a, b, 0, 0), R::qf(log(x), a, b, 0, 1));')
-
-
-         ,"runit_dt" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::dt(x, a, 0), R::dt(x, a, 1));')
-         ,"runit_pt" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::pt(x, a, 1, 0), R::pt(log(x), a, 1, 1),
-                                          R::pt(x, a, 0, 0), R::pt(log(x), a, 0, 1));')
-         ,"runit_qt" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::qt(x, a, 1, 0), R::qt(log(x), a, 1, 1),
-                                          R::qt(x, a, 0, 0), R::qt(log(x), a, 0, 1));')
-
-
-         ,"runit_dbinom" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::dbinom(x, a, b, 0), R::dbinom(x, a, b, 1));')
-         ,"runit_pbinom" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::pbinom(x, a, b, 1, 0), R::pbinom(log(x), a, b, 1, 1),
-                                          R::pbinom(x, a, b, 0, 0), R::pbinom(log(x), a, b, 0, 1));')
-         ,"runit_qbinom" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qbinom(x, a, b, 1, 0), R::qbinom(log(x), a, b, 1, 1),
-                                          R::qbinom(x, a, b, 0, 0), R::qbinom(log(x), a, b, 0, 1));')
-
-
-         ,"runit_dcauchy" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::dcauchy(x, a, b, 0), R::dcauchy(x, a, b, 1));')
-         ,"runit_pcauchy" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::pcauchy(x, a, b, 1, 0), R::pcauchy(log(x), a, b, 1, 1),
-                                          R::pcauchy(x, a, b, 0, 0), R::pcauchy(log(x), a, b, 0, 1));')
-         ,"runit_qcauchy" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qcauchy(x, a, b, 1, 0), R::qcauchy(log(x), a, b, 1, 1),
-                                          R::qcauchy(x, a, b, 0, 0), R::qcauchy(log(x), a, b, 0, 1));')
-
-
-         ,"runit_dexp" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::dexp(x, a, 0), R::dexp(x, a, 1));')
-         ,"runit_pexp" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::pexp(x, a, 1, 0), R::pexp(log(x), a, 1, 1),
-                                          R::pexp(x, a, 0, 0), R::pexp(log(x), a, 0, 1));')
-         ,"runit_qexp" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::qexp(x, a, 1, 0), R::qexp(log(x), a, 1, 1),
-                                          R::qexp(x, a, 0, 0), R::qexp(log(x), a, 0, 1));')
-
-
-         ,"runit_dgeom" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::dgeom(x, a, 0), R::dgeom(x, a, 1));')
-         ,"runit_pgeom" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::pgeom(x, a, 1, 0), R::pgeom(log(x), a, 1, 1),
-                                          R::pgeom(x, a, 0, 0), R::pgeom(log(x), a, 0, 1));')
-         ,"runit_qgeom" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::qgeom(x, a, 1, 0), R::qgeom(log(x), a, 1, 1),
-                                          R::qgeom(x, a, 0, 0), R::qgeom(log(x), a, 0, 1));')
-
-
-         ,"runit_dhyper" = list(signature(x_ = "double", a_ = "double", b_ = "double", c_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_), c = as<double>(c_);
-	     return NumericVector::create(R::dhyper(x, a, b, c, 0), R::dhyper(x, a, b, c, 1));')
-         ,"runit_phyper" = list(signature(x_ = "double", a_ = "double", b_ = "double", c_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_), c = as<double>(c_);
-	     return NumericVector::create(R::phyper(x, a, b, c, 1, 0), R::phyper(log(x), a, b, c, 1, 1),
-                                          R::phyper(x, a, b, c, 0, 0), R::phyper(log(x), a, b, c, 0, 1));')
-         ,"runit_qhyper" = list(signature(x_ = "double", a_ = "double", b_ = "double", c_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_), c = as<double>(c_);
-	     return NumericVector::create(R::qhyper(x, a, b, c, 1, 0), R::qhyper(log(x), a, b, c, 1, 1),
-                                          R::qhyper(x, a, b, c, 0, 0), R::qhyper(log(x), a, b, c, 0, 1));')
-
-
-         ,"runit_dnbinom" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::dnbinom(x, a, b, 0), R::dnbinom(x, a, b, 1));')
-         ,"runit_pnbinom" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_) ;
-	     return NumericVector::create(R::pnbinom(x, a, b, 1, 0), R::pnbinom(log(x), a, b, 1, 1),
-                                          R::pnbinom(x, a, b, 0, 0), R::pnbinom(log(x), a, b, 0, 1));')
-         ,"runit_qnbinom" = list(signature(x_ = "double", a_ = "double", b_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_), b = as<double>(b_);
-	     return NumericVector::create(R::qnbinom(x, a, b, 1, 0), R::qnbinom(log(x), a, b, 1, 1),
-                                          R::qnbinom(x, a, b, 0, 0), R::qnbinom(log(x), a, b, 0, 1));')
-
-
-         ,"runit_dpois" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::dpois(x, a, 0), R::dpois(x, a, 1));')
-         ,"runit_ppois" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
-	     return NumericVector::create(R::ppois(x, a, 1, 0), R::ppois(log(x), a, 1, 1),
-                                          R::ppois(x, a, 0, 0), R::ppois(log(x), a, 0, 1));')
-         ,"runit_qpois" = list(signature(x_ = "double", a_ = "double"), '
-             double x = as<double>(x_), a = as<double>(a_);
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/rcpp -r 4384

From noreply at r-forge.r-project.org  Tue Jul  2 18:13:48 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 18:13:48 +0200 (CEST)
Subject: [Rcpp-commits] r4385 - in pkg/Rcpp: . inst/unitTests
	inst/unitTests/cpp
Message-ID: <20130702161349.052B3184AAF@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 18:13:48 +0200 (Tue, 02 Jul 2013)
New Revision: 4385

Added:
   pkg/Rcpp/inst/unitTests/cpp/RObject.cpp
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.RObject.R
Log:
using sourceCpp in runit.RObject

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-02 15:41:13 UTC (rev 4384)
+++ pkg/Rcpp/ChangeLog	2013-07-02 16:13:48 UTC (rev 4385)
@@ -7,6 +7,7 @@
         * unitTests/runit.wrap.R: using sourceCpp
         * unitTests/runit.support.R: using sourceCpp
         * unitTests/runit.rmath.R: using sourceCpp
+        * unitTests/runit.RObject.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/RObject.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/RObject.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/RObject.cpp	2013-07-02 16:13:48 UTC (rev 4385)
@@ -0,0 +1,164 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// RObject.cpp: Rcpp R/C++ interface class library -- RObject 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]]
+double asDouble(double d){ 
+    return 2*d ;
+}
+
+// [[Rcpp::export]]
+int asInt(int i){
+    return 2*i;
+}
+
+// [[Rcpp::export]]
+std::string asStdString(std::string s){
+   return s+s ; 
+}
+
+// [[Rcpp::export]]
+Rbyte asRaw( Rbyte i ){
+    return (Rbyte)(2*i) ;
+}
+
+// [[Rcpp::export]]
+bool asLogical( bool b){ 
+    return !b ;
+}
+
+// [[Rcpp::export]]
+std::vector<int> asStdVectorInt( SEXP x){
+    std::vector<int> iv = as< std::vector<int> >(x);
+	for (size_t i=0; i<iv.size(); i++) {
+	    iv[i] = 2*iv[i];
+    }
+	return iv ;
+}
+
+// [[Rcpp::export]]
+std::vector<double> asStdVectorDouble(SEXP x){
+    std::vector<double> iv = as< std::vector<double> >( x );
+    for (size_t i=0; i<iv.size(); i++) {
+        	iv[i] = 2*iv[i];
+    }
+	return iv ;
+}
+
+// [[Rcpp::export]]
+std::vector<Rbyte> asStdVectorRaw( SEXP x){
+    std::vector<Rbyte> iv = as< std::vector<Rbyte> >( x );
+    for (size_t i=0; i<iv.size(); i++) {
+        iv[i] = 2*iv[i];
+    }
+	return iv ;
+}
+
+
+// [[Rcpp::export]]
+std::vector<bool> asStdVectorBool( SEXP x ){
+    std::vector<bool> bv = as< std::vector<bool> >( x );
+    for (size_t i=0; i<bv.size(); i++) {
+        	bv[i].flip() ;
+    }
+    return bv ;
+}
+
+// [[Rcpp::export]]
+std::vector<std::string> asStdVectorString( SEXP x){
+    std::vector<std::string> iv = as< std::vector<std::string> >( x );
+    for (size_t i=0; i<iv.size(); i++) {
+        iv[i] = iv[i] + iv[i];
+    }
+	return iv ;
+}
+
+// [[Rcpp::export]]
+std::set<int> stdsetint(){
+    std::set<int> iv ;
+    iv.insert( 0 ) ;
+    iv.insert( 1 ) ;
+    iv.insert( 0 ) ;
+    return iv ;
+}
+
+// [[Rcpp::export]]
+std::set<double> stdsetdouble(){
+    std::set<double> ds;
+    ds.insert( 0.0 );
+    ds.insert( 1.0 );
+    ds.insert( 0.0 );
+    return ds ;
+}
+
+// [[Rcpp::export]]
+std::set<Rbyte> stdsetraw(){
+    std::set<Rbyte> bs ;
+    bs.insert( (Rbyte)0 ) ;
+    bs.insert( (Rbyte)1 ) ;
+    bs.insert( (Rbyte)0 ) ;
+    return bs ;
+}
+
+// [[Rcpp::export]]
+std::set<std::string> stdsetstring(){
+    std::set<std::string> ss ;
+	ss.insert( "foo" ) ;
+	ss.insert( "bar" ) ;
+	ss.insert( "foo" ) ;
+	return ss ;
+}
+
+// [[Rcpp::export]]
+std::vector<std::string> attributeNames(DataFrame x){
+    return x.attributeNames() ;
+}
+
+// [[Rcpp::export]]
+bool hasAttribute( DataFrame x){
+    bool has_class = x.hasAttribute( "class" ) ;
+    return has_class ;
+}
+
+// [[Rcpp::export]]
+SEXP attr_( DataFrame x){
+    return x.attr( "row.names" ) ;
+}
+    
+// [[Rcpp::export]]
+RObject attr_set(){
+    RObject y = wrap("blabla") ;
+	y.attr("foo") = 10 ;
+	return y ;
+}
+
+// [[Rcpp::export]]
+bool isNULL(RObject x){
+    return x.isNULL() ;
+}
+
+// [[Rcpp::export]]
+bool inherits_( RObject xx){
+    return xx.inherits( "foo" ) ;
+}
+

Modified: pkg/Rcpp/inst/unitTests/runit.RObject.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.RObject.R	2013-07-02 15:41:13 UTC (rev 4384)
+++ pkg/Rcpp/inst/unitTests/runit.RObject.R	2013-07-02 16:13:48 UTC (rev 4385)
@@ -1,7 +1,7 @@
 #!/usr/bin/r -t
 # -*- mode: R; tab-width: 4; -*-
 #
-# Copyright (C) 2009 - 2012  Romain Francois and Dirk Eddelbuettel
+# Copyright (C) 2009 - 2013  Romain Francois and Dirk Eddelbuettel
 #
 # This file is part of Rcpp.
 #
@@ -22,332 +22,167 @@
 
 if (.runThisTest) {
 
-definitions <- function(){
-    list("asDouble"=list(
-                  signature(x="numeric"),
-                  'double d = as<double>(x);
-				   return(wrap( 2*d ) );')
+.setUp <- Rcpp:::unit_test_setup( "RObject.cpp" ) 
 
-                  ,"asInt"=list(
-                   signature(x="numeric"),
-                   'int i = as<int>(x) ;
-					return(wrap( 2*i ) ); ')
-
-                  ,"asStdString"=list(
-                   signature(x="character"),
-                   'std::string s = as<std::string>(x) ;
-	                return(wrap( s+s ) );')
-
-                  ,"asRaw"=list(
-                   signature(x="raw"),
-                   'Rbyte i = as<Rbyte>(x);
-	                return(wrap( (Rbyte)(2*i) ) ); ')
-
-                  ,"asLogical"=list(
-                   signature(x="logical"),
-                   'bool b = as<bool>(x);
-					return(wrap( !b ));')
-
-                  ,"asStdVectorInt"=list(
-                   signature(x="numeric"),
-                   'std::vector<int> iv = as< std::vector<int> >(x);
-				    for (size_t i=0; i<iv.size(); i++) {
-				        iv[i] = 2*iv[i];
-    				}
-				    return(Rcpp::wrap( iv ) );')
-
-                  ,"asStdVectorDouble"=list(
-                   signature(x="numeric"),
-                   'std::vector<double> iv = as< std::vector<double> >( x );
-					for (size_t i=0; i<iv.size(); i++) {
-	        			iv[i] = 2*iv[i];
-	    			}
-				 	return(Rcpp::wrap( iv ));')
-
-                  ,"asStdVectorRaw"=list(
-                   signature(x="raw"),
-                   'std::vector<Rbyte> iv = as< std::vector<Rbyte> >( x );
-					for (size_t i=0; i<iv.size(); i++) {
-			    	    iv[i] = 2*iv[i];
-			    	}
-			 		return(Rcpp::wrap( iv ));')
-
-                  ,"asStdVectorBool"=list(
-                   signature(x="logical"),
-                   'std::vector<bool> bv = as< std::vector<bool> >( x );
-					for (size_t i=0; i<bv.size(); i++) {
-		    			bv[i].flip() ;
-					}
-					return(Rcpp::wrap( bv ));')
-
-                  ,"asStdVectorString"=list(
-                   signature(x="character"),
-                   'std::vector<std::string> iv = as< std::vector<std::string> >( x );
-					for (size_t i=0; i<iv.size(); i++) {
-			    	    iv[i] = iv[i] + iv[i];
-			    	}
-				 	return(Rcpp::wrap( iv ));')
-
-                  ,"stdsetint"=list(
-                   signature(),
-                   'std::set<int> iv ;
-					iv.insert( 0 ) ;
-					iv.insert( 1 ) ;
-					iv.insert( 0 ) ;
-					return Rcpp::wrap( iv );')
-
-                  ,"stdsetdouble"=list(
-                   signature(),
-                   'std::set<double> ds;
-					ds.insert( 0.0 );
-					ds.insert( 1.0 );
-					ds.insert( 0.0 );
-					return(Rcpp::wrap( ds )); ')
-
-                  ,"stdsetraw"=list(
-                   signature(),
-                   'std::set<Rbyte> bs ;
-					bs.insert( (Rbyte)0 ) ;
-					bs.insert( (Rbyte)1 ) ;
-					bs.insert( (Rbyte)0 ) ;
-					return(Rcpp::wrap( bs )); ')
-
-                  ,"stdsetstring"=list(
-                   signature(),
-                   'std::set<std::string> ss ;
-					ss.insert( "foo" ) ;
-					ss.insert( "bar" ) ;
-					ss.insert( "foo" ) ;
-					return(Rcpp::wrap( ss )); ')
-
-                  ,"attributeNames"=list(
-                   signature(x="data.frame"),
-                   'std::vector<std::string> iv = RObject(x).attributeNames();
-					return(wrap( iv ));' )
-
-                  ,"hasAttribute"=list(
-                   signature(x="data.frame"),
-                   'bool has_class = RObject(x).hasAttribute( "class" ) ;
-					return wrap( has_class ) ;')
-
-                  ,"attr"=list(
-                   signature(x="data.frame"),
-                   'return RObject(x).attr( "row.names" ) ;')
-
-                  ,"attr_set"=list(
-                   signature(),
-                   'RObject y = wrap("blabla") ;
-	                y.attr("foo") = 10 ;
-					return y ; ')
-
-                  ,"isNULL"=list(
-                   signature(x="ANY"),
-                   'bool is_null = RObject(x).isNULL() ;
-					return wrap( is_null ) ; ')
-
-				  ,"inherits" = list(
-                   signature(x = "ANY" ),
-				   'RObject xx(x) ;
-				    return wrap( xx.inherits( "foo" ) ) ;
-				   ')
-
-                  )
-
-}
-
-cxxargs <- function(){
-    ifelse(Rcpp:::capabilities()[["initializer lists"]],"-std=c++0x","")
-}
-
-.setUp <- function(){
-    suppressMessages( require( datasets ) )
-    data( iris )
-
-    tests <- ".Rcpp.RObject"
-    if( ! exists(tests, globalenv() )) {
-        fun <- Rcpp:::compile_unit_tests(
-            definitions(),
-            cxxargs = cxxargs()
-        )
-        assign( tests, fun, globalenv() )
-    }
-}
-
 test.RObject.asDouble <- function(){
-	funx <- .Rcpp.RObject$asDouble
-	checkEquals( funx(2.123), 4.246, msg = "as<double>( REALSXP ) " )
-	checkEquals( funx(2L), 4.0, msg = "as<double>( INTSXP ) " )
-	checkEquals( funx(as.raw(2L)), 4.0, msg = "as<double>( RAWSXP )" )
-	checkException( funx(x='2'), msg = "as<double>( STRSXP ) -> exception" )
-	checkException( funx(x=2:3), msg = "as<double> expects the vector to be of length 1" )
+	checkEquals( asDouble(2.123), 4.246, msg = "as<double>( REALSXP ) " )
+	checkEquals( asDouble(2L), 4.0, msg = "as<double>( INTSXP ) " )
+	checkEquals( asDouble(as.raw(2L)), 4.0, msg = "as<double>( RAWSXP )" )
+	checkException( asDouble('2'), msg = "as<double>( STRSXP ) -> exception" )
+	checkException( asDouble(2:3), msg = "as<double> expects the vector to be of length 1" )
 }
 
 test.RObject.asInt <- function(){
-	funx <- .Rcpp.RObject$asInt
-	checkEquals( funx(2.123), 4L, msg = "as<int>( REALSXP )" )
-	checkEquals( funx(2), 4L, msg = "as<int>( REALSXP )" )
-	checkEquals( funx(2L), 4.0, msg = "as<int>( INTSXP )" )
-	checkEquals( funx(as.raw(2L)), 4.0, msg = "as<int>( RAWSXP )" )
-	checkException( funx(x='2'), msg = "as<int> can not convert character" )
-	checkException( funx(x=2:3), msg = "as<int> expects the vector to be of length 1" )
+	checkEquals( asInt(2.123), 4L, msg = "as<int>( REALSXP )" )
+	checkEquals( asInt(2), 4L, msg = "as<int>( REALSXP )" )
+	checkEquals( asInt(2L), 4.0, msg = "as<int>( INTSXP )" )
+	checkEquals( asInt(as.raw(2L)), 4.0, msg = "as<int>( RAWSXP )" )
+	checkException( asInt( '2'), msg = "as<int> can not convert character" )
+	checkException( asInt( 2:3), msg = "as<int> expects the vector to be of length 1" )
 }
 
 test.RObject.asStdString <- function(){
-	funx <- .Rcpp.RObject$asStdString
-	checkEquals( funx("abc"), "abcabc", msg = "as<std::string>" )
-	checkException( funx(NULL), msg = "as<std::string> expects character vector" )
-	checkException( funx(0L), msg = "as<std::string> expects character vector" )
-	checkException( funx(0.1), msg = "as<std::string> expects character vector" )
-	checkException( funx(as.raw(0L)), msg = "as<std::string> expects character vector" )
+	checkEquals( asStdString("abc"), "abcabc", msg = "as<std::string>" )
+	checkException( asStdString(NULL), msg = "as<std::string> expects character vector" )
+	checkException( asStdString(0L), msg = "as<std::string> expects character vector" )
+	checkException( asStdString(0.1), msg = "as<std::string> expects character vector" )
+	checkException( asStdString(as.raw(0L)), msg = "as<std::string> expects character vector" )
 
-	checkException( funx(letters), msg = "as<std::string> expects single string" )
+	checkException( asStdString(letters), msg = "as<std::string> expects single string" )
 }
 
 test.RObject.asRaw <- function(){
-	funx <- .Rcpp.RObject$asRaw
-	checkEquals( funx(1L), as.raw(2L), msg = "as<Rbyte>(integer)" )
-	checkEquals( funx(1.3), as.raw(2L), msg = "as<Rbyte>(numeric)" )
-	checkEquals( funx(as.raw(1)), as.raw(2L), msg = "as<Rbyte>(raw)" )
-	checkException( funx(NULL) , msg = "as<Rbyte>(NULL) -> exception" )
-	checkException( funx("foo") , msg = "as<Rbyte>(character) -> exception" )
-	checkException( funx(1:2), msg = "as<Rbyte>(>1 integer) -> exception" )
-	checkException( funx(as.numeric(1:2)), msg = "as<Rbyte>(>1 numeric) -> exception" )
-	checkException( funx(as.raw(1:3)), msg = "as<Rbyte>(>1 raw) -> exception" )
-	checkException( funx(integer(0)), msg = "as<Rbyte>(0 integer) -> exception" )
-	checkException( funx(numeric(0)), msg = "as<Rbyte>(0 numeric) -> exception" )
-	checkException( funx(raw(0)), msg = "as<Rbyte>(0 raw) -> exception" )
+	checkEquals( asRaw(1L), as.raw(2L), msg = "as<Rbyte>(integer)" )
+	checkEquals( asRaw(1.3), as.raw(2L), msg = "as<Rbyte>(numeric)" )
+	checkEquals( asRaw(as.raw(1)), as.raw(2L), msg = "as<Rbyte>(raw)" )
+	checkException( asRaw(NULL) , msg = "as<Rbyte>(NULL) -> exception" )
+	checkException( asRaw("foo") , msg = "as<Rbyte>(character) -> exception" )
+	checkException( asRaw(1:2), msg = "as<Rbyte>(>1 integer) -> exception" )
+	checkException( asRaw(as.numeric(1:2)), msg = "as<Rbyte>(>1 numeric) -> exception" )
+	checkException( asRaw(as.raw(1:3)), msg = "as<Rbyte>(>1 raw) -> exception" )
+	checkException( asRaw(integer(0)), msg = "as<Rbyte>(0 integer) -> exception" )
+	checkException( asRaw(numeric(0)), msg = "as<Rbyte>(0 numeric) -> exception" )
+	checkException( asRaw(raw(0)), msg = "as<Rbyte>(0 raw) -> exception" )
 }
 
 test.RObject.asLogical <- function(){
-	funx <- .Rcpp.RObject$asLogical
-	checkTrue( !funx(TRUE), msg = "as<bool>(TRUE) -> true" )
-	checkTrue( funx(FALSE), msg = "as<bool>(FALSE) -> false" )
-	checkTrue( !funx(1L), msg = "as<bool>(1L) -> true" )
-	checkTrue( funx(0L), msg = "as<bool>(0L) -> false" )
-	checkTrue( !funx(1.0), msg = "as<bool>(1.0) -> true" )
-	checkTrue( funx(0.0), msg = "as<bool>0.0) -> false" )
-	checkTrue( !funx(as.raw(1)), msg = "as<bool>(aw.raw(1)) -> true" )
-	checkTrue( funx(as.raw(0)), msg = "as<bool>(as.raw(0)) -> false" )
+	checkTrue( !asLogical(TRUE), msg = "as<bool>(TRUE) -> true" )
+	checkTrue( asLogical(FALSE), msg = "as<bool>(FALSE) -> false" )
+	checkTrue( !asLogical(1L), msg = "as<bool>(1L) -> true" )
+	checkTrue( asLogical(0L), msg = "as<bool>(0L) -> false" )
+	checkTrue( !asLogical(1.0), msg = "as<bool>(1.0) -> true" )
+	checkTrue( asLogical(0.0), msg = "as<bool>0.0) -> false" )
+	checkTrue( !asLogical(as.raw(1)), msg = "as<bool>(aw.raw(1)) -> true" )
+	checkTrue( asLogical(as.raw(0)), msg = "as<bool>(as.raw(0)) -> false" )
 
-	checkException( funx(NULL), msg = "as<bool>(NULL) -> exception" )
-	checkException( funx(c(TRUE,FALSE)), msg = "as<bool>(>1 logical) -> exception" )
-	checkException( funx(1:2), msg = "as<bool>(>1 integer) -> exception" )
-	checkException( funx(1:2+.1), msg = "as<bool>(>1 numeric) -> exception" )
-	checkException( funx(as.raw(1:2)), msg = "as<bool>(>1 raw) -> exception" )
+	checkException( asLogical(NULL), msg = "as<bool>(NULL) -> exception" )
+	checkException( asLogical(c(TRUE,FALSE)), msg = "as<bool>(>1 logical) -> exception" )
+	checkException( asLogical(1:2), msg = "as<bool>(>1 integer) -> exception" )
+	checkException( asLogical(1:2+.1), msg = "as<bool>(>1 numeric) -> exception" )
+	checkException( asLogical(as.raw(1:2)), msg = "as<bool>(>1 raw) -> exception" )
 
-	checkException( funx(integer(0)), msg = "as<bool>(0 integer) -> exception" )
-	checkException( funx(numeric(0)), msg = "as<bool>(0 numeric) -> exception" )
-	checkException( funx(raw(0)), msg = "as<bool>(0 raw) -> exception" )
+	checkException( asLogical(integer(0)), msg = "as<bool>(0 integer) -> exception" )
+	checkException( asLogical(numeric(0)), msg = "as<bool>(0 numeric) -> exception" )
+	checkException( asLogical(raw(0)), msg = "as<bool>(0 raw) -> exception" )
 }
 
 test.RObject.asStdVectorInt <- function(){
-	funx <- .Rcpp.RObject$asStdVectorInt
-    checkEquals( funx(x=2:5), 2:5*2L, msg = "as< std::vector<int> >(integer)" )
-    checkEquals( funx(x=2:5+.1), 2:5*2L, msg = "as< std::vector<int> >(numeric)" )
-    checkEquals( funx(x=as.raw(2:5)), 2:5*2L, msg = "as< std::vector<int> >(raw)" )
-    checkException( funx("foo"), msg = "as< std::vector<int> >(character) -> exception" )
-    checkException( funx(NULL), msg = "as< std::vector<int> >(NULL) -> exception" )
+    checkEquals( asStdVectorInt(x=2:5), 2:5*2L, msg = "as< std::vector<int> >(integer)" )
+    checkEquals( asStdVectorInt(x=2:5+.1), 2:5*2L, msg = "as< std::vector<int> >(numeric)" )
+    checkEquals( asStdVectorInt(x=as.raw(2:5)), 2:5*2L, msg = "as< std::vector<int> >(raw)" )
+    checkException( asStdVectorInt("foo"), msg = "as< std::vector<int> >(character) -> exception" )
+    checkException( asStdVectorInt(NULL), msg = "as< std::vector<int> >(NULL) -> exception" )
 }
 
 test.RObject.asStdVectorDouble <- function(){
-	funx <- .Rcpp.RObject$asStdVectorDouble
-	checkEquals( funx(x=0.1+2:5), 2*(0.1+2:5), msg = "as< std::vector<double> >( numeric )" )
-	checkEquals( funx(x=2:5), 2*(2:5), msg = "as< std::vector<double> >(integer)" )
-	checkEquals( funx(x=as.raw(2:5)), 2*(2:5), msg = "as< std::vector<double> >(raw)" )
-	checkException( funx("foo"), msg = "as< std::vector<double> >(character) -> exception" )
-    checkException( funx(NULL), msg = "as< std::vector<double> >(NULL) -> exception" )
+    checkEquals( asStdVectorDouble(x=0.1+2:5), 2*(0.1+2:5), msg = "as< std::vector<double> >( numeric )" )
+    checkEquals( asStdVectorDouble(x=2:5), 2*(2:5), msg = "as< std::vector<double> >(integer)" )
+    checkEquals( asStdVectorDouble(x=as.raw(2:5)), 2*(2:5), msg = "as< std::vector<double> >(raw)" )
+    checkException( asStdVectorDouble("foo"), msg = "as< std::vector<double> >(character) -> exception" )
+    checkException( asStdVectorDouble(NULL), msg = "as< std::vector<double> >(NULL) -> exception" )
 }
 
 test.RObject.asStdVectorRaw <- function(){
-	funx <- .Rcpp.RObject$asStdVectorRaw
-	checkEquals( funx(x=as.raw(0:9)), as.raw(2*(0:9)), msg = "as< std::vector<Rbyte> >(raw)" )
-	checkEquals( funx(x=0:9), as.raw(2*(0:9)), msg = "as< std::vector<Rbyte> >( integer )" )
-	checkEquals( funx(x=as.numeric(0:9)), as.raw(2*(0:9)), msg = "as< std::vector<Rbyte> >(numeric)" )
-	checkException( funx("foo"), msg = "as< std::vector<Rbyte> >(character) -> exception" )
-    checkException( funx(NULL), msg = "as< std::vector<Rbyte> >(NULL) -> exception" )
-
+	checkEquals( asStdVectorRaw(x=as.raw(0:9)), as.raw(2*(0:9)), msg = "as< std::vector<Rbyte> >(raw)" )
+    checkEquals( asStdVectorRaw(x=0:9), as.raw(2*(0:9)), msg = "as< std::vector<Rbyte> >( integer )" )
+    checkEquals( asStdVectorRaw(x=as.numeric(0:9)), as.raw(2*(0:9)), msg = "as< std::vector<Rbyte> >(numeric)" )
+    checkException( asStdVectorRaw("foo"), msg = "as< std::vector<Rbyte> >(character) -> exception" )
+    checkException( asStdVectorRaw(NULL), msg = "as< std::vector<Rbyte> >(NULL) -> exception" )
 }
 
 test.RObject.asStdVectorBool <- function(){
-	funx <- .Rcpp.RObject$asStdVectorBool
-	checkEquals( funx(x=c(TRUE,FALSE)), c(FALSE, TRUE), msg = "as< std::vector<bool> >(logical)" )
-	checkEquals( funx(x=c(1L, 0L)), c(FALSE, TRUE), msg = "as< std::vector<bool> >(integer)" )
-	checkEquals( funx(x=c(1.0, 0.0)), c(FALSE, TRUE), msg = "as< std::vector<bool> >(numeric)" )
-	checkEquals( funx(x=as.raw(c(1,0))), c(FALSE, TRUE), msg = "as< std::vector<bool> >(raw)" )
-	checkException( funx("foo"), msg = "as< std::vector<bool> >(character) -> exception" )
-    checkException( funx(NULL), msg = "as< std::vector<bool> >(NULL) -> exception" )
+	checkEquals( asStdVectorBool(x=c(TRUE,FALSE)), c(FALSE, TRUE), msg = "as< std::vector<bool> >(logical)" )
+    checkEquals( asStdVectorBool(x=c(1L, 0L)), c(FALSE, TRUE), msg = "as< std::vector<bool> >(integer)" )
+    checkEquals( asStdVectorBool(x=c(1.0, 0.0)), c(FALSE, TRUE), msg = "as< std::vector<bool> >(numeric)" )
+    checkEquals( asStdVectorBool(x=as.raw(c(1,0))), c(FALSE, TRUE), msg = "as< std::vector<bool> >(raw)" )
+    checkException( asStdVectorBool("foo"), msg = "as< std::vector<bool> >(character) -> exception" )
+    checkException( asStdVectorBool(NULL), msg = "as< std::vector<bool> >(NULL) -> exception" )
 }
 
 test.RObject.asStdVectorString <- function(){
-	funx <- .Rcpp.RObject$asStdVectorString
-	checkEquals( funx(c("foo", "bar")), c("foofoo", "barbar"), msg = "as< std::vector<std::string> >(character)" )
-	checkException( funx(1L), msg = "as< std::vector<std::string> >(integer) -> exception" )
-	checkException( funx(1.0), msg = "as< std::vector<std::string> >(numeric) -> exception" )
-	checkException( funx(as.raw(1)), msg = "as< std::vector<std::string> >(raw) -> exception" )
-	checkException( funx(TRUE), msg = "as< std::vector<std::string> >(logical) -> exception" )
-	checkException( funx(NULL), msg = "as< std::vector<std::string> >(NULL) -> exception" )
+	checkEquals( asStdVectorString(c("foo", "bar")), c("foofoo", "barbar"), msg = "as< std::vector<std::string> >(character)" )
+	checkException( asStdVectorString(1L), msg = "as< std::vector<std::string> >(integer) -> exception" )
+	checkException( asStdVectorString(1.0), msg = "as< std::vector<std::string> >(numeric) -> exception" )
+	checkException( asStdVectorString(as.raw(1)), msg = "as< std::vector<std::string> >(raw) -> exception" )
+	checkException( asStdVectorString(TRUE), msg = "as< std::vector<std::string> >(logical) -> exception" )
+	checkException( asStdVectorString(NULL), msg = "as< std::vector<std::string> >(NULL) -> exception" )
 }
 
 test.RObject.stdsetint <- function(){
-	funx <- .Rcpp.RObject$stdsetint
-	checkEquals( funx(), c(0L, 1L), msg = "wrap( set<int> )" )
+	checkEquals( stdsetint(), c(0L, 1L), msg = "wrap( set<int> )" )
 }
 
 test.RObject.stdsetdouble <- function(){
-	funx <- .Rcpp.RObject$stdsetdouble
-	checkEquals( funx(), as.numeric(0:1), msg = "wrap( set<double>" )
+	checkEquals( stdsetdouble(), as.numeric(0:1), msg = "wrap( set<double>" )
 }
 
 test.RObject.stdsetraw <- function(){
-	funx <- .Rcpp.RObject$stdsetraw
-	checkEquals( funx(), as.raw(0:1), msg = "wrap(set<raw>)" )
+	checkEquals( stdsetraw(), as.raw(0:1), msg = "wrap(set<raw>)" )
 }
 
 test.RObject.stdsetstring <- function(){
-	funx <- .Rcpp.RObject$stdsetstring
-	checkEquals( funx(), c("bar", "foo"), msg = "wrap(set<string>)" )
+	checkEquals( stdsetstring(), c("bar", "foo"), msg = "wrap(set<string>)" )
 }
 
 test.RObject.attributeNames <- function(){
-	funx <- .Rcpp.RObject$attributeNames
-	checkTrue( all( c("names","row.names","class") %in% funx(iris)), msg = "RObject.attributeNames" )
+	df <- data.frame( x = 1:10, y = 1:10 )
+	checkTrue( all( c("names","row.names","class") %in% attributeNames(df)), msg = "RObject.attributeNames" )
 }
 
 test.RObject.hasAttribute <- function(){
-	funx <- .Rcpp.RObject$hasAttribute
-	checkTrue( funx( iris ), msg = "RObject.hasAttribute" )
+	df <- data.frame( x = 1:10 )
+	checkTrue( hasAttribute( df ), msg = "RObject.hasAttribute" )
 }
 
 test.RObject.attr <- function(){
-	funx <- .Rcpp.RObject$attr
-	checkEquals( funx( iris ), 1:150, msg = "RObject.attr" )
+	df <- data.frame( x = 1:150 )
+	rownames(df) <- 1:150
+	checkEquals( attr_( iris ), 1:150, msg = "RObject.attr" )
 }
 
 test.RObject.attr.set <- function(){
-	funx <- .Rcpp.RObject$attr_set
-	checkEquals( attr(funx(), "foo"), 10L, msg = "RObject.attr() = " )
+	checkEquals( attr(attr_set(), "foo"), 10L, msg = "RObject.attr() = " )
 }
 
 test.RObject.isNULL <- function(){
-	funx <- .Rcpp.RObject$isNULL
-	checkTrue( !funx( iris ), msg = "RObject.isNULL(iris) -> false" )
-	checkTrue( funx(NULL), msg = "RObject.isNULL(NULL) -> true" )
-	checkTrue( !funx(1L), msg = "RObject.isNULL(integer) -> false" )
-	checkTrue( !funx(1.0), msg = "RObject.isNULL(numeric) -> false" )
-	checkTrue( !funx(as.raw(1)), msg = "RObject.isNULL(raw) -> false" )
-	checkTrue( !funx(letters), msg = "RObject.isNULL(character) -> false")
-	checkTrue( !funx(funx), msg = "RObject.isNULL(function) -> false" )
-	checkTrue( !funx(.GlobalEnv), msg = "RObject.isNULL(environment) -> false" )
+	df <- data.frame( x = 1:10 )
+	checkTrue( !isNULL( df ), msg = "RObject.isNULL(data frame) -> false" )
+	checkTrue( !isNULL(1L), msg = "RObject.isNULL(integer) -> false" )
+	checkTrue( !isNULL(1.0), msg = "RObject.isNULL(numeric) -> false" )
+	checkTrue( !isNULL(as.raw(1)), msg = "RObject.isNULL(raw) -> false" )
+	checkTrue( !isNULL(letters), msg = "RObject.isNULL(character) -> false")
+	checkTrue( !isNULL(test.RObject.isNULL), msg = "RObject.isNULL(function) -> false" )
+	checkTrue( !isNULL(.GlobalEnv), msg = "RObject.isNULL(environment) -> false" )
+	checkTrue( isNULL(NULL), msg = "RObject.isNULL(NULL) -> true" )
 }
 
 test.RObject.inherits <- function(){
-	fx <- .Rcpp.RObject$inherits
 	x <- 1:10
-	checkTrue( !fx(x) )
+	checkTrue( !inherits_(x) )
 	class(x) <- "foo"
-	checkTrue( fx(x) )
+	checkTrue( inherits_(x) )
 	class(x) <- c("foo", "bar" )
-	checkTrue( fx(x) )
+	checkTrue( inherits_(x) )
 }
 
 }


From noreply at r-forge.r-project.org  Tue Jul  2 19:16:26 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 19:16:26 +0200 (CEST)
Subject: [Rcpp-commits] r4386 - in pkg/Rcpp: . inst/unitTests
	inst/unitTests/cpp
Message-ID: <20130702171626.6E53F184BB4@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 19:16:26 +0200 (Tue, 02 Jul 2013)
New Revision: 4386

Added:
   pkg/Rcpp/inst/unitTests/cpp/stats.cpp
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.stats.R
Log:
more use of sourceCpp in testing

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-02 16:13:48 UTC (rev 4385)
+++ pkg/Rcpp/ChangeLog	2013-07-02 17:16:26 UTC (rev 4386)
@@ -8,6 +8,7 @@
         * unitTests/runit.support.R: using sourceCpp
         * unitTests/runit.rmath.R: using sourceCpp
         * unitTests/runit.RObject.R: using sourceCpp
+        * unitTests/runit.stats.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/stats.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/stats.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/stats.cpp	2013-07-02 17:16:26 UTC (rev 4386)
@@ -0,0 +1,247 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// stats.cpp: Rcpp R/C++ interface class library -- stats 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]]
+List runit_dbeta(NumericVector xx, double aa, double bb){
+    return List::create(
+        _["NoLog"] = dbeta( xx, aa, bb),
+        _["Log"]	 = dbeta( xx, aa, bb, true )
+    );
+}
+
+// [[Rcpp::export]]
+List runit_dbinom( IntegerVector xx ){
+    return List::create(
+        _["false"] = dbinom( xx, 10, .5),
+        _["true"]	 = dbinom( xx, 10, .5, true )
+    );
+}
+
+// [[Rcpp::export]]
+List runit_dunif( NumericVector xx){
+    return List::create(
+        _["NoLog_noMin_noMax"] = dunif( xx ),
+        _["NoLog_noMax"] = dunif( xx, 0.0 ),
+        _["NoLog"] = dunif( xx, 0.0 , 1.0 ),
+        _["Log"]	= dunif( xx, 0.0, 1.0 , true ),
+        _["Log_noMax"]	= dunif( xx, 0.0, true )
+        //,_["Log_noMin_noMax"]	= dunif( xx, true )
+    );
+}
+
+// [[Rcpp::export]]
+List runit_dgamma( NumericVector xx ){
+    return List::create(
+        _["NoLog"] = dgamma( xx, 1.0, 1.0),
+        _["Log"]	 = dgamma( xx, 1.0, 1.0, true ),
+        _["Log_noRate"]	 = dgamma( xx, 1.0, true )
+        );
+}
+
+// [[Rcpp::export]]
+List runit_dpois( IntegerVector xx ){
+    return List::create(
+        _["false"] = dpois( xx, .5 ),
+        _["true"]	 = dpois( xx, .5 , true)
+        );
+}
+
+// [[Rcpp::export]]
+List runit_dnorm( NumericVector xx ){
+    return List::create(
+        _["false_noMean_noSd"] = dnorm( xx ),
+        _["false_noSd"] = dnorm( xx, 0.0  ),
+        _["false"] = dnorm( xx, 0.0, 1.0 ),
+        _["true"]	 = dnorm( xx, 0.0, 1.0, true ),
+        _["true_noSd"]	 = dnorm( xx, 0.0, true ),
+        _["true_noMean_noSd"]	 = dnorm( xx, true )
+        );
+}
+
+// [[Rcpp::export]]
+List runit_dt( NumericVector xx){
+    return List::create(
+        _["false"] = dt( xx, 5),
+        _["true"]	 = dt( xx, 5, true ));
+}
+
+// [[Rcpp::export]]
+List runit_pbeta( NumericVector xx, double aa, double bb ){
+    return List::create(
+        _["lowerNoLog"] = pbeta( xx, aa, bb),
+        _["lowerLog"]	  = pbeta( xx, aa, bb, true, true),
+        _["upperNoLog"] = pbeta( xx, aa, bb, false),
+        _["upperLog"]	  = pbeta( xx, aa, bb, false, true)
+    );
+}
+
+// [[Rcpp::export]]
+List runit_pbinom( NumericVector xx, int n, double p){
+    return List::create(
+        _["lowerNoLog"] = pbinom(xx, n, p ),
+        _["lowerLog"]	  = pbinom(xx, n, p, true, true ),
+        _["upperNoLog"] = pbinom(xx, n, p, false ),
+        _["upperLog"]	  = pbinom(xx, n, p, false, true )
+    );
+}
+
+// [[Rcpp::export]]
+List runit_pcauchy( NumericVector xx, double loc, double scl){
+    return List::create(
+        _["lowerNoLog"] = pcauchy(xx, loc, scl ),
+        _["lowerLog"]	  = pcauchy(xx, loc, scl, true, true ),
+        _["upperNoLog"] = pcauchy(xx, loc, scl, false ),
+        _["upperLog"]	  = pcauchy(xx, loc, scl, false, true )
+    );
+}
+
+// [[Rcpp::export]]
+List runit_punif( NumericVector xx ){
+    return List::create(
+        _["lowerNoLog"] = punif( xx, 0.0, 1.0 ),
+        _["lowerLog"]   = punif( xx, 0.0, 1.0, true, true ),
+        _["upperNoLog"] = punif( xx, 0.0, 1.0, false ),
+        _["upperLog"]   = punif( xx, 0.0, 1.0, false, true )
+    );
+}
+
+// [[Rcpp::export]]
+List runit_pgamma( NumericVector xx ){
+    return List::create(
+        _["lowerNoLog"] = pgamma( xx, 2.0, 1.0 ),
+        _["lowerLog"]	  = pgamma( xx, 2.0, 1.0, true, true ),
+        _["upperNoLog"] = pgamma( xx, 2.0, 1.0, false ),
+        _["upperLog"]	  = pgamma( xx, 2.0, 1.0, false, true )
+        );
+}
+
+// [[Rcpp::export]]
+List runit_pnf( NumericVector xx ){
+    return List::create(
+        _["lowerNoLog"] = pnf( xx, 6.0, 8.0, 2.5, true ),
+        _["lowerLog"]	  = pnf( xx, 6.0, 8.0, 2.5, true, true ),
+        _["upperNoLog"] = pnf( xx, 6.0, 8.0, 2.5, false ),
+        _["upperLog"]	  = pnf( xx, 6.0, 8.0, 2.5, false, true )
+        );
+}
+
+// [[Rcpp::export]]
+List runit_pf( NumericVector xx ){
+    return List::create(
+        _["lowerNoLog"] = pf( xx, 6.0, 8.0 ),
+        _["lowerLog"]	  = pf( xx, 6.0, 8.0, true, true ),
+        _["upperNoLog"] = pf( xx, 6.0, 8.0, false ),
+        _["upperLog"]	  = pf( xx, 6.0, 8.0, false, true )
+    );
+}
+
+// [[Rcpp::export]]
+List runit_pnchisq( NumericVector xx ){
+    return List::create(
+        _["lowerNoLog"] = pnchisq( xx, 6.0, 2.5, true ),
+        _["lowerLog"]	  = pnchisq( xx, 6.0, 2.5, true, true ),
+        _["upperNoLog"] = pnchisq( xx, 6.0, 2.5, false ),
+        _["upperLog"]	  = pnchisq( xx, 6.0, 2.5, false, true )
+        );
+}
+
+// [[Rcpp::export]]
+List runit_pchisq( NumericVector xx){
+    return List::create(
+        _["lowerNoLog"] = pchisq( xx, 6.0 ),
+        _["lowerLog"]	  = pchisq( xx, 6.0, true, true ),
+        _["upperNoLog"] = pchisq( xx, 6.0, false ),
+        _["upperLog"]	  = pchisq( xx, 6.0, false, true )
+    );
+}
+
+// [[Rcpp::export]]
+List runit_pnorm( NumericVector xx ){
+    return List::create(
+        _["lowerNoLog"] = pnorm( xx, 0.0, 1.0 ),
+        _["lowerLog"]	  = pnorm( xx, 0.0, 1.0, true, true ),
+        _["upperNoLog"] = pnorm( xx, 0.0, 1.0, false ),
+        _["upperLog"]	  = pnorm( xx, 0.0, 1.0, false, true )
+        );
+}
+
+// [[Rcpp::export]]
+List runit_ppois( NumericVector xx){
+    return List::create(
+        _["lowerNoLog"] = ppois( xx, 0.5 ),
+        _["lowerLog"]	  = ppois( xx, 0.5, true, true ),
+        _["upperNoLog"] = ppois( xx, 0.5, false ),
+        _["upperLog"]	  = ppois( xx, 0.5, false, true )
+        );
+}
+
+// [[Rcpp::export]]
+List runit_pt( NumericVector xx ){
+    return List::create(
+        _["false"] = pt( xx, 5, true),
+        _["true"]	 = pt( xx, 5, true, true	 )
+        );
+}
+
+// [[Rcpp::export]]
+List runit_qbinom_prob( NumericVector xx, int n, double p){
+    return List::create(
+        _["lower"] = qbinom( xx, n, p ),
+        _["upper"] = qbinom( xx, n, p, false)
+        );
+}
+
+// [[Rcpp::export]]
+List runit_qunif_prob( NumericVector xx ){
+    return List::create(
+        _["lower"] = qunif( xx, 0.0, 1.0 ),
+        _["upper"] = qunif( xx, 0.0, 1.0, false)
+        );
+}
+    
+// [[Rcpp::export]]
+List runit_qnorm_prob( NumericVector xx ){
+    return List::create(
+        _["lower"] = qnorm( xx, 0.0, 1.0 ),
+        _["upper"] = qnorm( xx, 0.0, 1.0, false));
+}
+
+// [[Rcpp::export]]
+List runit_qnorm_log( NumericVector xx ){
+    return List::create(
+        _["lower"] = qnorm( xx, 0.0, 1.0, true, true),
+        _["upper"] = qnorm( xx, 0.0, 1.0, false, true));
+}
+
+// [[Rcpp::export]]
+List runit_qpois_prob( NumericVector xx ){
+    return List::create(
+        _["lower"] = qpois( xx, 0.5 ),
+        _["upper"] = qpois( xx, 0.5, false));
+}
+
+// [[Rcpp::export]]
+NumericVector runit_qt( NumericVector xx, double d, bool lt, bool lg ){
+    return qt( xx, d, lt, lg);
+}

Modified: pkg/Rcpp/inst/unitTests/runit.stats.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.stats.R	2013-07-02 16:13:48 UTC (rev 4385)
+++ pkg/Rcpp/inst/unitTests/runit.stats.R	2013-07-02 17:16:26 UTC (rev 4386)
@@ -1,7 +1,7 @@
 #!/usr/bin/r -t
 # -*- mode: R; tab-width: 4; -*-
 #
-# Copyright (C) 2010 - 2012  Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2013  Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -22,297 +22,12 @@
 
 if (.runThisTest) {
 
-definitions <- function(){
-    list(
-				  "runit_dbeta" = list(
-				  signature(x = "numeric",
-							a = "numeric", b = "numeric"),
-				  '
-				  double aa = as<double>(a), bb = as<double>(b) ;
-				  NumericVector xx(x) ;
-				  return List::create(_["NoLog"] = dbeta( xx, aa, bb),
-									  _["Log"]	 = dbeta( xx, aa, bb, true ));
-				  ')
+.setUp <- Rcpp:::unit_test_setup( "stats.cpp" ) 
 
-				  ,
-				  "runit_dbinom" = list(
-				  signature( x = "integer" ),
-				  '
-				  IntegerVector xx(x) ;
-				  return List::create(_["false"] = dbinom( xx, 10, .5),
-									  _["true"]	 = dbinom( xx, 10, .5, true ));
-				  ')
-
-				  ,
-				  "runit_dunif" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(
-                                      _["NoLog_noMin_noMax"] = dunif( xx ),
-                                      _["NoLog_noMax"] = dunif( xx, 0.0 ),
-                                      _["NoLog"] = dunif( xx, 0.0 , 1.0 ),
-									  _["Log"]	= dunif( xx, 0.0, 1.0 , true ),
-									  _["Log_noMax"]	= dunif( xx, 0.0, true )
-                                    //,_["Log_noMin_noMax"]	= dunif( xx, true )
-                  );
-				  ')
-
-				  ,
-				  "runit_dgamma" = list( signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["NoLog"] = dgamma( xx, 1.0, 1.0),
-									  _["Log"]	 = dgamma( xx, 1.0, 1.0, true ),
-									  _["Log_noRate"]	 = dgamma( xx, 1.0, true )
-                  );
-				  ')
-
-				  ,
-				  "runit_dpois" = list(
-				  signature( x = "integer" ),
-				  '
-				  IntegerVector xx(x) ;
-				  return List::create(_["false"] = dpois( xx, .5 ),
-									  _["true"]	 = dpois( xx, .5 , true));
-				  ')
-
-				  ,
-				  "runit_dnorm" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(
-                                      _["false_noMean_noSd"] = dnorm( xx ),
-                                      _["false_noSd"] = dnorm( xx, 0.0  ),
-                                      _["false"] = dnorm( xx, 0.0, 1.0 ),
-									  _["true"]	 = dnorm( xx, 0.0, 1.0, true ),
-									  _["true_noSd"]	 = dnorm( xx, 0.0, true ),
-									  _["true_noMean_noSd"]	 = dnorm( xx, true ));
-				  ')
-
-				  ,
-				  "runit_dt" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["false"] = dt( xx, 5),
-									  _["true"]	 = dt( xx, 5, true ));
-				  ')
-
-				  ,
-				  "runit_pbeta" = list(
-				  signature(x = "numeric", a = "numeric", b = "numeric"),
-				  '
-				  double aa = as<double>(a), bb = as<double>(b) ;
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = pbeta( xx, aa, bb),
-									  _["lowerLog"]	  = pbeta( xx, aa, bb, true, true),
-									  _["upperNoLog"] = pbeta( xx, aa, bb, false),
-									  _["upperLog"]	  = pbeta( xx, aa, bb, false, true));
-				  ')
-
-				  ,
-				  "runit_pbinom" = list(
-				  signature( x = "numeric", size = "integer", prob = "numeric" ),
-				  '
-				  int n = as<int>(size);
-				  double p = as<double>(prob);
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = pbinom(xx, n, p ),
-									  _["lowerLog"]	  = pbinom(xx, n, p, true, true ),
-									  _["upperNoLog"] = pbinom(xx, n, p, false ),
-									  _["upperLog"]	  = pbinom(xx, n, p, false, true ));
-				  ')
-
-				  ,
-				  "runit_pcauchy" = list(
-				  signature( x = "numeric", location = "numeric", scale = "numeric" ),
-				  '
-				  double loc = as<double>(location);
-				  double scl = as<double>(scale);
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = pcauchy(xx, loc, scl ),
-									  _["lowerLog"]	  = pcauchy(xx, loc, scl, true, true ),
-									  _["upperNoLog"] = pcauchy(xx, loc, scl, false ),
-									  _["upperLog"]	  = pcauchy(xx, loc, scl, false, true ));
-				  ')
-
-				  ,
-				  "runit_punif" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = punif( xx, 0.0, 1.0 ),
-									  _["lowerLog"]	  = punif( xx, 0.0, 1.0, true, true ),
-									  _["upperNoLog"] = punif( xx, 0.0, 1.0, false ),
-									  _["upperLog"]	  = punif( xx, 0.0, 1.0, false, true ));
-				  ')
-
-				  ,
-				  "runit_pgamma" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = pgamma( xx, 2.0, 1.0 ),
-									  _["lowerLog"]	  = pgamma( xx, 2.0, 1.0, true, true ),
-									  _["upperNoLog"] = pgamma( xx, 2.0, 1.0, false ),
-									  _["upperLog"]	  = pgamma( xx, 2.0, 1.0, false, true ));
-				  ')
-
-				  ,
-				  "runit_pnf" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = pnf( xx, 6.0, 8.0, 2.5, true ),
-									  _["lowerLog"]	  = pnf( xx, 6.0, 8.0, 2.5, true, true ),
-									  _["upperNoLog"] = pnf( xx, 6.0, 8.0, 2.5, false ),
-									  _["upperLog"]	  = pnf( xx, 6.0, 8.0, 2.5, false, true ));
-				  ')
-
-				  ,
-				  "runit_pf" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = pf( xx, 6.0, 8.0 ),
-									  _["lowerLog"]	  = pf( xx, 6.0, 8.0, true, true ),
-									  _["upperNoLog"] = pf( xx, 6.0, 8.0, false ),
-									  _["upperLog"]	  = pf( xx, 6.0, 8.0, false, true ));
-				  ')
-
-				  ,
-				  "runit_pnchisq" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = pnchisq( xx, 6.0, 2.5, true ),
-									  _["lowerLog"]	  = pnchisq( xx, 6.0, 2.5, true, true ),
-									  _["upperNoLog"] = pnchisq( xx, 6.0, 2.5, false ),
-									  _["upperLog"]	  = pnchisq( xx, 6.0, 2.5, false, true ));
-				  ')
-
-				  ,
-				  "runit_pchisq" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = pchisq( xx, 6.0 ),
-									  _["lowerLog"]	  = pchisq( xx, 6.0, true, true ),
-									  _["upperNoLog"] = pchisq( xx, 6.0, false ),
-									  _["upperLog"]	  = pchisq( xx, 6.0, false, true ));
-				  ')
-
-                  ,
-				  "runit_pnorm" = list(signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = pnorm( xx, 0.0, 1.0 ),
-									  _["lowerLog"]	  = pnorm( xx, 0.0, 1.0, true, true ),
-									  _["upperNoLog"] = pnorm( xx, 0.0, 1.0, false ),
-									  _["upperLog"]	  = pnorm( xx, 0.0, 1.0, false, true ));
-				  ')
-
-				  ,
-				  "runit_ppois" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lowerNoLog"] = ppois( xx, 0.5 ),
-									  _["lowerLog"]	  = ppois( xx, 0.5, true, true ),
-									  _["upperNoLog"] = ppois( xx, 0.5, false ),
-									  _["upperLog"]	  = ppois( xx, 0.5, false, true ));
-				  ')
-
-				  ,
-				  "runit_pt" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["false"] = pt( xx, 5, true),
-									  _["true"]	 = pt( xx, 5, true, true	 ));
-				  '
-				  )
-
-				  ,
-				  "runit_qbinom_prob" = list(
-				  signature( x = "numeric", size = "integer", prob = "numeric" ),
-				  '
-				  int n = as<int>(size);
-				  double p = as<double>(prob);
-				  NumericVector xx(x) ;
-				  return List::create(_["lower"] = qbinom( xx, n, p ),
-									  _["upper"] = qbinom( xx, n, p, false));
-				  ')
-
-				  ,
-				  "runit_qunif_prob" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lower"] = qunif( xx, 0.0, 1.0 ),
-									  _["upper"] = qunif( xx, 0.0, 1.0, false));
-				  '
-				  )
-
-				  ,
-				  "runit_qnorm_prob" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lower"] = qnorm( xx, 0.0, 1.0 ),
-									  _["upper"] = qnorm( xx, 0.0, 1.0, false));
-				  ')
-
-				  ## need a separate test for log prob because different allowable range of x
-				  ,
-				  "runit_qnorm_log" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lower"] = qnorm( xx, 0.0, 1.0, true, true),
-									  _["upper"] = qnorm( xx, 0.0, 1.0, false, true));
-				  ')
-
-				  ,
-				  "runit_qpois_prob" = list(
-				  signature( x = "numeric" ),
-				  '
-				  NumericVector xx(x) ;
-				  return List::create(_["lower"] = qpois( xx, 0.5 ),
-									  _["upper"] = qpois( xx, 0.5, false));
-				  ')
-
-
-                  ,
-                  "runit_qt" = list(
-                  signature( x = "numeric", df = "numeric", lower = "logical", log = "logical" ),
-                  '
-				  NumericVector xx(x);
-                  double d = as<double>(df);
-                  bool lt = as<bool>(lower);
-                  bool lg = as<bool>(log);
-			      return wrap(qt( xx, d, lt, lg));
-				  ')
-
-         )
-}
-
-.setUp <- function(){
-	if( ! exists( ".rcpp.stats", globalenv() ) ){
-		fun <- Rcpp:::compile_unit_tests(
-		    definitions()
-		)
-	    assign( ".rcpp.stats", fun, globalenv() )
-	}
-}
-
 test.stats.dbeta <- function() {
-    fx <- .rcpp.stats$runit_dbeta
     vv <- seq(0, 1, by = 0.1)
     a <- 0.5; b <- 2.5
-    checkEquals(fx(vv, a, b),
+    checkEquals(runit_dbeta(vv, a, b),
                 list(
                      NoLog = dbeta(vv, a, b),
                      Log   = dbeta(vv, a, b, log=TRUE)
@@ -321,9 +36,8 @@
 }
 
 test.stats.dbinom <- function( ){
-	fx <- .rcpp.stats$runit_dbinom
-    v <- 1:10
-	checkEquals(fx(v) ,
+	v <- 1:10
+	checkEquals(runit_dbinom(v) ,
                 list(
                     false = dbinom(v, 10, .5),
                     true = dbinom(v, 10, .5, TRUE )
@@ -331,9 +45,8 @@
 }
 
 test.stats.dunif <- function() {
-    fx <- .rcpp.stats$runit_dunif
     vv <- seq(0, 1, by = 0.1)
-    checkEquals(fx(vv),
+    checkEquals(runit_dunif(vv),
                 list(
                     NoLog_noMin_noMax = dunif(vv),
                     NoLog_noMax = dunif(vv, 0),
@@ -346,9 +59,8 @@
 }
 
 test.stats.dgamma <- function( ) {
-    fx <- .rcpp.stats$runit_dgamma
     v <- 1:4
-    checkEquals(fx(v),
+    checkEquals(runit_dgamma(v),
                 list( NoLog = dgamma(v, 1.0, 1.0),
                       Log = dgamma(v, 1.0, 1.0, log = TRUE ),
                       Log_noRate = dgamma(v, 1.0, log = TRUE )
@@ -357,18 +69,16 @@
 
 
 test.stats.dpois <- function( ){
-	fx <- .rcpp.stats$runit_dpois
-    v <- 0:5
-	checkEquals(fx(v) ,
+	v <- 0:5
+	checkEquals(runit_dpois(v) ,
                 list( false = dpois(v, .5),
                       true = dpois(v, .5, TRUE )
                 ), msg = "stats.dpois" )
 }
 
 test.stats.dnorm <- function( ) {
-    fx <- .rcpp.stats$runit_dnorm
     v <- seq(0.0, 1.0, by=0.1)
-    checkEquals(fx(v),
+    checkEquals(runit_dnorm(v),
                 list( false_noMean_noSd = dnorm(v),
                       false_noSd = dnorm(v, 0.0),
                       false = dnorm(v, 0.0, 1.0),
@@ -379,19 +89,17 @@
 }
 
 test.stats.dt <- function( ) {
-	fx <- .rcpp.stats$runit_dt
-    v <- seq(0.0, 1.0, by=0.1)
-    checkEquals(fx(v),
+	v <- seq(0.0, 1.0, by=0.1)
+    checkEquals(runit_dt(v),
                 list( false = dt(v, 5),
                       true = dt(v, 5, log=TRUE ) # NB: need log=TRUE here
                 ), msg = "stats.dt" )
 }
 
 test.stats.pbeta <- function( ) {
-    fx <- .rcpp.stats$runit_pbeta
     a <- 0.5; b <- 2.5
     v <- qbeta(seq(0.0, 1.0, by=0.1), a, b)
-    checkEquals(fx(v, a, b),
+    checkEquals(runit_pbeta(v, a, b),
                 list(lowerNoLog = pbeta(v, a, b),
                      lowerLog   = pbeta(v, a, b,              log=TRUE),
                      upperNoLog = pbeta(v, a, b, lower=FALSE),
@@ -402,16 +110,15 @@
     x <- c(.01, .10, .25, .40, .55, .71, .98)
     pbval <- c(-0.04605755624088, -0.3182809860569, -0.7503593555585,
                -1.241555830932, -1.851527837938, -2.76044482378, -8.149862739881)
-    checkEqualsNumeric(fx(x, 0.8, 2)$upperLog, pbval, msg = " stats.pbeta")
-    checkEqualsNumeric(fx(1-x, 2, 0.8)$lowerLog, pbval, msg = " stats.pbeta")
+    checkEqualsNumeric(runit_pbeta(x, 0.8, 2)$upperLog, pbval, msg = " stats.pbeta")
+    checkEqualsNumeric(runit_pbeta(1-x, 2, 0.8)$lowerLog, pbval, msg = " stats.pbeta")
 }
 
 test.stats.pbinom <- function( ) {
-    fx <- .rcpp.stats$runit_pbinom
     n <- 20
     p <- 0.5
     vv <- 0:n
-    checkEquals(fx(vv, n, p),
+    checkEquals(runit_pbinom(vv, n, p),
                 list(lowerNoLog = pbinom(vv, n, p),
                      lowerLog   = pbinom(vv, n, p, log=TRUE),
                      upperNoLog = pbinom(vv, n, p, lower=FALSE),
@@ -421,11 +128,10 @@
 }
 
 test.stats.pcauchy <- function( ) {
-    fx <- .rcpp.stats$runit_pcauchy
     location <- 0.5
     scale <- 1.5
     vv <- 1:5
-    checkEquals(fx(vv, location, scale),
+    checkEquals(runit_pcauchy(vv, location, scale),
                 list(lowerNoLog = pcauchy(vv, location, scale),
                      lowerLog   = pcauchy(vv, location, scale, log=TRUE),
                      upperNoLog = pcauchy(vv, location, scale, lower=FALSE),
@@ -435,9 +141,8 @@
 }
 
 test.stats.punif <- function( ) {
-    fx <- .rcpp.stats$runit_punif
     v <- qunif(seq(0.0, 1.0, by=0.1))
-    checkEquals(fx(v),
+    checkEquals(runit_punif(v),
                 list(lowerNoLog = punif(v),
                      lowerLog   = punif(v, log=TRUE ),
                      upperNoLog = punif(v, lower=FALSE),
@@ -448,9 +153,8 @@
 }
 
 test.stats.pf <- function( ) {
-    fx <- .rcpp.stats$runit_pf
     v <- (1:9)/10
-    checkEquals(fx(v),
+    checkEquals(runit_pf(v),
                 list(lowerNoLog = pf(v, 6, 8, lower=TRUE, log=FALSE),
                      lowerLog   = pf(v, 6, 8, log=TRUE ),
                      upperNoLog = pf(v, 6, 8, lower=FALSE),
@@ -460,9 +164,8 @@
 }
 
 test.stats.pnf <- function( ) {
-    fx <- .rcpp.stats$runit_pnf
     v <- (1:9)/10
-    checkEquals(fx(v),
+    checkEquals(runit_pnf(v),
                 list(lowerNoLog = pf(v, 6, 8, ncp=2.5, lower=TRUE, log=FALSE),
                      lowerLog   = pf(v, 6, 8, ncp=2.5, log=TRUE ),
                      upperNoLog = pf(v, 6, 8, ncp=2.5, lower=FALSE),
@@ -472,9 +175,8 @@
 }
 
 test.stats.pchisq <- function( ) {
-    fx <- .rcpp.stats$runit_pchisq
     v <- (1:9)/10
-    checkEquals(fx(v),
+    checkEquals(runit_pchisq(v),
                 list(lowerNoLog = pchisq(v, 6, lower=TRUE, log=FALSE),
                      lowerLog   = pchisq(v, 6, log=TRUE ),
                      upperNoLog = pchisq(v, 6, lower=FALSE),
@@ -484,9 +186,8 @@
 }
 
 test.stats.pnchisq <- function( ) {
-    fx <- .rcpp.stats$runit_pnchisq
     v <- (1:9)/10
-    checkEquals(fx(v),
+    checkEquals(runit_pnchisq(v),
                 list(lowerNoLog = pchisq(v, 6, ncp=2.5, lower=TRUE, log=FALSE),
                      lowerLog   = pchisq(v, 6, ncp=2.5, log=TRUE ),
                      upperNoLog = pchisq(v, 6, ncp=2.5, lower=FALSE),
@@ -496,9 +197,8 @@
 }
 
 test.stats.pgamma <- function( ) {
-    fx <- .rcpp.stats$runit_pgamma
     v <- (1:9)/10
-    checkEquals(fx(v),
+    checkEquals(runit_pgamma(v),
                 list(lowerNoLog = pgamma(v, shape = 2.0),
                      lowerLog   = pgamma(v, shape = 2.0, log=TRUE ),
                      upperNoLog = pgamma(v, shape = 2.0, lower=FALSE),
@@ -509,9 +209,8 @@
 
 
 test.stats.pnorm <- function( ) {
-    fx <- .rcpp.stats$runit_pnorm
     v <- qnorm(seq(0.0, 1.0, by=0.1))
-    checkEquals(fx(v),
+    checkEquals(runit_pnorm(v),
                 list(lowerNoLog = pnorm(v),
                      lowerLog   = pnorm(v, log=TRUE ),
                      upperNoLog = pnorm(v, lower=FALSE),
@@ -521,17 +220,16 @@
     ## Borrowed from R's d-p-q-r-tests.R
     z <- c(-Inf,Inf,NA,NaN, rt(1000, df=2))
     z.ok <- z > -37.5 | !is.finite(z)
-    pz <- fx(z)
+    pz <- runit_pnorm(z)
     checkEqualsNumeric(pz$lowerNoLog, 1 - pz$upperNoLog, msg = "stats.pnorm")
-    checkEqualsNumeric(pz$lowerNoLog, fx(-z)$upperNoLog, msg = "stats.pnorm")
+    checkEqualsNumeric(pz$lowerNoLog, runit_pnorm(-z)$upperNoLog, msg = "stats.pnorm")
     checkEqualsNumeric(log(pz$lowerNoLog[z.ok]), pz$lowerLog[z.ok], msg = "stats.pnorm")
     ## FIXME: Add tests that use non-default mu and sigma
-}
+} 
 
 test.stats.ppois <- function( ) {
-    fx <- .rcpp.stats$runit_ppois
     vv <- 0:20
-    checkEquals(fx(vv),
+    checkEquals(runit_ppois(vv),
                 list(lowerNoLog = ppois(vv, 0.5),
                      lowerLog   = ppois(vv, 0.5,              log=TRUE),
                      upperNoLog = ppois(vv, 0.5, lower=FALSE),
@@ -541,19 +239,17 @@
 }
 
 test.stats.pt <- function( ) {
-	fx <- .rcpp.stats$runit_pt
-    v <- seq(0.0, 1.0, by=0.1)
-    checkEquals(fx(v),
+	v <- seq(0.0, 1.0, by=0.1)
+    checkEquals(runit_pt(v),
                 list( false = pt(v, 5), true = pt(v, 5, log=TRUE ) ), # NB: need log=TRUE here
                 msg = "stats.pt" )
 }
 
 test.stats.qbinom <- function( ) {
-    fx <- .rcpp.stats$runit_qbinom_prob
     n <- 20
     p <- 0.5
     vv <- seq(0, 1, by = 0.1)
-    checkEquals(fx(vv, n, p),
+    checkEquals(runit_qbinom_prob(vv, n, p),
                 list(lower = qbinom(vv, n, p),
                      upper = qbinom(vv, n, p, lower=FALSE)
                      ),
@@ -561,8 +257,7 @@
 }
 
 test.stats.qunif <- function( ) {
-    fx <- .rcpp.stats$runit_qunif_prob
-    checkEquals(fx(c(0, 1, 1.1, -.1)),
+    checkEquals(runit_qunif_prob(c(0, 1, 1.1, -.1)),
                 list(lower = c(0, 1, NaN, NaN),
                      upper = c(1, 0, NaN, NaN)
                      ),
@@ -571,31 +266,28 @@
 }
 
 test.stats.qnorm <- function( ) {
-    fx <- .rcpp.stats$runit_qnorm_prob
-    checkEquals(fx(c(0, 1, 1.1, -.1)),
+    checkEquals(runit_qnorm_prob(c(0, 1, 1.1, -.1)),
                 list(lower = c(-Inf, Inf, NaN, NaN),
                      upper = c(Inf, -Inf, NaN, NaN)
                      ),
                 msg = "stats.qnorm" )
     ## Borrowed from R's d-p-q-r-tests.R and Wichura (1988)
-    checkEqualsNumeric(fx(c( 0.25,  .001,	 1e-20))$lower,
+    checkEqualsNumeric(runit_qnorm_prob(c( 0.25,  .001,	 1e-20))$lower,
                        c(-0.6744897501960817, -3.090232306167814, -9.262340089798408),
                        msg = "stats.qnorm",
                        tol = 1e-15)
 
-    fx <- .rcpp.stats$runit_qnorm_log
-    checkEquals(fx(c(-Inf, 0, 0.1)),
+    checkEquals(runit_qnorm_log(c(-Inf, 0, 0.1)),
                 list(lower = c(-Inf, Inf, NaN),
                      upper = c(Inf, -Inf, NaN)
                      ),
                 msg = "stats.qnorm" )
-    checkEqualsNumeric(fx(-1e5)$lower, -447.1974945)
+    checkEqualsNumeric(runit_qnorm_log(-1e5)$lower, -447.1974945)
 }
 
 test.stats.qpois.prob <- function( ) {
-    fx <- .rcpp.stats$runit_qpois_prob
     vv <- seq(0, 1, by = 0.1)
-    checkEquals(fx(vv),
+    checkEquals(runit_qpois_prob(vv),
                 list(lower = qpois(vv, 0.5),
                      upper = qpois(vv, 0.5, lower=FALSE)
                      ),
@@ -603,16 +295,23 @@
 }
 
 test.stats.qt <- function( ) {
-	fx <- .rcpp.stats$runit_qt
     v <- seq(0.05, 0.95, by=0.05)
-    checkEquals(fx(v, df=5, lower=FALSE, log=FALSE),
-                qt(v, df=5, lower=FALSE, log=FALSE), msg="stats.qt.f.f")
-    checkEquals(fx(v, df=5, lower=TRUE,  log=FALSE),
-                qt(v, df=5, lower=TRUE,  log=FALSE), msg="stats.qt.t.f")
-    checkEquals(fx(-v, df=5, lower=FALSE, log=TRUE),
-                qt(-v, df=5, lower=FALSE, log=TRUE), msg="stats.qt.f.t")
-    checkEquals(fx(-v, df=5, lower=TRUE,  log=TRUE),
-                qt(-v, df=5, lower=TRUE,  log=TRUE), msg="stats.qt.t.t")
+    ( x1 <- runit_qt(v, 5, FALSE, FALSE) )
+    ( x2 <- qt(v, df=5, lower=FALSE, log=FALSE) )
+    checkEquals(x1, x2, msg="stats.qt.f.f")
+    
+    ( x1 <- runit_qt(v, 5, TRUE, FALSE) )
+    ( x2 <- qt(v, df=5, lower=TRUE, log=FALSE) ) 
+    checkEquals(x1, x2, msg="stats.qt.t.f")
+    
+	( x1 <- runit_qt(-v, 5, FALSE, TRUE) )
+    ( x2 <- qt(-v, df=5, lower=FALSE, log=TRUE) ) 
+    checkEquals(x1, x2, msg="stats.qt.f.t")
+    
+    ( x1 <- runit_qt(-v, 5, TRUE, TRUE) )
+    ( x2 <- qt(-v, df=5, lower=TRUE, log=TRUE) ) 
+    checkEquals(x1, x2, msg="stats.qt.t.t")
+    
 }
 
 # TODO: test.stats.qgamma


From noreply at r-forge.r-project.org  Tue Jul  2 19:26:25 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 19:26:25 +0200 (CEST)
Subject: [Rcpp-commits] r4387 - in pkg/Rcpp/inst/unitTests: . cpp
Message-ID: <20130702172626.083E6184174@r-forge.r-project.org>

Author: romain
Date: 2013-07-02 19:26:25 +0200 (Tue, 02 Jul 2013)
New Revision: 4387

Removed:
   pkg/Rcpp/inst/unitTests/runit.sugarOps.R
Modified:
   pkg/Rcpp/inst/unitTests/cpp/sugar.cpp
   pkg/Rcpp/inst/unitTests/runit.sugar.R
Log:
move sugar Ops to sugar, use more sourceCpp

Modified: pkg/Rcpp/inst/unitTests/cpp/sugar.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/sugar.cpp	2013-07-02 17:16:26 UTC (rev 4386)
+++ pkg/Rcpp/inst/unitTests/cpp/sugar.cpp	2013-07-02 17:26:25 UTC (rev 4387)
@@ -2,7 +2,7 @@
 //
 // sugar.cpp: Rcpp R/C++ interface class library -- sugar unit tests
 //
-// Copyright (C) 2012 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2012 - 2013 Dirk Eddelbuettel and Romain Francois
 //
 // This file is part of Rcpp.
 //
@@ -594,3 +594,40 @@
     return clamp( a, x, b ) ;
 }
 
+// [[Rcpp::export]]
+List vector_scalar_ops( NumericVector xx ){
+			NumericVector y1 = xx + 2.0;  // NB does not work with ints as eg "+ 2L"
+			NumericVector y2 = 2 - xx;
+			NumericVector y3 = xx * 2.0;
+			NumericVector y4 = 2.0 / xx;
+			return List::create(y1, y2, y3, y4);
+}
+
+// [[Rcpp::export]]
+List vector_scalar_logical( NumericVector xx ){
+			LogicalVector y1 = xx < 2;
+			LogicalVector y2 = 2  > xx;
+			LogicalVector y3 = xx <= 2;
+			LogicalVector y4 = 2 != xx;
+			return List::create(y1, y2, y3, y4);
+}
+
+// [[Rcpp::export]]
+List vector_vector_ops( NumericVector xx, NumericVector yy){
+			NumericVector y1 = xx + yy;
+			NumericVector y2 = yy - xx;
+			NumericVector y3 = xx * yy;
+			NumericVector y4 = yy / xx;
+			return List::create(y1, y2, y3, y4);
+}
+
+// [[Rcpp::export]]
+List vector_vector_logical( NumericVector xx, NumericVector yy){
+			LogicalVector y1 = xx < yy;
+			LogicalVector y2 = xx > yy;
+			LogicalVector y3 = xx <= yy;
+			LogicalVector y4 = xx >= yy;
+			LogicalVector y5 = xx == yy;
+			LogicalVector y6 = xx != yy;
+			return List::create(y1, y2, y3, y4, y5, y6);
+}     

Modified: pkg/Rcpp/inst/unitTests/runit.sugar.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugar.R	2013-07-02 17:16:26 UTC (rev 4386)
+++ pkg/Rcpp/inst/unitTests/runit.sugar.R	2013-07-02 17:26:25 UTC (rev 4387)
@@ -22,10 +22,7 @@
 
 if (.runThisTest) {
 
-.setUp <- function() {
-    #sourceCpp( system.file( "unitTests/cpp/sugar.cpp", package = "Rcpp") )
-    sourceCpp(file.path(pathRcppTests, "cpp/sugar.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup( "sugar.cpp" ) 
 
 test.sugar.abs <- function( ){
 	x <- rnorm(10)
@@ -729,4 +726,26 @@
     )
 }
 
+test.vector.scalar.ops <- function( ){
+    x <- rnorm(10)
+    checkEquals(vector_scalar_ops(x), list(x + 2, 2 - x, x * 2, 2 / x), "sugar vector scalar operations")
 }
+
+test.vector.scalar.logical <- function( ){
+    x <- rnorm(10) + 2
+    checkEquals(vector_scalar_logical(x), list(x < 2, 2 > x, x <= 2, 2 != x), "sugar vector scalar logical operations")
+}
+
+test.vector.vector.ops <- function( ){
+    x <- rnorm(10)
+    y <- runif(10)
+    checkEquals(vector_vector_ops(x,y), list(x + y, y - x, x * y, y / x), "sugar vector vector operations")
+}
+
+test.vector.vector.logical <- function( ){
+    x <- rnorm(10)
+    y <- runif(10)
+    checkEquals(vector_vector_logical(x,y), list(x < y, x > y, x <= y, x >= y, x == y, x != y), "sugar vector vector operations")
+}
+
+}

Deleted: pkg/Rcpp/inst/unitTests/runit.sugarOps.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.sugarOps.R	2013-07-02 17:16:26 UTC (rev 4386)
+++ pkg/Rcpp/inst/unitTests/runit.sugarOps.R	2013-07-02 17:26:25 UTC (rev 4387)
@@ -1,130 +0,0 @@
-#!/usr/bin/r -t
-#   -*- mode: R; ess-indent-level: 4; indent-tabs-mode: nil; -*-
-#
-# Copyright (C) 2012         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/>.
-
-.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
-
-if (.runThisTest) {
-
-definitions <- function() {
-    list(
-    	"vector_scalar_ops" = list(signature(x = "numeric"),
-    			'
-			NumericVector xx(x);
-			NumericVector y1 = xx + 2.0;  // NB does not work with ints as eg "+ 2L"
-			NumericVector y2 = 2 - xx;
-			NumericVector y3 = xx * 2.0;
-			NumericVector y4 = 2.0 / xx;
-			return List::create(y1, y2, y3, y4);
-			'
-			)
-
-        ,
-    	"vector_scalar_logical" = list(signature(x = "numeric"),
-    			'
-			NumericVector xx(x);
-			LogicalVector y1 = xx < 2;
-			LogicalVector y2 = 2  > xx;
-			LogicalVector y3 = xx <= 2;
-			LogicalVector y4 = 2 != xx;
-			return List::create(y1, y2, y3, y4);
-			'
-        		)
-
-        ,
-    	"vector_vector_ops" = list(signature(x = "numeric", y="numeric"),
-    			'
-			NumericVector xx(x);
-			NumericVector yy(y);
-			NumericVector y1 = xx + yy;
-			NumericVector y2 = yy - xx;
-			NumericVector y3 = xx * yy;
-			NumericVector y4 = yy / xx;
-			return List::create(y1, y2, y3, y4);
-			'
-        		)
-
-        ,
-    	"vector_vector_logical" = list(signature(x = "numeric", y="numeric"),
-    			'
-			NumericVector xx(x);
-			NumericVector yy(y);
-			LogicalVector y1 = xx < yy;
-			LogicalVector y2 = xx > yy;
-			LogicalVector y3 = xx <= yy;
-			LogicalVector y4 = xx >= yy;
-			LogicalVector y5 = xx == yy;
-			LogicalVector y6 = xx != yy;
-			return List::create(y1, y2, y3, y4, y5, y6);
-			'
-        		)
-
-        ## ,
-    	## "matrix_plus" = list(signature(x = "numeric"),
-	## 		'
-	## 		NumericMatrix xx(x);
-	## 		// -- fails to compile
-        ##                 NumericMatrix yy = xx + 2;
-	## 		return yy;
-	## 		'
-	## 		)
-    )
-}
-
-.setUp <- function(){
-    if ( ! exists( ".rcpp.sugarOps", globalenv() ) ) {
-        fun <- Rcpp:::compile_unit_tests(definitions())
-        assign( ".rcpp.sugarOps", fun, globalenv() )
-    }
-}
-
-test.vector.scalar.ops <- function( ){
-    fx <- .rcpp.sugarOps$vector_scalar_ops
-    x <- rnorm(10)
-    checkEquals(fx(x), list(x + 2, 2 - x, x * 2, 2 / x), "sugar vector scalar operations")
-}
-
-test.vector.scalar.logical <- function( ){
-    fx <- .rcpp.sugarOps$vector_scalar_logical
-    x <- rnorm(10) + 2
-    checkEquals(fx(x), list(x < 2, 2 > x, x <= 2, 2 != x), "sugar vector scalar logical operations")
-}
-
-test.vector.vector.ops <- function( ){
-    fx <- .rcpp.sugarOps$vector_vector_ops
-    x <- rnorm(10)
-    y <- runif(10)
-    checkEquals(fx(x,y), list(x + y, y - x, x * y, y / x), "sugar vector vector operations")
-}
-
-test.vector.vector.logical <- function( ){
-    fx <- .rcpp.sugarOps$vector_vector_logical
-    x <- rnorm(10)
-    y <- runif(10)
-    checkEquals(fx(x,y), list(x < y, x > y, x <= y, x >= y, x == y, x != y), "sugar vector vector operations")
-}
-
-## test.matrix.plus <- function( ){
-##     fx <- .rcpp.sugarOps$matrix_plus
-##     x <- matrix(rnorm(10), 5, 2)
-##     checkEquals(fx(x) , x + 2)
-##     #checkEquals(fx(x) , x )             # DUMMY
-## }
-
-}


From noreply at r-forge.r-project.org  Tue Jul  2 19:38:03 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue,  2 Jul 2013 19:38:03 +0200 (CEST)
Subject: [Rcpp-commits] r4388 - in pkg/Rcpp: . inst/unitTests
	inst/unitTests/cpp
Message-ID: <20130702173803.C91FA184BB4@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" )
-    }
-
 }


From noreply at r-forge.r-project.org  Wed Jul  3 11:29:28 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed,  3 Jul 2013 11:29:28 +0200 (CEST)
Subject: [Rcpp-commits] r4389 - in pkg/Rcpp: . inst/unitTests
	inst/unitTests/cpp
Message-ID: <20130703092928.1466A181299@r-forge.r-project.org>

Author: romain
Date: 2013-07-03 11:29:27 +0200 (Wed, 03 Jul 2013)
New Revision: 4389

Added:
   pkg/Rcpp/inst/unitTests/cpp/Module.cpp
   pkg/Rcpp/inst/unitTests/cpp/modref.cpp
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/unitTests/runit.Module.R
   pkg/Rcpp/inst/unitTests/runit.modref.R
Log:
more use of sourceCpp in testing

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-02 17:38:03 UTC (rev 4388)
+++ pkg/Rcpp/ChangeLog	2013-07-03 09:29:27 UTC (rev 4389)
@@ -1,3 +1,8 @@
+2013-07-03  Romain Francois <romain at r-enthusiasts.com>
+
+        * unitTests/runit.modref.R: using sourceCpp
+        * unitTests/runit.Module.R: using sourceCpp
+
 2013-07-02  Romain Francois <romain at r-enthusiasts.com>
 
         * include/Rcpp/vector/Vector.h: fill__dispatch was mispelled (as

Added: pkg/Rcpp/inst/unitTests/cpp/Module.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/Module.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/Module.cpp	2013-07-03 09:29:27 UTC (rev 4389)
@@ -0,0 +1,146 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// Module.cpp: Rcpp R/C++ interface class library -- module 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 ;
+
+std::string hello(){
+	return "hello" ;
+}
+
+int bar( int x){
+	return x*2 ;
+}
+
+double foo( int x, double y){
+	return x * y ;
+}
+
+void bla( ){
+	Rprintf( "hello\\n" ) ;
+}
+
+void bla1( int x){
+	Rprintf( "hello (x = %d)\\n", x ) ;
+}
+
+void bla2( int x, double y){
+	Rprintf( "hello (x = %d, y = %5.2f)\\n", x, y ) ;
+}
+
+class World {
+public:
+    World() : msg("hello"){}
+    void set(std::string msg_) { this->msg = msg_; }
+    std::string greet() { return msg; }
+
+private:
+    std::string msg;
+};
+
+void clearWorld( World* w ){
+	w->set( "" );
+}
+
+class Num{
+public:
+    Num() : x(0.0), y(0){} ;
+
+    double getX() const { return x ; }
+    void setX(double value){ x = value ; }
+
+    int getY() { return y ; }
+
+private:
+    double x ;
+    int y ;
+};
+    
+class Number{
+public:
+    Number() : x(0.0), y(0){} ;
+
+    double x ;
+    int y ;
+};
+    
+class Randomizer {
+public:
+
+    // Randomizer() : min(0), max(1){}
+    Randomizer( double min_, double max_) : min(min_), max(max_){}
+
+    NumericVector get( int n ){
+        RNGScope scope ;
+        return runif( n, min, max );
+    }
+
+private:
+    double min, max ;
+} ;
+
+
+RCPP_MODULE(yada){
+	function( "hello" , &hello ) ;
+	function( "bar"   , &bar   ) ;
+	function( "foo"   , &foo   ) ;
+	function( "bla"   , &bla   ) ;
+	function( "bla1"  , &bla1   ) ;
+	function( "bla2"  , &bla2   ) ;
+
+	class_<World>( "World" )
+
+	    .constructor()
+
+		.method( "greet", &World::greet )
+		.method( "set", &World::set )
+		.method( "clear", &clearWorld )
+	;
+      
+	class_<Num>( "Num" )
+	    .constructor()
+    
+        	// read and write property
+        	.property( "x", &Num::getX, &Num::setX )
+        
+        	// read-only property
+        	.property( "y", &Num::getY )
+    ;
+    
+    class_<Number>( "Number" )
+    
+        .constructor()
+    
+        	// read and write data member
+        	.field( "x", &Number::x )
+        
+        	// read only data member
+        	.field_readonly( "y", &Number::y )
+    ; 
+    
+    class_<Randomizer>( "Randomizer" )
+        // No default: .default_constructor()
+        .constructor<double,double>()
+
+        .method( "get" , &Randomizer::get ) 
+    ;
+}
+

Added: pkg/Rcpp/inst/unitTests/cpp/modref.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/modref.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/modref.cpp	2013-07-03 09:29:27 UTC (rev 4389)
@@ -0,0 +1,55 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// modref.cpp: Rcpp R/C++ interface class library -- module 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 ;
+
+class World {
+public:
+    World() : foo(1), msg("hello") {}
+    void set(std::string msg_) { this->msg = msg_; }
+    std::string greet() { return msg; }
+    
+    int foo ;
+    double bar ;
+
+private:
+    std::string msg;
+};
+
+void clearWorld( World* w ){
+    w->set( "" );
+}
+
+RCPP_MODULE(yada){
+	class_<World>( "World" )
+        .default_constructor()
+        
+        .method( "greet", &World::greet )
+        .method( "set", &World::set )
+        .method( "clear", &clearWorld )
+        
+        .field( "foo", &World::foo )
+        .field_readonly( "bar", &World::bar )
+	;
+
+}
+

Modified: pkg/Rcpp/inst/unitTests/runit.Module.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Module.R	2013-07-02 17:38:03 UTC (rev 4388)
+++ pkg/Rcpp/inst/unitTests/runit.Module.R	2013-07-03 09:29:27 UTC (rev 4389)
@@ -1,7 +1,7 @@
 #!/usr/bin/r -t
 #       hey emacs, please make this use  -*- tab-width: 4 -*-
 #
-# Copyright (C) 2010 - 2012  Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2013  Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -18,136 +18,31 @@
 # You should have received a copy of the GNU General Public License
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
-.tearDown <- function(){
-	gc()
-}
-
 .runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
 # .runThisTest <- FALSE 
 
 if( .runThisTest && Rcpp:::capabilities()[["Rcpp modules"]] ) {
 
-test.Module <- function(){
+.tearDown <- function(){
+	gc()
+}
 
-	inc  <- '
-
-	std::string hello(){
-		return "hello" ;
-	}
-
-	int bar( int x){
-		return x*2 ;
-	}
-
-	double foo( int x, double y){
-		return x * y ;
-	}
-
-	void bla( ){
-		Rprintf( "hello\\n" ) ;
-	}
-
-	void bla1( int x){
-		Rprintf( "hello (x = %d)\\n", x ) ;
-	}
-
-	void bla2( int x, double y){
-		Rprintf( "hello (x = %d, y = %5.2f)\\n", x, y ) ;
-	}
-
-	class World {
-	public:
-	    World() : msg("hello"){}
-	    void set(std::string msg_) { this->msg = msg_; }
-	    std::string greet() { return msg; }
-
-	private:
-	    std::string msg;
-	};
-
-	void clearWorld( World* w ){
-		w->set( "" );
-	}
-
-	RCPP_MODULE(yada){
-		using namespace Rcpp ;
-
-		function( "hello" , &hello ) ;
-		function( "bar"   , &bar   ) ;
-		function( "foo"   , &foo   ) ;
-		function( "bla"   , &bla   ) ;
-		function( "bla1"  , &bla1   ) ;
-		function( "bla2"  , &bla2   ) ;
-
-		class_<World>( "World" )
-
-		    .constructor()
-
-			.method( "greet", &World::greet )
-			.method( "set", &World::set )
-			.method( "clear", &clearWorld )
-		;
-
-	}
-
-	'
-	fx <- cxxfunction( signature(), "" , include = inc, plugin = "Rcpp" )
-
-	mod <- Module( "yada", getDynLib(fx) )
-	checkEquals( mod$bar( 2L ), 4L )
-	checkEquals( mod$foo( 2L, 10.0 ), 20.0 )
-	checkEquals( mod$hello(), "hello" )
-	# checkEquals( capture.output( mod$bla() ), "hello" )
-	# checkEquals( capture.output( mod$bla1(2L) ), "hello (x = 2)" )
-    # checkEquals( capture.output( mod$bla2(2L, 5.0) ), "hello (x = 2, y =  5.00)" )
-
-    World <- mod$World
+.setUp <- Rcpp:::unit_test_setup( "Module.cpp" )
+    
+test.Module <- function(){
+    checkEquals( bar( 2L ), 4L )
+    checkEquals( foo( 2L, 10.0 ), 20.0 )
+    checkEquals( hello(), "hello" )
+    
     w <- new( World )
     checkEquals( w$greet(), "hello" )
     w$set( "hello world" )
     checkEquals( w$greet(), "hello world" )
     w$clear( )
     checkEquals( w$greet(), "" )
-
-
 }
 
 test.Module.property <- function(){
-
-	inc  <- '
-	class Num{
-	public:
-	    Num() : x(0.0), y(0){} ;
-
-	    double getX() const { return x ; }
-	    void setX(double value){ x = value ; }
-
-	    int getY() { return y ; }
-
-	private:
-	    double x ;
-	    int y ;
-	};
-
-	RCPP_MODULE(yada){
-		using namespace Rcpp ;
-
-		class_<Num>( "Num" )
-
-		    .constructor()
-
-			// read and write property
-			.property( "x", &Num::getX, &Num::setX )
-
-			// read-only property
-			.property( "y", &Num::getY )
-		;
-	}
-	'
-	fx <- cxxfunction( signature(), "" , include = inc, plugin = "Rcpp" )
-
-	mod <- Module( "yada", getDynLib(fx) )
-	Num <- mod$Num
     w <- new( Num )
     checkEquals( w$x, 0.0 )
     checkEquals( w$y, 0L )
@@ -158,37 +53,7 @@
     checkException( { w$y <- 3 } )
 }
 
-
 test.Module.member <- function(){
-
-	inc  <- '
-	class Number{
-	public:
-	    Number() : x(0.0), y(0){} ;
-
-	    double x ;
-	    int y ;
-	};
-
-	RCPP_MODULE(yada){
-		using namespace Rcpp ;
-
-		class_<Number>( "Number" )
-
-		    .constructor()
-
-			// read and write data member
-			.field( "x", &Number::x )
-
-			// read only data member
-			.field_readonly( "y", &Number::y )
-		;
-	}
-	'
-	fx <- cxxfunction( signature(), "" , include = inc, plugin = "Rcpp" )
-
-	mod <- Module( "yada", getDynLib(fx) )
-	Number <- mod$Number
     w <- new( Number )
     checkEquals( w$x, 0.0 )
     checkEquals( w$y, 0L )
@@ -200,48 +65,11 @@
 }
 
 test.Module.Constructor <- function() {
-
-    inc <- '
-
-class Randomizer {
-public:
-
-    // Randomizer() : min(0), max(1){}
-    Randomizer( double min_, double max_) : min(min_), max(max_){}
-
-    NumericVector get( int n ){
-        RNGScope scope ;
-        return runif( n, min, max );
-    }
-
-private:
-    double min, max ;
-} ;
-
-RCPP_MODULE(mod){
-
-    class_<Randomizer>( "Randomizer" )
-
-        // No default: .default_constructor()
-        .constructor<double,double>()
-
-        .method( "get" , &Randomizer::get ) ;
-
-}
-'
-    fx <- cxxfunction( , '', includes = inc, plugin = "Rcpp" )
-
-    mod <- Module( "mod", getDynLib( fx ) )
-
-    Randomizer <- mod$Randomizer
     r <- new( Randomizer, 10.0, 20.0 )
     set.seed(123)
     x10 <- runif(10, 10.0, 20.0)
     set.seed(123)
     checkEquals(r$get(10), x10)
-
-    ##r <- new( Randomizer )
-    ##stopifnot(is(tryCatch(r$get(10), error = function(e)e), "error"))
 }
 
 }

Modified: pkg/Rcpp/inst/unitTests/runit.modref.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.modref.R	2013-07-02 17:38:03 UTC (rev 4388)
+++ pkg/Rcpp/inst/unitTests/runit.modref.R	2013-07-03 09:29:27 UTC (rev 4389)
@@ -1,6 +1,6 @@
 #!/usr/bin/r -t
 #
-# Copyright (C) 2010 - 2012  John Chambers, Dirk Eddelbuettel and Romain Francois
+# Copyright (C) 2010 - 2013  John Chambers, Dirk Eddelbuettel and Romain Francois
 #
 # This file is part of Rcpp.
 #
@@ -21,65 +21,25 @@
 
 if (.runThisTest) {
 
-    test.modRef <- function() {
-        inc  <- '
+.setUp <- Rcpp:::unit_test_setup( "modref.cpp" )     
+    
+test.modRef <- function() {
+    ww = new(World)
+    wg = World$new()
+    
+    checkEquals(ww$greet(), wg$greet())
+    wgg <- wg$greet()
+    
+    ww$set("Other")
+    
+    ## test independence of ww, wg
+    checkEquals(ww$greet(), "Other")
+    checkEquals(wg$greet(), wgg)
+    
+    World$methods(twice = function() paste(greet(), greet()))
+    
+    checkEquals(ww$twice(), paste(ww$greet(), ww$greet()))
 
-	class World {
-	public:
-	    World() : foo(1), msg("hello") {}
-	    void set(std::string msg_) { this->msg = msg_; }
-	    std::string greet() { return msg; }
+}
 
-	    int foo ;
-	    double bar ;
-
-	private:
-	    std::string msg;
-	};
-
-	void clearWorld( World* w ){
-		w->set( "" );
-	}
-
-	RCPP_MODULE(yada){
-		using namespace Rcpp ;
-
-		class_<World>( "World" )
-
-		    .default_constructor()
-
-			.method( "greet", &World::greet )
-			.method( "set", &World::set )
-			.method( "clear", &clearWorld )
-
-			.field( "foo", &World::foo )
-			.field_readonly( "bar", &World::bar )
-		;
-
-	}
-
-	'
-        fx <- inline::cxxfunction( signature(), "" , include = inc, plugin = "Rcpp" )
-
-        mod <- Module( "yada", getDynLib(fx) )
-
-        World <- mod$World
-
-        ww = new(World)
-        wg = World$new()
-
-        checkEquals(ww$greet(), wg$greet())
-        wgg <- wg$greet()
-
-        ww$set("Other")
-
-        ## test independence of ww, wg
-        checkEquals(ww$greet(), "Other")
-        checkEquals(wg$greet(), wgg)
-
-        World$methods(twice = function() paste(greet(), greet()))
-
-        checkEquals(ww$twice(), paste(ww$greet(), ww$greet()))
-
-    }
 }


From noreply at r-forge.r-project.org  Wed Jul  3 11:42:34 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed,  3 Jul 2013 11:42:34 +0200 (CEST)
Subject: [Rcpp-commits] r4390 - in pkg/Rcpp: . inst/doc/unitTests
	inst/unitTests inst/unitTests/cpp
Message-ID: <20130703094234.4E946181299@r-forge.r-project.org>

Author: romain
Date: 2013-07-03 11:42:33 +0200 (Wed, 03 Jul 2013)
New Revision: 4390

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/doc/unitTests/Rcpp-unitTests.R
   pkg/Rcpp/inst/unitTests/cpp/Vector.cpp
   pkg/Rcpp/inst/unitTests/runTests.R
   pkg/Rcpp/inst/unitTests/runit.Vector.R
Log:
no need for inline anymore for testing

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-03 09:29:27 UTC (rev 4389)
+++ pkg/Rcpp/ChangeLog	2013-07-03 09:42:33 UTC (rev 4390)
@@ -2,7 +2,10 @@
 
         * unitTests/runit.modref.R: using sourceCpp
         * unitTests/runit.Module.R: using sourceCpp
-
+        * unitTests/runit.Vector.R: no more uses of inline
+        * unitTests/runTests.R: we don't need inline no more for testing
+        * doc/unitTests/Rcpp-unitTests.R: idem
+        
 2013-07-02  Romain Francois <romain at r-enthusiasts.com>
 
         * include/Rcpp/vector/Vector.h: fill__dispatch was mispelled (as

Modified: pkg/Rcpp/inst/doc/unitTests/Rcpp-unitTests.R
===================================================================
--- pkg/Rcpp/inst/doc/unitTests/Rcpp-unitTests.R	2013-07-03 09:29:27 UTC (rev 4389)
+++ pkg/Rcpp/inst/doc/unitTests/Rcpp-unitTests.R	2013-07-03 09:42:33 UTC (rev 4390)
@@ -2,16 +2,7 @@
 
 # load this package
 require( pkg, character.only = TRUE )
-require( inline )
 
-if( compareVersion( packageDescription( "inline" )[["Version"]], "0.3.4.4" ) < 0 ){
-	stop( "Rcpp unit tests need at least the version 0.3.4.4 of inline" )
-}
-
-cppfunction <- function( ... ){
-	cxxfunction( ..., plugin = "Rcpp" )
-}
-
 ## Make sure we run all tests for the vignette
 Sys.setenv("RunAllRcppTests"="yes")
 

Modified: pkg/Rcpp/inst/unitTests/cpp/Vector.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/Vector.cpp	2013-07-03 09:29:27 UTC (rev 4389)
+++ pkg/Rcpp/inst/unitTests/cpp/Vector.cpp	2013-07-03 09:42:33 UTC (rev 4390)
@@ -720,5 +720,12 @@
         CharacterVector x = {"foo", "bar"} ;
         return x ;
     }
+    
+    List List_insert(){
+        List list(x) ;
+        list.insert( list.begin(), 10 ) ;
+        list.insert( list.end(), Named("foo", "bar" ) ) ;
+        return list ;
+	}
 #endif
 

Modified: pkg/Rcpp/inst/unitTests/runTests.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runTests.R	2013-07-03 09:29:27 UTC (rev 4389)
+++ pkg/Rcpp/inst/unitTests/runTests.R	2013-07-03 09:42:33 UTC (rev 4390)
@@ -1,6 +1,6 @@
 ## -*- mode: R; 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.
 ##
@@ -27,20 +27,12 @@
 
 pkg <- "Rcpp"
 
-if ( ! require( "inline", character.only = TRUE, quietly = TRUE ) ){
-    stop( "The inline package is required to run Rcpp unit tests" )
-}
-
-if ( compareVersion( packageDescription( "inline" )[["Version"]], "0.3.4.4" ) < 0 ){
-    stop( "Rcpp unit tests need at least the version 0.3.4.4 of inline" )
-}
-
 if (require("RUnit", quietly = TRUE)) {
 
     is_local <- function(){
-    	if( exists( "argv", globalenv() ) && "--local" %in% argv ) return(TRUE)
-    	if( "--local" %in% commandArgs(TRUE) ) return(TRUE)
-    	FALSE
+        if( exists( "argv", globalenv() ) && "--local" %in% argv ) return(TRUE)
+        if( "--local" %in% commandArgs(TRUE) ) return(TRUE)
+        FALSE
     }
     if (is_local() ) path <- getwd()
 

Modified: pkg/Rcpp/inst/unitTests/runit.Vector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Vector.R	2013-07-03 09:29:27 UTC (rev 4389)
+++ pkg/Rcpp/inst/unitTests/runit.Vector.R	2013-07-03 09:42:33 UTC (rev 4390)
@@ -604,65 +604,42 @@
     checkEquals( res, expected, msg = "List rep constructor" )
 }
 
+if( Rcpp:::capabilities()[["initializer lists"]] ){
 
-# test graveyard. Might come back when we can use C++11
+	test.RawVector.initializer.list <- function(){
+		checkEquals( raw_initializer_list(), as.raw(2*0:3), msg = "RawVector( initializer list) " )
+	}
 
-# if( Rcpp:::capabilities()[["initializer lists"]] ){
-# 	test.RawVector.initializer.list <- function(){
-# 		funx <- raw_initializer_list
-# 		checkEquals( funx(), as.raw(2*0:3), msg = "RawVector( initializer list) " )
-# 	}
-# }
+	test.ComplexVector.initializer.list <- function(){
+		checkEquals( complex_initializer_list(), c( 0:1*(1+1i)), msg = "ComplexVector( initializer list) " )
+	}
 
-# if( Rcpp:::capabilities()[["initializer lists"]] ){
-# 	test.ComplexVector.initializer.list <- function(){
-# 		funx <- complex_initializer_list
-# 		checkEquals( funx(), c( 0:1*(1+1i)), msg = "ComplexVector( initializer list) " )
-# 	}
-# }
+    test.IntegerVector.initializer.list <- function() {
+        checkEquals( integer_initializer_list(), 2*0:3, msg = "IntegerVector( initializer list) " )
+    }
 
-# if (Rcpp:::capabilities()[["initializer lists"]]) {
-#     test.IntegerVector.initializer.list <- function() {
-#         fun <- integer_initializer_list
-#         checkEquals( fun(), 2*0:3, msg = "IntegerVector( initializer list) " )
-#     }
-# }
+	test.NumericVector.initializer.list <- function(){
+		checkEquals( numeric_initlist(), as.numeric(2*0:3), msg = "NumericVector( initializer list) " )
+	}
 
-# if( Rcpp:::capabilities()[["initializer lists"]] ){
-# 	test.NumericVector.initializer.list <- function(){
-# 		funx <- numeric_initlist
-# 		checkEquals( funx(), as.numeric(2*0:3), msg = "NumericVector( initializer list) " )
-# 	}
-# }
+    test.List.initializer.list <- function(){
+        checkEquals( list_initializer_list(), as.list(0:2), 
+            msg = "List( initializer list) " )
+    }
 
-# if( Rcpp:::capabilities()[["initializer lists"]] ){
-#     test.List.initializer.list <- function(){
-#         fun <- list_initializer_list
-#         checkEquals( fun(), as.list(0:2), msg = "List( initializer list) " )
-#     }
-# }
+    test.List.insert <- function(){
+	    d <- list( x = 1:10, y = letters[1:10] )
+	    res <- List_insert( d )
+	    checkEquals( res,
+	        	list( 10L, x = 1:10, y = letters[1:10], foo = "bar" ),
+	        	msg = "List.insert" )
+    }
 
-# test.List.insert <- function(){
-#
-# 	funx <- cxxfunction( signature(x = "list"),
-# 	'
-# 	List list(x) ;
-# 	list.insert( list.begin(), 10 ) ;
-# 	list.insert( list.end(), Named("foo", "bar" ) ) ;
-# 	return list ;
-# 	' , plugin = "Rcpp" )
-# 	d <- list( x = 1:10, y = letters[1:10] )
-# 	res <- funx( d )
-# 	checkEquals( res,
-# 		list( 10L, x = 1:10, y = letters[1:10], foo = "bar" ),
-# 		msg = "List.insert" )
-# }
+    test.CharacterVector.initializer.list <- function() {
+        checkEquals( character_initializer_list(), c("foo","bar"),
+            msg = "CharacterVector( initializer list) " )
+    }
 
-# if (Rcpp:::capabilities()[["initializer lists"]]) {
-#     test.CharacterVector.initializer.list <- function() {
-#         fun <- character_initializer_list
-#         checkEquals( fun(), c("foo","bar"), msg = "CharacterVector( initializer list) " )
-#     }
-# }
+}
 
 }


From noreply at r-forge.r-project.org  Thu Jul 11 13:52:43 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 11 Jul 2013 13:52:43 +0200 (CEST)
Subject: [Rcpp-commits] r4391 - in pkg/Rcpp: . R inst
Message-ID: <20130711115243.2BF75185B09@r-forge.r-project.org>

Author: edd
Date: 2013-07-11 13:52:42 +0200 (Thu, 11 Jul 2013)
New Revision: 4391

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/DESCRIPTION
   pkg/Rcpp/R/Attributes.R
   pkg/Rcpp/inst/NEWS.Rd
Log:
added a new plugin 'openmp' 
(sorry about all the whitespace diffs in Attributes.R -- I really added about
four lines but emacs seems to have switches tabs and spaces...)


Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-03 09:42:33 UTC (rev 4390)
+++ pkg/Rcpp/ChangeLog	2013-07-11 11:52:42 UTC (rev 4391)
@@ -1,3 +1,7 @@
+2013-07-11  Dirk Eddelbuettel  <edd at debian.org>
+
+	* R/Attributes.R: Add an OpenMP plugin
+
 2013-07-03  Romain Francois <romain at r-enthusiasts.com>
 
         * unitTests/runit.modref.R: using sourceCpp
@@ -5,7 +9,7 @@
         * unitTests/runit.Vector.R: no more uses of inline
         * unitTests/runTests.R: we don't need inline no more for testing
         * doc/unitTests/Rcpp-unitTests.R: idem
-        
+
 2013-07-02  Romain Francois <romain at r-enthusiasts.com>
 
         * include/Rcpp/vector/Vector.h: fill__dispatch was mispelled (as
@@ -18,14 +22,14 @@
         * 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 
+        * 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&>
         when T is module exposed
         * include/Rcpp/as.h: as<T&> and as<const T&> when T is module exposed
-        * include/Rcpp/module/Module_generated_CppFunction.h: removed the 
+        * include/Rcpp/module/Module_generated_CppFunction.h: removed the
         remove_const_and_reference since as<T&> and as<const T&> is supported
-        * src/attributes.cpp: automatically populating the environment with 
+        * src/attributes.cpp: automatically populating the environment with
         the content of a module, rather than make the module object available
         in the environment
 
@@ -49,7 +53,7 @@
         * src/Module.cpp : bring a simplified version of RCPP_FUNCTION 1 .. 4
         * unitTests/runit.macros.R : removed, as RCPP_FUNCTION ... are deprecated
         * include/Rcpp/macros/preprocessor_generated.h : deprecating RCPP_FUNCTION_... macros
-        
+
 2013-06-24  Dirk Eddelbuettel  <edd at debian.org>
 
 	* inst/include/Rcpp/platform/compiler.h: Note the useful wiki page

Modified: pkg/Rcpp/DESCRIPTION
===================================================================
--- pkg/Rcpp/DESCRIPTION	2013-07-03 09:42:33 UTC (rev 4390)
+++ pkg/Rcpp/DESCRIPTION	2013-07-11 11:52:42 UTC (rev 4391)
@@ -1,6 +1,6 @@
 Package: Rcpp
 Title: Seamless R and C++ Integration
-Version: 0.10.4.1
+Version: 0.10.4.2
 Date: $Date$
 Author: Dirk Eddelbuettel and Romain Francois, with contributions 
  by Douglas Bates, John Chambers and JJ Allaire

Modified: pkg/Rcpp/R/Attributes.R
===================================================================
--- pkg/Rcpp/R/Attributes.R	2013-07-03 09:42:33 UTC (rev 4390)
+++ pkg/Rcpp/R/Attributes.R	2013-07-11 11:52:42 UTC (rev 4391)
@@ -19,11 +19,11 @@
 # Source C++ code from a file
 sourceCpp <- function(file = "",
                       code = NULL,
-                      env = globalenv(), 
+                      env = globalenv(),
                       rebuild = FALSE,
                       showOutput = verbose,
-                      verbose = getOption("verbose")) { 
-    
+                      verbose = getOption("verbose")) {
+
     # resolve code into a file if necessary
     if (!missing(code)) {
         file <- tempfile(fileext = ".cpp")
@@ -31,10 +31,10 @@
         writeLines(code, con)
         close(con)
     }
-    
+
     # resolve the file path
     file <- normalizePath(file, winslash = "/")
-    
+
     # error if the file extension isn't one supported by R CMD SHLIB
     if (! tools::file_ext(file) %in% c("cc", "cpp")) {
         stop("The filename '", basename(file), "' does not have an ",
@@ -48,35 +48,35 @@
                  "is not permitted.")
         }
     }
-     
+
     # get the context (does code generation as necessary)
-    context <- .Call("sourceCppContext", PACKAGE="Rcpp", 
+    context <- .Call("sourceCppContext", PACKAGE="Rcpp",
                      file, code, rebuild, .Platform)
-    
+
     # perform a build if necessary
     if (context$buildRequired || rebuild) {
-    
-        # print output for verbose mode 
-        if (verbose) 
-            .printVerboseOutput(context)   
-        
+
+        # print output for verbose mode
+        if (verbose)
+            .printVerboseOutput(context)
+
         # variables used to hold completed state (passed to completed hook)
         succeeded <- FALSE
         output <- NULL
-        
+
         # build dependency list
         depends <- .getSourceCppDependencies(context$depends, file)
-        
+
         # validate packages (error if package not found)
         .validatePackages(depends, context$cppSourceFilename)
-        
+
         # temporarily modify environment for the build
         envRestore <- .setupBuildEnvironment(depends, context$plugins, file)
-        
+
         # temporarily setwd to build directory
         cwd <- getwd()
         setwd(context$buildDirectory)
-          
+
         # call the onBuild hook. note that this hook should always be called
         # after .setupBuildEnvironment so subscribers are able to examine
         # the build environment
@@ -86,7 +86,7 @@
             setwd(cwd)
             return (invisible(NULL))
         }
-        
+
         # on.exit handler calls hook and restores environment and working dir
         on.exit({
             if (!succeeded)
@@ -95,26 +95,26 @@
             setwd(cwd)
             .restoreEnvironment(envRestore)
         })
-        
+
         # unload and delete existing dylib if necessary
         if (file.exists(context$previousDynlibPath)) {
             try(silent=T, dyn.unload(context$previousDynlibPath))
             file.remove(context$previousDynlibPath)
         }
-           
+
         # prepare the command (output if we are in showOutput mode)
         cmd <- paste(R.home(component="bin"), .Platform$file.sep, "R ",
-                     "CMD SHLIB ",  
+                     "CMD SHLIB ",
                      "-o ", shQuote(context$dynlibFilename), " ",
                      ifelse(rebuild, "--preclean ", ""),
                      shQuote(context$cppSourceFilename), sep="")
         if (showOutput)
             cat(cmd, "\n")
-        
+
         # execute the build -- suppressWarnings b/c when showOutput = FALSE
         # we are going to explicitly check for an error and print the output
         result <- suppressWarnings(system(cmd, intern = !showOutput))
-        
+
         # check build results
         if(!showOutput) {
             # capture output
@@ -133,50 +133,50 @@
             } else {
                 succeeded <- TRUE
             }
-        } 
+        }
         else if (!identical(as.character(result), "0")) {
             succeeded <- FALSE
             stop("Error ", result, " occurred building shared library.")
         } else {
             succeeded <- TRUE
         }
-    } 
+    }
     else {
         if (verbose)
             cat("\nNo rebuild required (use rebuild = TRUE to ",
                 "force a rebuild)\n\n", sep="")
     }
-    
+
     # load the module if we have exported symbols
     if (length(context$exportedFunctions) > 0 || length(context$modules) > 0) {
-        
+
         # remove existing objects of the same name from the environment
         exports <- c(context$exportedFunctions, context$modules)
         removeObjs <- exports[exports %in% ls(envir = env, all.names = T)]
         remove(list = removeObjs, envir = env)
-        
+
         # source the R script
-        scriptPath <- file.path(context$buildDirectory, context$rSourceFilename) 
+        scriptPath <- file.path(context$buildDirectory, context$rSourceFilename)
         source(scriptPath, local = env)
-        
+
     } else if (getOption("rcpp.warnNoExports", default=TRUE)) {
         warning("No Rcpp::export attributes or RCPP_MODULE declarations ",
                 "found in source")
     }
-    
+
     # source the embeddedR
     if (length(context$embeddedR) > 0) {
         srcConn <- textConnection(context$embeddedR)
         source(file=srcConn, echo=TRUE)
     }
-    
+
     # return (invisibly) a list containing exported functions and modules
     invisible(list(functions = context$exportedFunctions,
                    modules = context$modules))
 }
 
 # Define a single C++ function
-cppFunction <- function(code, 
+cppFunction <- function(code,
                         depends = character(),
                         plugins = character(),
                         includes = character(),
@@ -184,24 +184,24 @@
                         rebuild = FALSE,
                         showOutput = verbose,
                         verbose = getOption("verbose")) {
-    
+
     # process depends
     if (!is.null(depends) && length(depends) > 0) {
         depends <- paste(depends, sep=", ")
         scaffolding <- paste("// [[Rcpp::depends(", depends, ")]]", sep="")
-        scaffolding <- c(scaffolding, "", .linkingToIncludes(depends, FALSE), 
+        scaffolding <- c(scaffolding, "", .linkingToIncludes(depends, FALSE),
                          recursive=TRUE)
     }
     else {
         scaffolding <- "#include <Rcpp.h>"
     }
-    
+
     # process plugins
     if (!is.null(plugins) && length(plugins) > 0) {
         plugins <- paste(plugins, sep=", ")
         pluginsAttrib <- paste("// [[Rcpp::plugins(", plugins, ")]]", sep="")
         scaffolding <- c(scaffolding, pluginsAttrib)
-        
+
         # append plugin includes
         for (pluginName in plugins) {
             plugin <- .findPlugin(pluginName)
@@ -209,19 +209,19 @@
             scaffolding <- c(scaffolding, settings$includes, recursive=TRUE)
         }
     }
-    
+
     # remainder of scaffolding
-    scaffolding <- c(scaffolding, 
+    scaffolding <- c(scaffolding,
                      "",
-                     "using namespace Rcpp;", 
+                     "using namespace Rcpp;",
                      "",
                      includes,
                      "// [[Rcpp::export]]",
                      recursive = T)
-        
+
     # prepend scaffolding to code
     code <- paste(c(scaffolding, code, recursive = T), collapse="\n")
-    
+
     # print the generated code if we are in verbose mode
     if (verbose) {
         cat("\nGenerated code for function definition:",
@@ -229,18 +229,18 @@
         cat(code)
         cat("\n")
     }
-    
+
     # source cpp into specified environment. if env is set to NULL
     # then create a new one (the caller can get a hold of the function
     # via the return value)
     if (is.null(env))
         env <- new.env()
-    exported <- sourceCpp(code = code, 
-                          env = env, 
-                          rebuild = rebuild, 
+    exported <- sourceCpp(code = code,
+                          env = env,
+                          rebuild = rebuild,
                           showOutput = showOutput,
                           verbose = verbose)
-    
+
     # verify that a single function was exported and return it
     if (length(exported$functions) == 0)
         stop("No function definition found")
@@ -253,39 +253,39 @@
 }
 
 # Evaluate a simple c++ expression
-evalCpp <- function(code, 
-                    depends = character(), 
-                    includes = character(), 
+evalCpp <- function(code,
+                    depends = character(),
+                    includes = character(),
                     rebuild = FALSE,
-                    showOutput = verbose, 
+                    showOutput = verbose,
                     verbose = getOption( "verbose" ) ){
- 
-                         
+
+
     code <- sprintf( "SEXP get_value(){ return wrap( %s ) ; }", code )
     env <- new.env()
-    cppFunction(code, depends = depends, includes = includes, env = env, 
+    cppFunction(code, depends = depends, includes = includes, env = env,
                 rebuild = rebuild, showOutput = showOutput, verbose = verbose )
     fun <- env[["get_value"]]
     fun()
 }
 
-areMacrosDefined <- function(names, 
-                    depends = character(), 
-                    includes = character(), 
+areMacrosDefined <- function(names,
+                    depends = character(),
+                    includes = character(),
                     rebuild = FALSE,
-                    showOutput = verbose, 
+                    showOutput = verbose,
                     verbose = getOption( "verbose" ) ){
- 
-                         
+
+
     code <- sprintf( '
-        LogicalVector get_value(){ 
-            
-            return LogicalVector::create( 
+        LogicalVector get_value(){
+
+            return LogicalVector::create(
                 %s
             ) ;
-        }', 
-        
-        paste( sprintf( '    _["%s"] = 
+        }',
+
+        paste( sprintf( '    _["%s"] =
                 #if defined(%s)
                     true
                 #else
@@ -294,65 +294,65 @@
          ', names, names ), collapse = ",\n" )
     )
     env <- new.env()
-    cppFunction(code, depends = depends, includes = includes, env = env, 
+    cppFunction(code, depends = depends, includes = includes, env = env,
                 rebuild = rebuild, showOutput = showOutput, verbose = verbose )
     fun <- env[["get_value"]]
     fun()
 }
 
 # Scan the source files within a package for attributes and generate code
-# based on the attributes. 
+# based on the attributes.
 compileAttributes <- function(pkgdir = ".", verbose = getOption("verbose")) {
-    
+
     # verify this is a package and read the DESCRIPTION to get it's name
     pkgdir <- normalizePath(pkgdir, winslash = "/")
     descFile <- file.path(pkgdir,"DESCRIPTION")
     if (!file.exists(descFile))
         stop("pkgdir must refer to the directory containing an R package")
-    
+
     pkgInfo <- tools:::.split_description(tools:::.read_description(descFile))
     pkgname <- as.character(pkgInfo$DESCRIPTION["Package"])
     depends <- unique(names(pkgInfo$Depends))
     if (is.null(depends))
         depends <- character()
-    
+
     # determine source directory
     srcDir <- file.path(pkgdir, "src")
     if (!file.exists(srcDir))
         return (FALSE)
-    
+
     # create R directory if it doesn't already exist
     rDir <- file.path(pkgdir, "R")
     if (!file.exists(rDir))
         dir.create(rDir)
-    
+
     # get a list of all source files
     cppFiles <- list.files(srcDir, pattern=glob2rx("*.c*"))
-    
+
     # derive base names (will be used for modules)
     cppFileBasenames <- tools:::file_path_sans_ext(cppFiles)
-    
+
     # expend them to their full paths
     cppFiles <- file.path(srcDir, cppFiles)
     cppFiles <- normalizePath(cppFiles, winslash = "/")
-    
+
     # generate the includes list based on LinkingTo. Specify plugins-only
     # because we only need as/wrap declarations
     linkingTo <- as.character(pkgInfo$DESCRIPTION["LinkingTo"])
     includes <- .linkingToIncludes(linkingTo, TRUE)
-    
+
     # if a master include file is defined for the package then include it
     pkgHeader <- paste(pkgname, ".h", sep="")
     pkgHeaderPath <- file.path(pkgdir, "inst", "include",  pkgHeader)
     if (file.exists(pkgHeaderPath)) {
-        pkgInclude <- paste("#include \"../inst/include/", 
+        pkgInclude <- paste("#include \"../inst/include/",
                             pkgHeader, "\"", sep="")
         includes <- c(includes, pkgInclude)
-    } 
-    
+    }
+
     # generate exports
-    invisible(.Call("compileAttributes", PACKAGE="Rcpp", 
-                    pkgdir, pkgname, depends, cppFiles, cppFileBasenames, 
+    invisible(.Call("compileAttributes", PACKAGE="Rcpp",
+                    pkgdir, pkgname, depends, cppFiles, cppFileBasenames,
                     includes, verbose, .Platform))
 }
 
@@ -364,56 +364,62 @@
     list(env = list(PKG_CXXFLAGS ="-std=c++11"))
 }
 
+## built-in OpenMP++11 plugin
+.plugins[["openmp"]] <- function() {
+    list(env = list(PKG_CXXFLAGS="-fopenmp",
+                    PKG_LIBS="-fopenmp"))
+}
+
 # register a plugin
 registerPlugin <- function(name, plugin) {
-    .plugins[[name]] <- plugin    
+    .plugins[[name]] <- plugin
 }
 
 
 # Take an empty function body and connect it to the specified external symbol
 sourceCppFunction <- function(func, isVoid, dll, symbol) {
-    
+
     args <- names(formals(func))
-    
+
     body <- quote( .Call( EXTERNALNAME, ARG ) )[ c(1:2, rep(3, length(args))) ]
-    
-    for (i in seq(along = args)) 
+
+    for (i in seq(along = args))
         body[[i+2]] <- as.symbol(args[i])
-    
+
     body[[1L]] <- .Call
     body[[2L]] <- getNativeSymbolInfo(symbol, dll)$address
-    
+
     if (isVoid)
         body <- call("invisible", body)
-    
+
     body(func) <- body
-    
+
     func
 }
 
 
 # Print verbose output
 .printVerboseOutput <- function(context) {
-    
+
     cat("\nGenerated extern \"C\" functions",
         "\n--------------------------------------------------------\n")
     cat(context$generatedCpp, sep="")
-    
+
     cat("\nGenerated R functions",
         "\n-------------------------------------------------------\n\n")
-    cat(readLines(file.path(context$buildDirectory, 
-                            context$rSourceFilename)), 
+    cat(readLines(file.path(context$buildDirectory,
+                            context$rSourceFilename)),
         sep="\n")
-    
-    cat("\nBuilding shared library", 
+
+    cat("\nBuilding shared library",
         "\n--------------------------------------------------------\n",
         "\nDIR: ", context$buildDirectory, "\n\n", sep="")
 }
 
 # Add LinkingTo dependencies if the sourceFile is in a package
 .getSourceCppDependencies <- function(depends, sourceFile) {
-    
-    # If the source file is in a package then simulate it being built 
+
+    # If the source file is in a package then simulate it being built
     # within the package by including it's LinkingTo dependencies,
     # the src directory (.), and the inst/include directory
     if (.isPackageSourceFile(sourceFile)) {
@@ -438,7 +444,7 @@
     if (length(unavailable) > 0) {
         stop(paste("Package '", unavailable[[1]], "' referenced from ",
                     "Rcpp::depends in source file ",
-                      sourceFilename, " is not available.", 
+                      sourceFilename, " is not available.",
                       sep=""),
                 call. = FALSE)
     }
@@ -448,25 +454,25 @@
 # Get the inline plugin for the specified package (return NULL if none found)
 .getInlinePlugin <- function(package) {
     tryCatch(get("inlineCxxPlugin", asNamespace(package)),
-             error = function(e) NULL) 
+             error = function(e) NULL)
 }
 
 # Lookup a plugin (first in our package then in the inline package)
 .findPlugin <- function(pluginName) {
     # lookup in our plugins
     plugin <- .plugins[[pluginName]]
-    
+
     # if necessary lookup in the inline package
     if (is.null(plugin))
         if (length(find.package("inline", quiet=TRUE)) > 0)
             plugin <- inline:::plugins[[pluginName]]
-    
+
     # error if plugin not found
     if (is.null(plugin))
         stop("Inline plugin '", pluginName, "' could not be found ",
              "within either the Rcpp or inline package. You should be ",
              "sure to call registerPlugin before using a plugin.")
-    
+
     return(plugin)
 }
 
@@ -474,18 +480,18 @@
 # opaque object that can be passed to .restoreEnvironment to reverse whatever
 # changes that were made
 .setupBuildEnvironment <- function(depends, plugins, sourceFile) {
-    
-    # setup 
+
+    # setup
     buildEnv <- list()
     linkingToPackages <- c("Rcpp")
-    
+
     # merge values into the buildEnv
     mergeIntoBuildEnv <- function(name, value) {
-        
+
         # protect against null or empty string
         if (is.null(value) || !nzchar(value))
             return;
-        
+
         # if it doesn't exist already just set it
         if (is.null(buildEnv[[name]])) {
             buildEnv[[name]] <<- value
@@ -495,47 +501,47 @@
             buildEnv[[name]] <<- paste(buildEnv[[name]], value);
         }
         else {
-            # it already exists and it's the same value, this 
-            # likely means it's a flag-type variable so we 
+            # it already exists and it's the same value, this
+            # likely means it's a flag-type variable so we
             # do nothing rather than appending it
-        }   
+        }
     }
-    
+
     # update dependencies from a plugin
     setDependenciesFromPlugin <- function(plugin) {
-        
-        # get the plugin settings 
+
+        # get the plugin settings
         settings <- plugin()
-        
+
         # merge environment variables
         pluginEnv <- settings$env
         for (name in names(pluginEnv)) {
             mergeIntoBuildEnv(name, pluginEnv[[name]])
         }
-        
+
         # capture any LinkingTo elements defined by the plugin
-        linkingToPackages <<- unique(c(linkingToPackages, 
+        linkingToPackages <<- unique(c(linkingToPackages,
                                       settings$LinkingTo))
     }
-    
+
     # add packages to linkingTo and introspect for plugins
     for (package in depends) {
-        
+
         # add a LinkingTo for this package
         linkingToPackages <- unique(c(linkingToPackages, package))
-        
+
         # see if the package exports a plugin
         plugin <- .getInlinePlugin(package)
         if (!is.null(plugin))
-           setDependenciesFromPlugin(plugin) 
+           setDependenciesFromPlugin(plugin)
     }
-    
+
     # process plugins
     for (pluginName in plugins) {
         plugin <- .findPlugin(pluginName)
         setDependenciesFromPlugin(plugin)
     }
-    
+
     # if there is no buildEnv from a plugin then use the Rcpp plugin
     if (length(buildEnv) == 0) {
         buildEnv <- Rcpp:::inlineCxxPlugin()$env
@@ -547,10 +553,10 @@
         if (is.null(pkgLibs) || !grepl(rcppLibs, pkgLibs, fixed = TRUE))
             buildEnv$PKG_LIBS <- paste(pkgLibs, rcppLibs)
     }
-    
+
     # set CLINK_CPPFLAGS based on the LinkingTo dependencies
     buildEnv$CLINK_CPPFLAGS <- .buildClinkCppFlags(linkingToPackages)
-     
+
     # if the source file is in a package then add src and inst/include
     if (.isPackageSourceFile(sourceFile)) {
         srcDir <- dirname(sourceFile)
@@ -558,18 +564,18 @@
         incDir <- file.path(dirname(sourceFile), "..", "inst", "include")
         incDir <- asBuildPath(incDir)
         dirFlags <- paste0('-I"', c(srcDir, incDir), '"', collapse=" ")
-        buildEnv$CLINK_CPPFLAGS <- paste(buildEnv$CLINK_CPPFLAGS, 
-                                         dirFlags, 
+        buildEnv$CLINK_CPPFLAGS <- paste(buildEnv$CLINK_CPPFLAGS,
+                                         dirFlags,
                                          collapse=" ")
     }
-    
+
     # merge existing environment variables
     for (name in names(buildEnv))
         mergeIntoBuildEnv(name, Sys.getenv(name))
-    
+
     # add cygwin message muffler
     buildEnv$CYGWIN = "nodosfilewarning"
-    
+
     # on windows see if we need to add Rtools to the path
     # (don't do this for RStudio since it has it's own handling)
     if (identical(Sys.info()[['sysname']], "Windows") &&
@@ -578,58 +584,58 @@
         if (!is.null(path))
             buildEnv$PATH <- path
     }
-    
+
     # create restore list
     restore <- list()
     for (name in names(buildEnv))
         restore[[name]] <- Sys.getenv(name, unset = NA)
-        
+
     # set environment variables
     do.call(Sys.setenv, buildEnv)
-     
+
     # return restore list
     return (restore)
 }
 
 
-# If we don't have the GNU toolchain already on the path then see if 
+# If we don't have the GNU toolchain already on the path then see if
 # we can find Rtools and add it to the path
 .pathWithRtools <- function() {
-    
+
     # Only proceed if we don't have the required tools on the path
     hasRtools <- nzchar(Sys.which("ls.exe")) && nzchar(Sys.which("gcc.exe"))
     if (!hasRtools) {
-        
+
         # Read the Rtools registry key
         key <- NULL
         try(key <- utils::readRegistry("SOFTWARE\\R-core\\Rtools",
-                                       hive = "HLM", view = "32-bit"), 
+                                       hive = "HLM", view = "32-bit"),
             silent = TRUE)
-        
+
         # If we found the key examine it
         if (!is.null(key)) {
-            
+
             # Check version -- we only support 2.15 and 2.16 right now
             ver <- key$`Current Version`
             if (identical("2.15", ver) || identical("2.16", ver)) {
-                
+
                 # See if the InstallPath leads to the expected directories
                 rToolsPath <- key$`InstallPath`
                 if (!is.null(rToolsPath)) {
-                    
+
                     # Return modified PATH if execpted directories exist
                     binPath <- file.path(rToolsPath, "bin", fsep="\\")
                     gccPath <- file.path(rToolsPath, "gcc-4.6.3", "bin", fsep="\\")
                     if (file.exists(binPath) && file.exists(gccPath))
-                        return(paste(binPath, 
-                                     gccPath, 
-                                     Sys.getenv("PATH"), 
+                        return(paste(binPath,
+                                     gccPath,
+                                     Sys.getenv("PATH"),
                                      sep=.Platform$path.sep))
-                }  
+                }
             }
         }
     }
-    
+
     return(NULL)
 }
 
@@ -640,8 +646,8 @@
     for (package in linkingToPackages) {
         packagePath <- find.package(package, NULL, quiet=TRUE)
         packagePath <- asBuildPath(packagePath)
-        pkgCxxFlags <- paste(pkgCxxFlags, 
-            paste0('-I"', packagePath, '/include"'), 
+        pkgCxxFlags <- paste(pkgCxxFlags,
+            paste0('-I"', packagePath, '/include"'),
             collapse=" ")
     }
     return (pkgCxxFlags)
@@ -652,7 +658,7 @@
     setVars <- restore[!is.na(restore)]
     if (length(setVars))
         do.call(Sys.setenv, setVars)
-    
+
     # variables to remove
     removeVars <- names(restore[is.na(restore)])
     if (length(removeVars))
@@ -667,40 +673,40 @@
 # or whether it will need to be scraped from the console (for verbose=TRUE)
 # The onBuild hook is always called from within the temporary build directory
 .callBuildHook <- function(file, fromCode, showOutput) {
-        
+
     for (fun in .getHooksList("sourceCpp.onBuild")) {
-        
-        if (is.character(fun)) 
+
+        if (is.character(fun))
             fun <- get(fun)
-        
+
         # allow the hook to cancel the build (errors in the hook explicitly
         # do not cancel the build since they are unexpected bugs)
         continue <- tryCatch(fun(file, fromCode, showOutput),
                              error = function(e) TRUE)
-        
+
         if (!continue)
             return (FALSE)
-    }    
-    
+    }
+
     return (TRUE)
 }
 
 # Call the onBuildComplete hook. This hook is provided so that external tools
-# can do analysis of build errors and (for example) present them in a 
+# can do analysis of build errors and (for example) present them in a
 # navigable list. Note that the output parameter will be NULL when showOutput
-# is TRUE. Tools can try to scrape the output from the console (in an 
-# implemenentation-dependent fashion) or can simply not rely on output 
+# is TRUE. Tools can try to scrape the output from the console (in an
+# implemenentation-dependent fashion) or can simply not rely on output
 # processing in that case (since the user explicitly asked for output to be
 # printed to the console). The onBuildCompleted hook is always called within
 # the temporary build directory.
 .callBuildCompleteHook <- function(succeeded, output) {
-    
+
     # Call the hooks in reverse order to align sequencing with onBuild
     for (fun in .getHooksList("sourceCpp.onBuildComplete")) {
-        
-        if (is.character(fun)) 
+
+        if (is.character(fun))
             fun <- get(fun)
-        
+
         try(fun(succeeded, output))
     }
 }
@@ -721,21 +727,21 @@
 # is the case for generation of shims (RcppExports.cpp) and Rcpp::interfaces
 # package header files.
 .linkingToIncludes <- function(linkingTo, pluginsOnly) {
-    
+
     # This field can be NULL or empty -- in that case just return Rcpp.h
     if (is.null(linkingTo) || !nzchar(linkingTo))
         return (c("#include <Rcpp.h>"))
-    
+
     # Look for Rcpp inline plugins within the list or LinkedTo packages
     include.before <- character()
     include.after <- character()
     linkingToPackages <- .parseLinkingTo(linkingTo)
     for (package in linkingToPackages) {
-        
+
         # We already handle Rcpp internally
         if (identical(package, "Rcpp"))
             next
-        
+
         # see if there is a plugin that we can extract includes from
         plugin <- .getInlinePlugin(package)
         if (!is.null(plugin)) {
@@ -744,7 +750,7 @@
                 include.before <- c(include.before, includes$before)
                 include.after <- c(include.after, includes$after)
             }
-        } 
+        }
         # otherwise check for standard Rcpp::interfaces generated include
         else if (!pluginsOnly) {
             pkgPath <- find.package(package, NULL, quiet=TRUE)
@@ -753,21 +759,21 @@
             if (file.exists(pkgHeaderPath)) {
                 pkgInclude <- paste("#include <", pkgHeader, ">", sep="")
                 include.after <- c(include.after, pkgInclude)
-            } 
+            }
         }
     }
-    
+
     # return the includes
     c(include.before, "#include <Rcpp.h>", include.after)
 }
 
 # Analyze the plugin's includes field to determine include.before and
-# include.after. We are ONLY interested in plugins that work with Rcpp since 
-# the only types we need from includes are as/wrap marshallers. Therefore, 
+# include.after. We are ONLY interested in plugins that work with Rcpp since
+# the only types we need from includes are as/wrap marshallers. Therefore,
 # we verify that the plugin was created using Rcpp.plugin.maker and then
 # use that assumption to correctly extract include.before and include.after
 .pluginIncludes <- function(plugin) {
-      
+
     # First determine the standard suffix of an Rcpp plugin by calling
     # Rcpp.plugin.maker. If the plugin$includes has this suffix we know
     # it's an Rcpp plugin
@@ -775,15 +781,15 @@
     stockRcppPlugin <- Rcpp:::Rcpp.plugin.maker(include.after=token)
     includes <- stockRcppPlugin()$includes
     suffix <- strsplit(includes, token)[[1]][[2]]
-    
+
     # now ask the plugin for it's includes, ensure that the plugin includes
     # are not null, and verify they have the Rcpp suffix before proceeding
     pluginIncludes <- plugin()$includes
-    if (is.null(pluginIncludes)) 
+    if (is.null(pluginIncludes))
         return (NULL)
     if (!grepl(suffix, pluginIncludes))
         return (NULL)
-    
+
     # strip the suffix then split on stock Rcpp include to get before and after
     pluginIncludes <- strsplit(pluginIncludes, suffix)[[1]][[1]]
     pluginIncludes <- strsplit(pluginIncludes, c("#include <Rcpp.h>"))[[1]]
@@ -795,29 +801,29 @@
     after <- pluginIncludes[[2]]
     after <- strsplit(after, "\n")[[1]]
     after <- after[nzchar(after)]
-    
+
     # return before and after
     list(before = before, after = after)
 }
 
 # Parse a LinkingTo field into a character vector
 .parseLinkingTo <- function(linkingTo) {
-    
+
     if (is.null(linkingTo))
         return (character())
-    
+
     linkingTo <- strsplit(linkingTo, "\\s*\\,")[[1]]
     gsub("\\s", "", linkingTo)
 }
 
 # show diagnostics for failed builds
 .showBuildFailureDiagnostics <- function() {
-    
+
     # RStudio does it's own diagnostics so only do this for other environments
     if (nzchar(Sys.getenv("RSTUDIO")))
         return();
-        
-    # if we can't call R CMD SHLIB then notify the user they should 
+
+    # if we can't call R CMD SHLIB then notify the user they should
     # install the appropriate development tools
     if (!.checkDevelTools()) {
         msg <- paste("\nWARNING: The tools required to build C++ code for R ",
@@ -828,7 +834,7 @@
                               "version of Rtools:\n\n",
                               "http://cran.r-project.org/bin/windows/Rtools/\n",
                               sep="");
-            
+
         } else if (identical(sysName, "Darwin")) {
             msg <- paste(msg, "Please install Command Line Tools for XCode ",
                          "(or equivalent).\n", sep="")
@@ -842,29 +848,29 @@
 
 # check if R development tools are installed (cache successful result)
 .hasDevelTools <- FALSE
-.checkDevelTools <- function() {  
-    
-    if (!.hasDevelTools) {     
+.checkDevelTools <- function() {
+
+    if (!.hasDevelTools) {
         # create temp source file
         tempFile <- file.path(tempdir(), "foo.c")
         cat("void foo() {}\n", file = tempFile)
         on.exit(unlink(tempFile))
-        
+
         # set working directory to tempdir (revert on exit)
         oldDir <- setwd(tempdir())
         on.exit(setwd(oldDir), add = TRUE)
-        
+
         # attempt the compilation and note whether we succeed
[TRUNCATED]

To get the complete diff run:
    svnlook diff /svnroot/rcpp -r 4391

From noreply at r-forge.r-project.org  Sat Jul 13 02:41:35 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 13 Jul 2013 02:41:35 +0200 (CEST)
Subject: [Rcpp-commits] r4392 - in pkg/RcppArmadillo: . inst inst/examples
	inst/examples/kalman inst/unitTests
Message-ID: <20130713004135.19549185156@r-forge.r-project.org>

Author: edd
Date: 2013-07-13 02:41:34 +0200 (Sat, 13 Jul 2013)
New Revision: 4392

Modified:
   pkg/RcppArmadillo/ChangeLog
   pkg/RcppArmadillo/DESCRIPTION
   pkg/RcppArmadillo/inst/NEWS.Rd
   pkg/RcppArmadillo/inst/examples/fastLm.r
   pkg/RcppArmadillo/inst/examples/kalman/benchmark.R
   pkg/RcppArmadillo/inst/examples/kalman/firstExample.R
   pkg/RcppArmadillo/inst/examples/varSimulation.r
   pkg/RcppArmadillo/inst/unitTests/runTests.R
   pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
Log:
converted to use Rcpp attributes rather than inline
hence inline removed from Suggests: in DESCRIPTION


Modified: pkg/RcppArmadillo/ChangeLog
===================================================================
--- pkg/RcppArmadillo/ChangeLog	2013-07-11 11:52:42 UTC (rev 4391)
+++ pkg/RcppArmadillo/ChangeLog	2013-07-13 00:41:34 UTC (rev 4392)
@@ -1,3 +1,14 @@
+2013-07-12  Dirk Eddelbuettel  <edd at debian.org>
+
+	* inst/unitTests/runTests.R: No longer need to test minimal versions
+	of package 'inline' as unit tests now use Rcpp attributes
+	* inst/unitTests/runit.RcppArmadillo.R: Don't load package 'library'
+
+	* inst/examples/fastLm.r: Also rewritten to use Rcpp attributes
+	* inst/examples/varSimulation.r: Idem
+
+	* DESCRIPTION: Removed Suggests: on inline
+
 2013-06-04  Dirk Eddelbuettel  <edd at debian.org>
 
 	* DESCRIPTION: Release 0.3.900.0

Modified: pkg/RcppArmadillo/DESCRIPTION
===================================================================
--- pkg/RcppArmadillo/DESCRIPTION	2013-07-11 11:52:42 UTC (rev 4391)
+++ pkg/RcppArmadillo/DESCRIPTION	2013-07-13 00:41:34 UTC (rev 4392)
@@ -34,5 +34,5 @@
 LazyLoad: yes
 Depends: R (>= 2.14.0), Rcpp (>= 0.10.2)
 LinkingTo: Rcpp
-Suggests: inline, RUnit
+Suggests: RUnit
 URL: http://arma.sourceforge.net/, http://dirk.eddelbuettel.com/code/rcpp.armadillo.html, http://romainfrancois.blog.free.fr/index.php?category/R-package/RcppArmadillo

Modified: pkg/RcppArmadillo/inst/NEWS.Rd
===================================================================
--- pkg/RcppArmadillo/inst/NEWS.Rd	2013-07-11 11:52:42 UTC (rev 4391)
+++ pkg/RcppArmadillo/inst/NEWS.Rd	2013-07-13 00:41:34 UTC (rev 4392)
@@ -2,6 +2,12 @@
 \title{News for Package 'RcppArmadillo'}
 \newcommand{\cpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}}
 
+\section{Changes in RcppArmadillo version 0.3.abc (2013-xx-yy)}{
+  \itemize{
+    \item The \pkg{inline} package is no longer used in the examples and
+    unit tests which have all been converted to Rcpp attributes use
+}
+
 \section{Changes in RcppArmadillo version 0.3.900 (2013-06-04)}{
   \itemize{
     \item Upgraded to Armadillo release Version 3.900.0 (Bavarian

Modified: pkg/RcppArmadillo/inst/examples/fastLm.r
===================================================================
--- pkg/RcppArmadillo/inst/examples/fastLm.r	2013-07-11 11:52:42 UTC (rev 4391)
+++ pkg/RcppArmadillo/inst/examples/fastLm.r	2013-07-13 00:41:34 UTC (rev 4392)
@@ -2,7 +2,7 @@
 ##
 ## fastLm.r: Benchmarking lm() via RcppArmadillo and directly
 ##
-## Copyright (C)  2010 - 2012  Dirk Eddelbuettel, Romain Francois and Douglas Bates
+## Copyright (C)  2010 - 2013  Dirk Eddelbuettel, Romain Francois and Douglas Bates
 ##
 ## This file is part of RcppArmadillo.
 ##
@@ -19,12 +19,11 @@
 ## You should have received a copy of the GNU General Public License
 ## along with RcppArmadillo.  If not, see <http://www.gnu.org/licenses/>.
 
-library(inline)
+library(RcppArmadillo)
 library(rbenchmark)
 
 src <- '
-    Rcpp::NumericMatrix Xr(Xs);
-    Rcpp::NumericVector yr(ys);
+Rcpp::List fLmTwoCasts(Rcpp::NumericMatrix Xr, Rcpp::NumericVector yr) {
     int n = Xr.nrow(), k = Xr.ncol();
     arma::mat X(Xr.begin(), n, k, false);
     arma::colvec y(yr.begin(), yr.size(), false);
@@ -43,14 +42,12 @@
     return Rcpp::List::create(Rcpp::Named("coefficients")=coef,
                               Rcpp::Named("stderr")      =sderr,
                               Rcpp::Named("df")          =df);
+}
 '
+cppFunction(code=src, depends="RcppArmadillo")
 
-fLmTwoCasts <- cxxfunction(signature(Xs="numeric", ys="numeric"),
-                           src, plugin="RcppArmadillo")
-
 src <- '
-    arma::mat X = Rcpp::as<arma::mat>(Xs);
-    arma::colvec y = Rcpp::as<arma::colvec>(ys);
+Rcpp::List fLmOneCast(arma::mat X, arma::colvec y) {
     int df = X.n_rows - X.n_cols;
 
     // fit model y ~ X, extract residuals
@@ -66,12 +63,11 @@
     return Rcpp::List::create(Rcpp::Named("coefficients")=coef,
                               Rcpp::Named("stderr")      =sderr,
                               Rcpp::Named("df")          =df);
+}
 '
+cppFunction(code=src, depends="RcppArmadillo")
 
-fLmOneCast <- cxxfunction(signature(Xs="numeric", ys="numeric"),
-                          src, plugin="RcppArmadillo")
 
-
 fastLmPureDotCall <- function(X, y) {
     .Call("fastLm", X, y, PACKAGE = "RcppArmadillo")
 }

Modified: pkg/RcppArmadillo/inst/examples/kalman/benchmark.R
===================================================================
--- pkg/RcppArmadillo/inst/examples/kalman/benchmark.R	2013-07-11 11:52:42 UTC (rev 4391)
+++ pkg/RcppArmadillo/inst/examples/kalman/benchmark.R	2013-07-13 00:41:34 UTC (rev 4392)
@@ -1,5 +1,6 @@
 
-suppressMessages(library(Rcpp))
+suppressMessages(library(utils))
+suppressMessages(library(RcppArmadillo))
 suppressMessages(library(rbenchmark))
 suppressMessages(library(compiler))
 

Modified: pkg/RcppArmadillo/inst/examples/kalman/firstExample.R
===================================================================
--- pkg/RcppArmadillo/inst/examples/kalman/firstExample.R	2013-07-11 11:52:42 UTC (rev 4391)
+++ pkg/RcppArmadillo/inst/examples/kalman/firstExample.R	2013-07-13 00:41:34 UTC (rev 4392)
@@ -1,12 +1,13 @@
 
-library(inline)
+library(RcppArmadillo)
 
-g <- cxxfunction(signature(vs="numeric"), plugin="RcppArmadillo", body='
-     arma::colvec v = Rcpp::as<arma::colvec>(vs);
+cppFunction(code='
+Rcpp::List g(arma::colvec v) {
      arma::mat op = v * v.t();
      double ip = arma::as_scalar(v.t() * v);
      return Rcpp::List::create(Rcpp::Named("outer")=op,
                                Rcpp::Named("inner")=ip);
-')
+}
+', depends="RcppArmadillo")
 
 g(7:11)

Modified: pkg/RcppArmadillo/inst/examples/varSimulation.r
===================================================================
--- pkg/RcppArmadillo/inst/examples/varSimulation.r	2013-07-11 11:52:42 UTC (rev 4391)
+++ pkg/RcppArmadillo/inst/examples/varSimulation.r	2013-07-13 00:41:34 UTC (rev 4392)
@@ -3,6 +3,7 @@
 ## varSimulation.r: Simulation of first-order vector autoregression data
 ##
 ## Copyright (C)  2011  Lance Bachmeier and Dirk Eddelbuettel
+## Copyright (C)  2013  Dirk Eddelbuettel
 ##
 ## This file is part of RcppArmadillo.
 ##
@@ -20,18 +21,21 @@
 ## along with RcppArmadillo.  If not, see <http://www.gnu.org/licenses/>.
 
 
+## load Rcpp to be able to use cppFunction() below
+suppressMessages(library(Rcpp))
+
+
 ## parameter and error terms used throughout
 a <- matrix(c(0.5,0.1,0.1,0.5),nrow=2)
 e <- matrix(rnorm(10000),ncol=2)
 
-
 ## Let's start with the R version
 rSim <- function(coeff, errors) {
-  simdata <- matrix(0, nrow(errors), ncol(errors))
-  for (row in 2:nrow(errors)) {
-    simdata[row,] = coeff %*% simdata[(row-1),] + errors[row,]
-  }
-  return(simdata)
+    simdata <- matrix(0, nrow(errors), ncol(errors))
+    for (row in 2:nrow(errors)) {
+        simdata[row,] = coeff %*% simdata[(row-1),] + errors[row,]
+    }
+    return(simdata)
 }
 
 rData <- rSim(a, e)                     # generated by R
@@ -46,24 +50,22 @@
 stopifnot(all.equal(rData, compRData))  # checking results
 
 
-## Now load 'inline' to compile C++ code on the fly
-suppressMessages(require(inline))
+## C++ variant: code passed as a text variable ...
 code <- '
-  arma::mat coeff = Rcpp::as<arma::mat>(a);
-  arma::mat errors = Rcpp::as<arma::mat>(e);
-  int m = errors.n_rows; int n = errors.n_cols;
-  arma::mat simdata(m,n);
-  simdata.row(0) = arma::zeros<arma::mat>(1,n);
-  for (int row=1; row<m; row++) {
-    simdata.row(row) = simdata.row(row-1)*trans(coeff)+errors.row(row);
-  }
-  return Rcpp::wrap(simdata);
+arma::mat rcppSim(arma::mat coeff, arma::mat errors) {
+    int m = errors.n_rows;
+    int n = errors.n_cols;
+    arma::mat simdata(m,n);
+    simdata.row(0) = arma::zeros<arma::mat>(1,n);
+    for (int row=1; row<m; row++) {
+        simdata.row(row) = simdata.row(row-1)*trans(coeff)+errors.row(row);
+    }
+    return simdata;
+}
 '
+## ... which is compiled/linked/loaded here to create the compiled function
+cppFunction(code=code, depends="RcppArmadillo")
 
-## create the compiled function
-rcppSim <- cxxfunction(signature(a="numeric",e="numeric"),
-                       code,plugin="RcppArmadillo")
-
 rcppData <- rcppSim(a,e)                # generated by C++ code
 
 stopifnot(all.equal(rData, rcppData))   # checking results

Modified: pkg/RcppArmadillo/inst/unitTests/runTests.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runTests.R	2013-07-11 11:52:42 UTC (rev 4391)
+++ pkg/RcppArmadillo/inst/unitTests/runTests.R	2013-07-13 00:41:34 UTC (rev 4392)
@@ -1,24 +1,16 @@
 pkg <- "RcppArmadillo"
 
-if( ! require( "inline", character.only = TRUE, quietly = TRUE ) ){
-    stop( "The inline package is required to run RcppArmadillo unit tests" )
-}
+if (require("RUnit", quietly = TRUE)) {
 
-if( compareVersion( packageDescription( "inline" )[["Version"]], "0.3.5" ) < 0 ){
-    stop( "RcppArmadillo unit tests need at least the version 0.3.5 of inline" )
-}
-
-if(require("RUnit", quietly = TRUE)) {
-
     is_local <- function(){
-    	if( exists( "argv", globalenv() ) && "--local" %in% argv ) return(TRUE)
-    	if( "--local" %in% commandArgs(TRUE) ) return(TRUE)
+    	if (exists( "argv", globalenv() ) && "--local" %in% argv) return(TRUE)
+    	if ("--local" %in% commandArgs(TRUE)) return(TRUE)
     	FALSE
     }
-    if( is_local() ) path <- getwd()
+    if (is_local()) path <- getwd()
 
     library(package=pkg, character.only = TRUE)
-    if(!(exists("path") && file.exists(path)))
+    if (!(exists("path") && file.exists(path)))
         path <- system.file("unitTests", package = pkg)
 
     ## --- Testing ---
@@ -27,8 +19,7 @@
     testSuite <- defineTestSuite(name=paste(pkg, "unit testing"), dirs = path)
 
     if(interactive()) {
-        cat("Now have RUnit Test Suite 'testSuite' for package '", pkg,
-            "' :\n", sep='')
+        cat("Now have RUnit Test Suite 'testSuite' for package '", pkg, "' :\n", sep='')
         str(testSuite)
         cat('', "Consider doing",
             "\t  tests <- runTestSuite(testSuite)", "\nand later",
@@ -40,7 +31,7 @@
         output <- NULL
 
         process_args <- function(argv){
-            if( !is.null(argv) && length(argv) > 0 ){
+            if (!is.null(argv) && length(argv) > 0 ){
                 rx <- "^--output=(.*)$"
                 g  <- grep( rx, argv, value = TRUE )
                 if( length(g) ){
@@ -50,23 +41,23 @@
         }
 
         # R CMD check uses this
-        if( exists( "RcppArmadillo.unit.test.output.dir", globalenv() ) ){
-			output <- RcppArmadillo.unit.test.output.dir
-		} else {
+        if (exists("RcppArmadillo.unit.test.output.dir", globalenv())) {
+            output <- RcppArmadillo.unit.test.output.dir
+        } else {
 
-			# give a chance to the user to customize where he/she wants
-        	# the unit tests results to be stored with the --output= command
-        	# line argument
-        	if( exists( "argv",  globalenv() ) ){
-        	    ## littler
-        	    output <- process_args(argv)
-        	} else {
-        	    ## Rscript
-        	    output <- process_args(commandArgs(TRUE))
-        	}
+            ## give a chance to the user to customize where he/she wants
+            ## the unit tests results to be stored with the --output= command
+            ## line argument
+            if (exists( "argv",  globalenv())) {
+                ## littler
+                output <- process_args(argv)
+            } else {
+                ## Rscript
+                output <- process_args(commandArgs(TRUE))
+            }
         }
 
-        if( is.null(output) ) {         # if it did not work, use parent dir
+        if (is.null(output)) {          # if it did not work, use parent dir
             output <- ".."              # as BDR does not want /tmp to be used
         }
 
@@ -87,7 +78,7 @@
         ##  stop() if there are any failures i.e. FALSE to unit test.
         ## This will cause R CMD check to return error and stop
         err <- getErrors(tests)
-        if( (err$nFail + err$nErr) > 0) {
+        if ((err$nFail + err$nErr) > 0) {
             stop( sprintf( "unit test problems: %d failures, %d errors", err$nFail, err$nErr) )
         } else{
             success <- err$nTestFunc - err$nFail - err$nErr - err$nDeactivated
@@ -95,7 +86,6 @@
         }
     }
 } else {
-    cat("R package 'RUnit' cannot be loaded -- no unit tests run\n",
-        "for package", pkg,"\n")
+    cat("R package 'RUnit' cannot be loaded -- no unit tests run\n", "for package", pkg,"\n")
 }
 

Modified: pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R
===================================================================
--- pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2013-07-11 11:52:42 UTC (rev 4391)
+++ pkg/RcppArmadillo/inst/unitTests/runit.RcppArmadillo.R	2013-07-13 00:41:34 UTC (rev 4392)
@@ -1,6 +1,6 @@
 #!/usr/bin/r -t
 #
-# Copyright (C) 2010	Dirk Eddelbuettel, Romain Francois and Douglas Bates
+# Copyright (C) 2010 - 2013  Dirk Eddelbuettel, Romain Francois and Douglas Bates
 #
 # This file is part of RcppArmadillo.
 #
@@ -18,7 +18,7 @@
 # along with RcppArmadillo.  If not, see <http://www.gnu.org/licenses/>.
 
 .setUp <- function(){
-    suppressMessages(require(inline))
+    suppressMessages(require(RcppArmadillo))
     sourceCpp(file.path(pathRcppArmadilloTests, "cpp/armadillo.cpp"))
 }
 


From noreply at r-forge.r-project.org  Sun Jul 14 12:00:52 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 14 Jul 2013 12:00:52 +0200 (CEST)
Subject: [Rcpp-commits] r4393 - in pkg/RcppXts: . man tests
Message-ID: <20130714100052.ACD34180936@r-forge.r-project.org>

Author: edd
Date: 2013-07-14 12:00:52 +0200 (Sun, 14 Jul 2013)
New Revision: 4393

Modified:
   pkg/RcppXts/ChangeLog
   pkg/RcppXts/DESCRIPTION
   pkg/RcppXts/man/RcppXts-package.Rd
   pkg/RcppXts/tests/checks.R
Log:
added some documentation
edited basic checks.R scripts


Modified: pkg/RcppXts/ChangeLog
===================================================================
--- pkg/RcppXts/ChangeLog	2013-07-13 00:41:34 UTC (rev 4392)
+++ pkg/RcppXts/ChangeLog	2013-07-14 10:00:52 UTC (rev 4393)
@@ -1,3 +1,7 @@
+2013-07-12  Dirk Eddelbuettel  <edd at debian.org>
+
+	* man/RcppXts-package.Rd: Added some documentation for new functions
+
 2013-06-26  Dirk Eddelbuettel  <edd at debian.org>
 
 	* src/xtsMod.cpp: Added a more functions now that xts 0.9-5 is on CRAN

Modified: pkg/RcppXts/DESCRIPTION
===================================================================
--- pkg/RcppXts/DESCRIPTION	2013-07-13 00:41:34 UTC (rev 4392)
+++ pkg/RcppXts/DESCRIPTION	2013-07-14 10:00:52 UTC (rev 4393)
@@ -1,7 +1,7 @@
 Package: RcppXts
 Type: Package
 Title: Interface the xts API via Rcpp
-Version: 0.0.4
+Version: 0.0.4.1
 Date: $Date$
 Author: Dirk Eddelbuettel
 Maintainer: Dirk Eddelbuettel <edd at debian.org>

Modified: pkg/RcppXts/man/RcppXts-package.Rd
===================================================================
--- pkg/RcppXts/man/RcppXts-package.Rd	2013-07-13 00:41:34 UTC (rev 4392)
+++ pkg/RcppXts/man/RcppXts-package.Rd	2013-07-14 10:00:52 UTC (rev 4393)
@@ -8,6 +8,11 @@
 \alias{xtsRbind}
 \alias{xtsCoredata}
 \alias{xtsLag}
+\alias{xtsEndpoints}
+\alias{xtsMakeIndexUnique}
+\alias{xtsMakeUnique}
+\alias{xtsMerge}
+\alias{xtsNaOmit}
 \docType{package}
 \title{Interface to the C API of xts}
 \description{This package helps with an Rcpp-based interface to the API
@@ -20,6 +25,11 @@
   xtsRbind(x, y, dup)
   xtsCoredata(x)
   xtsLag(x, k, pad)
+  xtsEndpoints(x, on, k, addlast)
+  xtsMakeIndexUnique(x, eps)
+  xtsMakeUnique(x, eps)
+  xtsMerge(x, y, all, fill, retclass, colnames, suffixes, retside, env, coerce)
+  xtsNaOmit(x)
 }
 \arguments{
   \item{x}{an \code{xts} object}
@@ -28,9 +38,29 @@
   \item{strictly}{a boolean switch}
   \item{check}{a boolean switch}
   \item{dup}{a boolean switch whether to remove duplicates}
-  \item{k}{an integer denoting lag length}
+  \item{k}{an integer denoting lag length, or interval}
   \item{pad}{a boolean switch whether to pad}
+
+  \item{on}{a numeric value for desired distance, measure in seconds, between endpoints}
+  \item{addlast}{a boolean switch whether last value should be included}
+  \item{eps}{a numeric value for the desired minimal difference between elements}
+  \item{all}{a boolean vector with two elements indication whether left
+    or right joins are desired}
+  \item{fill}{a vector with value to be filled at the end, if needed;
+    defaults to \code{NA}}
+  \item{retclass}{a boolean switch indicating whether the return class
+    attribute should be set; default is TRUE}
+  \item{colnames}{a character vector with column names}
+  \item{suffixes}{a character vector with column name suffixes; default is NULL}
+  \item{retside}{a boolean switch of size two for the desired return
+    dimension if these need to be set}
+  \item{env}{an environment, possibly empty}
+  \item{coerce}{an integer value indicating if coercion should be forced}
 }
+\details{Please use the \pkg{xts} sources as the ultimate reference for
+  these variables. The R functions in package \pkg{xts} set some of
+  these values up, and the \pkg{RcppXts} package could eventually shadow
+  some of this.}
 \author{Dirk Eddelbuettel}
 \keyword{package}
 \seealso{\code{\link[xts:xts-package]{xts}}}

Modified: pkg/RcppXts/tests/checks.R
===================================================================
--- pkg/RcppXts/tests/checks.R	2013-07-13 00:41:34 UTC (rev 4392)
+++ pkg/RcppXts/tests/checks.R	2013-07-14 10:00:52 UTC (rev 4393)
@@ -1,4 +1,8 @@
 
+## The function calls just validate that by going via RcppXts to xts, we still obtain
+## the same xts functionality.  The main purpose of this package is still to access xts
+## functionality while at the C++ layer.
+
 library(RcppXts)
 
 options("digits.secs"=6)
@@ -31,12 +35,19 @@
 xtsEndpoints(index(X), 60L, 4, TRUE)     # every fourth minute, incl last
 xtsEndpoints(index(X), 60L, 4, FALSE)    # every fourth minute
 
-xtsMerge(X, X2, c(TRUE,TRUE), TRUE, TRUE, "a", "b", TRUE, new.env(), 0)
+#stop("now")
+#xtsMerge(X, X2, c(TRUE,TRUE), TRUE, TRUE, "a", "b", TRUE, new.env(), 0)
+Y <- 2*X
+#index(Y) <- index(Y) + runif(length(X)) * 0.01
+#xtsMerge(X, Y, c(TRUE,TRUE), TRUE, TRUE, "a", "b", TRUE, new.env(), 0)
 
-Y2 <- Y
+Y2 <- Y[1:10]
 Y2[2] <- NA
 xtsNaOmit(Y2)
 
+xtsMerge(X, X, c(TRUE,TRUE), TRUE, TRUE, c("a", "b"), NULL, TRUE, new.env(), 0)
+
+
 ## -- requires xts 0.9-6 (fixed in SVN)
 ## Y2 <- X2
 ## Y2[3] <- NA


From noreply at r-forge.r-project.org  Wed Jul 17 12:02:17 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 17 Jul 2013 12:02:17 +0200 (CEST)
Subject: [Rcpp-commits] r4394 - in pkg/Rcpp: . inst inst/include
	inst/include/Rcpp inst/include/Rcpp/api/meat
	inst/include/Rcpp/vector inst/unitTests
Message-ID: <20130717100217.6FF4B1801C7@r-forge.r-project.org>

Author: romain
Date: 2013-07-17 12:02:17 +0200 (Wed, 17 Jul 2013)
New Revision: 4394

Added:
   pkg/Rcpp/inst/include/Rcpp/api/meat/is.h
   pkg/Rcpp/inst/include/Rcpp/is.h
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/NEWS.Rd
   pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h
   pkg/Rcpp/inst/include/Rcpp/vector/instantiation.h
   pkg/Rcpp/inst/include/RcppCommon.h
   pkg/Rcpp/inst/unitTests/runit.Date.R
   pkg/Rcpp/inst/unitTests/runit.S4.R
   pkg/Rcpp/inst/unitTests/runit.String.R
   pkg/Rcpp/inst/unitTests/runit.Vector.R
   pkg/Rcpp/inst/unitTests/runit.wstring.R
Log:
first pass at implementing Rcpp::is<T>

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/ChangeLog	2013-07-17 10:02:17 UTC (rev 4394)
@@ -1,3 +1,9 @@
+2013-07-17  Romain Francois <romain at r-enthusiasts.com>
+
+        * include/Rcpp/vector/instantiation.h: added the DoubleVector alias
+        to NumericVector
+        * include/Rcpp/is.h: added is template function
+
 2013-07-11  Dirk Eddelbuettel  <edd at debian.org>
 
 	* R/Attributes.R: Add an OpenMP plugin

Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/NEWS.Rd	2013-07-17 10:02:17 UTC (rev 4394)
@@ -12,6 +12,12 @@
       stack traces.
       \item \code{as<T&>} and \code{as<const T&>} is now supported, when 
       T is a class exposed by modules, i.e. with \code{RCPP_EXPOSED_CLASS}
+      \item \code{DoubleVector} as been added as an alias to 
+      \code{NumericVector}
+      \item New template function \code{is<T>} to identify if an R object 
+      can be seen as a \code{T}. For example \code{is<DataFrame>(x)}. 
+      This is a building block for more expressive dispatch in various places
+      (modules and attributes functions). 
     }
 
     \item Changes in Attributes:

Added: pkg/Rcpp/inst/include/Rcpp/api/meat/is.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/api/meat/is.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/api/meat/is.h	2013-07-17 10:02:17 UTC (rev 4394)
@@ -0,0 +1,143 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// is.h: Rcpp R/C++ interface class library -- is implementations 
+//
+// 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/>.
+
+#ifndef Rcpp_api_meat_is_h
+#define Rcpp_api_meat_is_h
+
+namespace Rcpp{ 
+    
+    inline bool is_atomic( SEXP x){ return Rf_length(x) == 1 ; } 
+    inline bool is_matrix(SEXP x){
+        SEXP dim = Rf_getAttrib( x, R_DimSymbol) ;
+        return dim != R_NilValue && Rf_length(dim) == 2 ;
+    }
+    
+    template <> inline bool is<int>( SEXP x ){
+        return is_atomic(x) && TYPEOF(x) == INTSXP ;
+    }
+
+    template <> inline bool is<double>( SEXP x ){
+        return is_atomic(x) && TYPEOF(x) == REALSXP ;
+    }
+    
+    template <> inline bool is<bool>( SEXP x ){
+        return is_atomic(x) && TYPEOF(x) == LGLSXP ;
+    }
+    
+    template <> inline bool is<std::string>( SEXP x ){
+        return is_atomic(x) && TYPEOF(x) == STRSXP ;
+    }
+    
+    template <> inline bool is<String>( SEXP x ){
+        return is_atomic(x) && TYPEOF(x) == STRSXP ;
+    }
+    
+    template <> inline bool is<RObject>( SEXP x ){
+        return true ;
+    }
+    template <> inline bool is<IntegerVector>( SEXP x ){
+        return TYPEOF(x) == INTSXP ;
+    }
+    template <> inline bool is<ComplexVector>( SEXP x ){
+        return TYPEOF(x) == CPLXSXP ;
+    }
+    template <> inline bool is<RawVector>( SEXP x ){
+        return TYPEOF(x) == RAWSXP ;
+    }
+    template <> inline bool is<NumericVector>( SEXP x ){
+        return TYPEOF(x) == REALSXP ;
+    }
+    template <> inline bool is<LogicalVector>( SEXP x ){
+        return TYPEOF(x) == LGLSXP ;
+    }
+    template <> inline bool is<List>( SEXP x ){
+        return TYPEOF(x) == VECSXP ;
+    }
+    template <> inline bool is<IntegerMatrix>( SEXP x ){
+        return TYPEOF(x) == INTSXP && is_matrix(x) ;
+    }
+    template <> inline bool is<ComplexMatrix>( SEXP x ){
+        return TYPEOF(x) == CPLXSXP && is_matrix(x) ;
+    }
+    template <> inline bool is<RawMatrix>( SEXP x ){
+        return TYPEOF(x) == RAWSXP && is_matrix(x) ;
+    }
+    template <> inline bool is<NumericMatrix>( SEXP x ){
+        return TYPEOF(x) == REALSXP && is_matrix(x) ;
+    }
+    template <> inline bool is<LogicalMatrix>( SEXP x ){
+        return TYPEOF(x) == LGLSXP && is_matrix(x) ;
+    }
+    template <> inline bool is<GenericMatrix>( SEXP x ){
+        return TYPEOF(x) == VECSXP && is_matrix(x) ;
+    }
+    
+    
+    template <> inline bool is<DataFrame>( SEXP x ){
+        if( TYPEOF(x) != VECSXP ) return false ;
+        return Rf_inherits( x, "data.frame" ) ;
+    }
+    template <> inline bool is<WeakReference>( SEXP x ){
+        return TYPEOF(x) == WEAKREFSXP ;
+    }
+    template <> inline bool is<Symbol>( SEXP x ){
+        return TYPEOF(x) == SYMSXP ;
+    }
+    template <> inline bool is<S4>( SEXP x ){
+        return ::Rf_isS4(x);
+    }
+    template <> inline bool is<Reference>( SEXP x ){
+        if( ! ::Rf_isS4(x) ) return false ;
+        return ::Rf_inherits(x, "envRefClass" ) ;
+    }
+    template <> inline bool is<Promise>( SEXP x ){
+        return TYPEOF(x) == PROMSXP ;
+    }
+    template <> inline bool is<Pairlist>( SEXP x ){
+        return TYPEOF(x) == LISTSXP ;
+    }
+    template <> inline bool is<Function>( SEXP x ){
+        return TYPEOF(x) == CLOSXP || TYPEOF(x) == SPECIALSXP || TYPEOF(x) == BUILTINSXP ;
+    }
+    template <> inline bool is<Environment>( SEXP x ){
+        return TYPEOF(x) == ENVSXP ;
+    }
+    template <> inline bool is<Formula>( SEXP x ){
+        if( TYPEOF(x) != LANGSXP ) return false ; 
+        return Rf_inherits( x, "formula" ) ;
+    }
+    
+    template <> inline bool is<Date>( SEXP x ){
+        return is_atomic(x) && TYPEOF(x) == REALSXP && Rf_inherits( x, "Date" ) ;
+    }
+    template <> inline bool is<Datetime>( SEXP x ){
+        return is_atomic(x) && TYPEOF(x) == REALSXP && Rf_inherits( x, "POSIXt" ) ;
+    }
+    template <> inline bool is<DateVector>( SEXP x ){
+        return TYPEOF(x) == REALSXP && Rf_inherits( x, "Date" ) ;
+    }
+    template <> inline bool is<DatetimeVector>( SEXP x ){
+        return TYPEOF(x) == REALSXP && Rf_inherits( x, "POSIXt" ) ;
+    }
+     
+} // namespace Rcpp
+
+#endif

Modified: pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/include/Rcpp/api/meat/meat.h	2013-07-17 10:02:17 UTC (rev 4394)
@@ -28,5 +28,6 @@
 #include <Rcpp/api/meat/Vector.h>
 #include <Rcpp/api/meat/Matrix.h>
 #include <Rcpp/api/meat/Reference.h>
+#include <Rcpp/api/meat/is.h>
 
 #endif

Added: pkg/Rcpp/inst/include/Rcpp/is.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/is.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/is.h	2013-07-17 10:02:17 UTC (rev 4394)
@@ -0,0 +1,37 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; indent-tabs-mode: nil; -*-
+//
+// is.h: Rcpp R/C++ interface class library -- test if an R Object can be seen 
+//                                             as one type
+//
+// 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/>.
+
+#ifndef Rcpp__is__h
+#define Rcpp__is__h
+
+namespace Rcpp{
+
+    /** identify if an x can be seen as the T type
+     *  
+     *  example:
+     *     bool is_list = is<List>( x ) ;
+     */
+    template <typename T> bool is( SEXP x ) ;
+    
+} // Rcpp 
+
+#endif

Modified: pkg/Rcpp/inst/include/Rcpp/vector/instantiation.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/vector/instantiation.h	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/include/Rcpp/vector/instantiation.h	2013-07-17 10:02:17 UTC (rev 4394)
@@ -2,7 +2,7 @@
 //
 // instantiation.h: Rcpp R/C++ interface class library -- 
 //
-// Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2010 - 2013 Dirk Eddelbuettel and Romain Francois
 //
 // This file is part of Rcpp.
 //
@@ -26,6 +26,7 @@
 typedef Vector<INTSXP> IntegerVector ;
 typedef Vector<LGLSXP> LogicalVector ;
 typedef Vector<REALSXP> NumericVector ;
+typedef Vector<REALSXP> DoubleVector ;
 typedef Vector<RAWSXP> RawVector ;
 
 typedef Vector<STRSXP> CharacterVector ;   

Modified: pkg/Rcpp/inst/include/RcppCommon.h
===================================================================
--- pkg/Rcpp/inst/include/RcppCommon.h	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/include/RcppCommon.h	2013-07-17 10:02:17 UTC (rev 4394)
@@ -110,6 +110,7 @@
 #include <Rcpp/internal/export.h>
 #include <Rcpp/internal/r_coerce.h>
 #include <Rcpp/as.h>
+#include <Rcpp/is.h>
 
 #include <Rcpp/vector/VectorBase.h>
 #include <Rcpp/vector/MatrixBase.h>

Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R	2013-07-17 10:02:17 UTC (rev 4394)
@@ -22,10 +22,7 @@
 
 if (.runThisTest) {
 
-.setUp <- function(){
-    if (!exists("pathRcppTests")) pathRcppTests <- getwd()
-    sourceCpp(file.path(pathRcppTests, "cpp/dates.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup("dates.cpp")
 
 test.Date.ctor.sexp <- function() {
     fun <- ctor_sexp

Modified: pkg/Rcpp/inst/unitTests/runit.S4.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.S4.R	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.S4.R	2013-07-17 10:02:17 UTC (rev 4394)
@@ -21,9 +21,7 @@
 
 if (.runThisTest) {
 
-.setUp <- function() {
-    sourceCpp(file.path(pathRcppTests, "cpp/S4.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup( "S4.cpp" )
 
 test.RObject.S4methods <- function(){
 	setClass("track", representation(x="numeric", y="numeric"))

Modified: pkg/Rcpp/inst/unitTests/runit.String.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.String.R	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.String.R	2013-07-17 10:02:17 UTC (rev 4394)
@@ -22,10 +22,7 @@
 
 if (.runThisTest) {
 
-.setUp <- function(){
-    #sourceCpp( system.file( "unitTests/cpp/String.cpp" , package = "Rcpp" ) )
-    sourceCpp(file.path(pathRcppTests, "cpp/String.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup( "String.cpp" )
 
 test.replace_all <- function(){
     checkEquals( String_replace_all("foobar", "o", "*"), "f**bar")

Modified: pkg/Rcpp/inst/unitTests/runit.Vector.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Vector.R	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.Vector.R	2013-07-17 10:02:17 UTC (rev 4394)
@@ -22,10 +22,7 @@
 
 if (.runThisTest) {
 
-.setUp <- function() {
-    #sourceCpp( system.file( "unitTests/cpp/Vector.cpp", package = "Rcpp" ) )
-    sourceCpp(file.path(pathRcppTests, "cpp/Vector.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup("Vector.cpp")
 
 test.RawVector <- function(){
 	funx <- raw_

Modified: pkg/Rcpp/inst/unitTests/runit.wstring.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.wstring.R	2013-07-14 10:00:52 UTC (rev 4393)
+++ pkg/Rcpp/inst/unitTests/runit.wstring.R	2013-07-17 10:02:17 UTC (rev 4394)
@@ -23,10 +23,7 @@
 
 if (.runThisTest) {
 
-.setUp <- function(){
-    if (!exists("pathRcppTests")) pathRcppTests <- getwd()
-    sourceCpp(file.path(pathRcppTests, "cpp/wstring.cpp"))
-}
+.setUp <- Rcpp:::unit_test_setup( "wstring.cpp" )
 
 test.CharacterVector_wstring <- function(){
     res <- CharacterVector_wstring()


From noreply at r-forge.r-project.org  Sat Jul 20 06:17:33 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 20 Jul 2013 06:17:33 +0200 (CEST)
Subject: [Rcpp-commits] r4395 - pkg/Rcpp/inst/doc
Message-ID: <20130720041733.6818D184EAB@r-forge.r-project.org>

Author: edd
Date: 2013-07-20 06:17:33 +0200 (Sat, 20 Jul 2013)
New Revision: 4395

Modified:
   pkg/Rcpp/inst/doc/Rcpp.bib
Log:
typos


Modified: pkg/Rcpp/inst/doc/Rcpp.bib
===================================================================
--- pkg/Rcpp/inst/doc/Rcpp.bib	2013-07-17 10:02:17 UTC (rev 4394)
+++ pkg/Rcpp/inst/doc/Rcpp.bib	2013-07-20 04:17:33 UTC (rev 4395)
@@ -548,8 +548,8 @@
   title = 	 {The C++ Programming Language},
   publisher = 	 {Addison-Wesley},
   address =	 {Boston},
-  year = 	 1997,
-  page =         1368,
+  year = 	 2013,
+  pages =        1368,
   edition = 	 {4th}
 }
 


From noreply at r-forge.r-project.org  Sun Jul 21 22:33:36 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sun, 21 Jul 2013 22:33:36 +0200 (CEST)
Subject: [Rcpp-commits] r4396 - pkg/Rcpp/inst/doc
Message-ID: <20130721203336.9C41C18548B@r-forge.r-project.org>

Author: edd
Date: 2013-07-21 22:33:36 +0200 (Sun, 21 Jul 2013)
New Revision: 4396

Modified:
   pkg/Rcpp/inst/doc/Rcpp.bib
Log:
updated R entry


Modified: pkg/Rcpp/inst/doc/Rcpp.bib
===================================================================
--- pkg/Rcpp/inst/doc/Rcpp.bib	2013-07-20 04:17:33 UTC (rev 4395)
+++ pkg/Rcpp/inst/doc/Rcpp.bib	2013-07-21 20:33:36 UTC (rev 4396)
@@ -483,8 +483,7 @@
   author =	 RCoreTeam,
   organization = RFoundation,
   address =	 {Vienna, Austria},
-  year =	 2012,
-  note =	 {{ISBN} 3-900051-07-0},
+  year =	 2013,
   url =		 {http://www.R-project.org/},
 }
 


From noreply at r-forge.r-project.org  Tue Jul 23 16:02:05 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 23 Jul 2013 16:02:05 +0200 (CEST)
Subject: [Rcpp-commits] r4397 - pkg/Rcpp/inst
Message-ID: <20130723140205.49EEF184D17@r-forge.r-project.org>

Author: edd
Date: 2013-07-23 16:02:04 +0200 (Tue, 23 Jul 2013)
New Revision: 4397

Modified:
   pkg/Rcpp/inst/NEWS.Rd
Log:
added missing semicolon


Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd	2013-07-21 20:33:36 UTC (rev 4396)
+++ pkg/Rcpp/inst/NEWS.Rd	2013-07-23 14:02:04 UTC (rev 4397)
@@ -2,7 +2,7 @@
 \title{News for Package 'Rcpp'}
 \newcommand{\cpkg}{\href{http://CRAN.R-project.org/package=#1}{\pkg{#1}}}
 
-  \section{Changes in Rcpp version 0.10.5 (future)}{
+\section{Changes in Rcpp version 0.10.5 (future)}{
   \itemize{
 
     \item Changes in Rcpp API:
@@ -47,8 +47,9 @@
       up-to-date code, such as using 'Rcpp attributes' or 'Rcpp modules'.  
     }
   }
-  
-  \section{Changes in Rcpp version 0.10.4 (2013-06-23)}{
+}
+
+\section{Changes in Rcpp version 0.10.4 (2013-06-23)}{
   \itemize{
     \item Changes in R code: None beyond those detailed for Rcpp Attributes
     \item Changes in Rcpp attributes:


From noreply at r-forge.r-project.org  Tue Jul 23 17:04:47 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 23 Jul 2013 17:04:47 +0200 (CEST)
Subject: [Rcpp-commits] r4398 - in pkg/Rcpp: . inst/include/Rcpp
	inst/include/Rcpp/macros inst/include/Rcpp/traits
	inst/unitTests inst/unitTests/cpp
Message-ID: <20130723150447.9034A185692@r-forge.r-project.org>

Author: romain
Date: 2013-07-23 17:04:47 +0200 (Tue, 23 Jul 2013)
New Revision: 4398

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/as.h
   pkg/Rcpp/inst/include/Rcpp/macros/module.h
   pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h
   pkg/Rcpp/inst/include/Rcpp/traits/un_pointer.h
   pkg/Rcpp/inst/unitTests/cpp/Module.cpp
   pkg/Rcpp/inst/unitTests/runit.Module.R
Log:
adding as<T*> and as<const T*> for T exposed by modules

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-23 14:02:04 UTC (rev 4397)
+++ pkg/Rcpp/ChangeLog	2013-07-23 15:04:47 UTC (rev 4398)
@@ -1,3 +1,14 @@
+2013-07-23  Romain Francois <romain at r-enthusiasts.com>
+
+        * include/Rcpp/as.h: support as<T*> and as<const T*> where T is a class
+        exposed by modules
+        * include/Rcpp/macros/module.h: idem
+        * include/Rcpp/traits/un_pointer.h: handle the object<T> case
+        * include/Rcpp/traits/r_type_traits.h: adding traits to help the 
+        with as<T*> and as<const T*>
+        * unitTests/runit.Module.R: testing as<T*> and as<const T*>
+        * unitTests/cpp/Module.cpp: idem
+
 2013-07-17  Romain Francois <romain at r-enthusiasts.com>
 
         * include/Rcpp/vector/instantiation.h: added the DoubleVector alias

Modified: pkg/Rcpp/inst/include/Rcpp/as.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/as.h	2013-07-23 14:02:04 UTC (rev 4397)
+++ pkg/Rcpp/inst/include/Rcpp/as.h	2013-07-23 15:04:47 UTC (rev 4398)
@@ -89,8 +89,13 @@
         }
         
         /** handling object<T> */ 
+        template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_const_pointer_tag ) {
+            typedef typename Rcpp::traits::remove_const<T>::type T_NON_CONST ;
+            return const_cast<T>( as_module_object<T_NON_CONST>( x ) ) ;
+        }
+        
         template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_pointer_tag ) {
-            return as_module_object<typename T::object_type>( x ) ;
+            return as_module_object<typename traits::un_pointer<T>::type>( x ) ;
         }
         
         /** handling T such that T is exposed by a module */

Modified: pkg/Rcpp/inst/include/Rcpp/macros/module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/macros/module.h	2013-07-23 14:02:04 UTC (rev 4397)
+++ pkg/Rcpp/inst/include/Rcpp/macros/module.h	2013-07-23 15:04:47 UTC (rev 4398)
@@ -29,6 +29,12 @@
  */
 #define RCPP_EXPOSED_AS(CLASS)                                         \
     namespace Rcpp{ namespace traits{                                  \
+    template<> struct r_type_traits< CLASS* >{                         \
+        typedef r_type_module_object_pointer_tag r_category ;          \
+    } ;                                                                \
+    template<> struct r_type_traits< const CLASS* >{                   \
+        typedef r_type_module_object_const_pointer_tag r_category ;    \
+    } ;                                                                \
     template<> struct r_type_traits< CLASS >{                          \
         typedef r_type_module_object_tag r_category ;                  \
     } ;                                                                \

Modified: pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h	2013-07-23 14:02:04 UTC (rev 4397)
+++ pkg/Rcpp/inst/include/Rcpp/traits/r_type_traits.h	2013-07-23 15:04:47 UTC (rev 4398)
@@ -61,11 +61,16 @@
 struct r_type_pairstring_generic_tag{} ;
 
 /**
- * identifies a module object pointer (i.e. something like object<T>
+ * identifies a module object pointer
  */ 
 struct r_type_module_object_pointer_tag{} ;
 
 /**
+ * identifies a module object const pointer 
+ */ 
+struct r_type_module_object_const_pointer_tag{} ;
+
+/**
  * identifies a module object. Implementers of modules can define the 
  * r_type_traits to show that their object is handled
  */ 

Modified: pkg/Rcpp/inst/include/Rcpp/traits/un_pointer.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/un_pointer.h	2013-07-23 14:02:04 UTC (rev 4397)
+++ pkg/Rcpp/inst/include/Rcpp/traits/un_pointer.h	2013-07-23 15:04:47 UTC (rev 4398)
@@ -3,7 +3,7 @@
 //
 // un_pointer.h: Rcpp R/C++ interface class library -- 
 //
-// Copyright (C) 2012 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2012-2013 Dirk Eddelbuettel and Romain Francois
 //
 // This file is part of Rcpp.
 //
@@ -28,6 +28,7 @@
 	
 template <typename T> struct un_pointer { typedef T type ;} ;
 template <typename T> struct un_pointer<T*> { typedef T type ;} ;
+template <typename T> struct un_pointer< object<T> > { typedef T* type ;} ;
 
 } // namespace traits
 } // namespace Rcpp

Modified: pkg/Rcpp/inst/unitTests/cpp/Module.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/Module.cpp	2013-07-23 14:02:04 UTC (rev 4397)
+++ pkg/Rcpp/inst/unitTests/cpp/Module.cpp	2013-07-23 15:04:47 UTC (rev 4398)
@@ -73,7 +73,8 @@
     double x ;
     int y ;
 };
-    
+   
+RCPP_EXPOSED_CLASS(Number)
 class Number{
 public:
     Number() : x(0.0), y(0){} ;
@@ -97,7 +98,26 @@
     double min, max ;
 } ;
 
+// [[Rcpp::export]]
+double Number_get_x_const_ref( const Number& x){
+    return x.x ;    
+}
 
+// [[Rcpp::export]]
+double Number_get_x_ref( Number& x){
+    return x.x ;    
+}
+
+// [[Rcpp::export]]
+double Number_get_x_const_pointer( const Number* x){
+    return x->x ;    
+}
+
+// [[Rcpp::export]]
+double Number_get_x_pointer( Number* x){
+    return x->x ;    
+}
+
 RCPP_MODULE(yada){
 	function( "hello" , &hello ) ;
 	function( "bar"   , &bar   ) ;

Modified: pkg/Rcpp/inst/unitTests/runit.Module.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Module.R	2013-07-23 14:02:04 UTC (rev 4397)
+++ pkg/Rcpp/inst/unitTests/runit.Module.R	2013-07-23 15:04:47 UTC (rev 4398)
@@ -19,7 +19,6 @@
 # along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
 
 .runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
-# .runThisTest <- FALSE 
 
 if( .runThisTest && Rcpp:::capabilities()[["Rcpp modules"]] ) {
 
@@ -42,6 +41,14 @@
     checkEquals( w$greet(), "" )
 }
 
+test.Module.exposed.class <- function(){
+    num <- new( Number )
+    checkEquals( Number_get_x_const_ref(num), 0.0 )
+    checkEquals( Number_get_x_const_pointer(num), 0.0 )
+    checkEquals( Number_get_x_ref(num), 0.0 )
+    checkEquals( Number_get_x_pointer(num), 0.0 )
+}
+
 test.Module.property <- function(){
     w <- new( Num )
     checkEquals( w$x, 0.0 )


From noreply at r-forge.r-project.org  Tue Jul 23 19:01:42 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 23 Jul 2013 19:01:42 +0200 (CEST)
Subject: [Rcpp-commits] r4399 - in pkg/Rcpp/inst: include/Rcpp unitTests/cpp
Message-ID: <20130723170142.73180183E5C@r-forge.r-project.org>

Author: romain
Date: 2013-07-23 19:01:42 +0200 (Tue, 23 Jul 2013)
New Revision: 4399

Modified:
   pkg/Rcpp/inst/include/Rcpp/String.h
   pkg/Rcpp/inst/include/Rcpp/as.h
   pkg/Rcpp/inst/unitTests/cpp/Module.cpp
Log:
more as<> support

Modified: pkg/Rcpp/inst/include/Rcpp/String.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/String.h	2013-07-23 15:04:47 UTC (rev 4398)
+++ pkg/Rcpp/inst/include/Rcpp/String.h	2013-07-23 17:01:42 UTC (rev 4399)
@@ -331,6 +331,9 @@
         bool operator==( const Rcpp::String& other) const {
             return get_sexp() == other.get_sexp() ;   
         }
+        bool operator!=( const Rcpp::String& other) const {
+            return get_sexp() != other.get_sexp() ;   
+        }
         
         bool operator>( const Rcpp::String& other ) const {
             return strcmp( get_cstring(), other.get_cstring() ) > 0;   

Modified: pkg/Rcpp/inst/include/Rcpp/as.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/as.h	2013-07-23 15:04:47 UTC (rev 4398)
+++ pkg/Rcpp/inst/include/Rcpp/as.h	2013-07-23 17:01:42 UTC (rev 4399)
@@ -91,7 +91,7 @@
         /** handling object<T> */ 
         template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_const_pointer_tag ) {
             typedef typename Rcpp::traits::remove_const<T>::type T_NON_CONST ;
-            return const_cast<T>( as_module_object<T_NON_CONST>( x ) ) ;
+            return const_cast<T>( (T_NON_CONST)as_module_object_internal(x) ) ;
         }
         
         template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_pointer_tag ) {
@@ -105,7 +105,8 @@
         }
         
         /** handling T such that T is a reference of a class handled by a module */
-        template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_reference_tag ){
+        template <typename T> 
+        T as(SEXP x, ::Rcpp::traits::r_type_module_object_reference_tag ){
             typedef typename traits::remove_reference<T>::type KLASS ;
             KLASS* obj = as_module_object<KLASS>(x) ;
             return *obj ;

Modified: pkg/Rcpp/inst/unitTests/cpp/Module.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/Module.cpp	2013-07-23 15:04:47 UTC (rev 4398)
+++ pkg/Rcpp/inst/unitTests/cpp/Module.cpp	2013-07-23 17:01:42 UTC (rev 4399)
@@ -98,22 +98,15 @@
     double min, max ;
 } ;
 
-// [[Rcpp::export]]
 double Number_get_x_const_ref( const Number& x){
     return x.x ;    
 }
-
-// [[Rcpp::export]]
 double Number_get_x_ref( Number& x){
     return x.x ;    
 }
-
-// [[Rcpp::export]]
 double Number_get_x_const_pointer( const Number* x){
     return x->x ;    
 }
-
-// [[Rcpp::export]]
 double Number_get_x_pointer( Number* x){
     return x->x ;    
 }
@@ -154,8 +147,13 @@
         
         	// read only data member
         	.field_readonly( "y", &Number::y )
-    ; 
+    ;
+    function( "Number_get_x_const_ref", Number_get_x_const_ref ); 
+    function( "Number_get_x_ref", Number_get_x_ref ); 
+    function( "Number_get_x_const_pointer", Number_get_x_const_pointer ); 
+    function( "Number_get_x_pointer", Number_get_x_pointer ); 
     
+    
     class_<Randomizer>( "Randomizer" )
         // No default: .default_constructor()
         .constructor<double,double>()


From noreply at r-forge.r-project.org  Tue Jul 23 22:42:59 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 23 Jul 2013 22:42:59 +0200 (CEST)
Subject: [Rcpp-commits] r4400 - in pkg/Rcpp: . inst src
Message-ID: <20130723204259.DED6318515F@r-forge.r-project.org>

Author: romain
Date: 2013-07-23 22:42:59 +0200 (Tue, 23 Jul 2013)
New Revision: 4400

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/NEWS.Rd
   pkg/Rcpp/src/attributes.cpp
Log:
attributes taking advantage of more flexible as<>

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-23 17:01:42 UTC (rev 4399)
+++ pkg/Rcpp/ChangeLog	2013-07-23 20:42:59 UTC (rev 4400)
@@ -8,6 +8,8 @@
         with as<T*> and as<const T*>
         * unitTests/runit.Module.R: testing as<T*> and as<const T*>
         * unitTests/cpp/Module.cpp: idem
+        * src/attributes.cpp: take advantage of a more flexible as<>. The Type
+        class gains a full_name() method that shows const-ness and reference-ness 
 
 2013-07-17  Romain Francois <romain at r-enthusiasts.com>
 

Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd	2013-07-23 17:01:42 UTC (rev 4399)
+++ pkg/Rcpp/inst/NEWS.Rd	2013-07-23 20:42:59 UTC (rev 4400)
@@ -10,7 +10,8 @@
       \item Add \code{#defined(__sun)} to lists of operating systems to
       test for when checking for lack of \code{backtrace()} needed for
       stack traces.
-      \item \code{as<T&>} and \code{as<const T&>} is now supported, when 
+      \item \code{as<T*>}, \code{as<const T*>}, \code{as<T&>} and
+      \code{as<const T&>} are now supported, when 
       T is a class exposed by modules, i.e. with \code{RCPP_EXPOSED_CLASS}
       \item \code{DoubleVector} as been added as an alias to 
       \code{NumericVector}
@@ -26,7 +27,12 @@
         in a file that is processed by \code{sourceCpp}) are now directly 
         available in the environment. We used to make the module object
         available, which was less useful.
-	\item A plugin for 'openmp' has been added to support use of OpenMP.
+        \item A plugin for 'openmp' has been added to support use of OpenMP.
+        \item \code{Rcpp::export} now takes advantage of the more flexible 
+        \code{as<>}, handling constness and referenceness of the input types. 
+        For users, it means that for the parameters of function exported by modules, 
+        we can now use references, pointers and const versions of them.
+        The Module.cpp file has an example. 
     }
 
     \item Changes in Modules:

Modified: pkg/Rcpp/src/attributes.cpp
===================================================================
--- pkg/Rcpp/src/attributes.cpp	2013-07-23 17:01:42 UTC (rev 4399)
+++ pkg/Rcpp/src/attributes.cpp	2013-07-23 20:42:59 UTC (rev 4400)
@@ -112,6 +112,13 @@
         bool empty() const { return name().empty(); }
         
         const std::string& name() const { return name_; }
+        std::string full_name() const {
+            std::string res ;
+            if( isConst() ) res += "const " ;
+            res += name() ;
+            if( isReference() ) res += "&" ;
+            return res ;
+        }
         
         bool isVoid() const { return name() == "void"; }
         bool isConst() const { return isConst_; }
@@ -1228,7 +1235,7 @@
         // if the type is now empty because of some strange parse then bail
         if (type.empty())
             return Type();
-            
+          
         return Type(type, isConst, isReference);
     }
     
@@ -2141,9 +2148,8 @@
             for (size_t i = 0; i<arguments.size(); i++) {
                 const Argument& argument = arguments[i];
                 
-                // Rcpp::as to c++ type
-                ostr << "        " << argument.type().name() << " " << argument.name() 
-                     << " = " << "Rcpp::as<"  << argument.type().name() << " >(" 
+                ostr << "        " << argument.type().full_name() << " " << argument.name() 
+                     << " = " << "Rcpp::as<"  << argument.type().full_name() << " >(" 
                      << argument.name() << "SEXP);" << std::endl;
             }
             


From noreply at r-forge.r-project.org  Tue Jul 23 22:57:08 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Tue, 23 Jul 2013 22:57:08 +0200 (CEST)
Subject: [Rcpp-commits] r4401 - in pkg/Rcpp/inst/unitTests: . cpp
Message-ID: <20130723205708.A59541848F4@r-forge.r-project.org>

Author: romain
Date: 2013-07-23 22:57:08 +0200 (Tue, 23 Jul 2013)
New Revision: 4401

Modified:
   pkg/Rcpp/inst/unitTests/cpp/Module.cpp
   pkg/Rcpp/inst/unitTests/runit.Module.R
Log:
more testing

Modified: pkg/Rcpp/inst/unitTests/cpp/Module.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/Module.cpp	2013-07-23 20:42:59 UTC (rev 4400)
+++ pkg/Rcpp/inst/unitTests/cpp/Module.cpp	2013-07-23 20:57:08 UTC (rev 4401)
@@ -74,7 +74,6 @@
     int y ;
 };
    
-RCPP_EXPOSED_CLASS(Number)
 class Number{
 public:
     Number() : x(0.0), y(0){} ;
@@ -98,17 +97,29 @@
     double min, max ;
 } ;
 
-double Number_get_x_const_ref( const Number& x){
-    return x.x ;    
+RCPP_EXPOSED_CLASS(Test)
+class Test{
+public:
+    double value ;
+    Test(double v) : value(v){}
+private:    
+    // hiding those on purpose
+    // we work by reference or pointers here. Not by copy. 
+    Test( const Test& other) ;
+    Test& operator=( const Test& ) ;
+} ;
+
+double Test_get_x_const_ref( const Test& x){
+    return x.value ;    
 }
-double Number_get_x_ref( Number& x){
-    return x.x ;    
+double Test_get_x_ref( Test& x){
+    return x.value;    
 }
-double Number_get_x_const_pointer( const Number* x){
-    return x->x ;    
+double Test_get_x_const_pointer( const Test* x){
+    return x->value ;    
 }
-double Number_get_x_pointer( Number* x){
-    return x->x ;    
+double Test_get_x_pointer( Test* x){
+    return x->value ;    
 }
 
 RCPP_MODULE(yada){
@@ -119,6 +130,10 @@
 	function( "bla1"  , &bla1   ) ;
 	function( "bla2"  , &bla2   ) ;
 
+	class_<Test>("Test")
+        .constructor<double>()
+    ;   
+    
 	class_<World>( "World" )
 
 	    .constructor()
@@ -148,10 +163,10 @@
         	// read only data member
         	.field_readonly( "y", &Number::y )
     ;
-    function( "Number_get_x_const_ref", Number_get_x_const_ref ); 
-    function( "Number_get_x_ref", Number_get_x_ref ); 
-    function( "Number_get_x_const_pointer", Number_get_x_const_pointer ); 
-    function( "Number_get_x_pointer", Number_get_x_pointer ); 
+    function( "Test_get_x_const_ref", Test_get_x_const_ref ); 
+    function( "Test_get_x_ref", Test_get_x_ref ); 
+    function( "Test_get_x_const_pointer", Test_get_x_const_pointer ); 
+    function( "Test_get_x_pointer", Test_get_x_pointer ); 
     
     
     class_<Randomizer>( "Randomizer" )
@@ -161,4 +176,25 @@
         .method( "get" , &Randomizer::get ) 
     ;
 }
+  
+// [[Rcpp::export]]
+double attr_Test_get_x_const_ref( const Test& x){
+    return x.value ;    
+}
 
+// [[Rcpp::export]]
+double attr_Test_get_x_ref( Test& x){
+    return x.value;    
+}
+
+// [[Rcpp::export]]
+double attr_Test_get_x_const_pointer( const Test* x){
+    return x->value ;    
+}
+
+// [[Rcpp::export]]
+double attr_Test_get_x_pointer( Test* x){
+    return x->value ;    
+}
+
+

Modified: pkg/Rcpp/inst/unitTests/runit.Module.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Module.R	2013-07-23 20:42:59 UTC (rev 4400)
+++ pkg/Rcpp/inst/unitTests/runit.Module.R	2013-07-23 20:57:08 UTC (rev 4401)
@@ -42,11 +42,16 @@
 }
 
 test.Module.exposed.class <- function(){
-    num <- new( Number )
-    checkEquals( Number_get_x_const_ref(num), 0.0 )
-    checkEquals( Number_get_x_const_pointer(num), 0.0 )
-    checkEquals( Number_get_x_ref(num), 0.0 )
-    checkEquals( Number_get_x_pointer(num), 0.0 )
+    test <- new( Test, 3.0 )
+    checkEquals( Test_get_x_const_ref(test), 3.0 )
+    checkEquals( Test_get_x_const_pointer(test), 3.0 )
+    checkEquals( Test_get_x_ref(test), 3.0 )
+    checkEquals( Test_get_x_pointer(test), 3.0 )
+    
+    checkEquals( attr_Test_get_x_const_ref(test), 3.0 )
+    checkEquals( attr_Test_get_x_const_pointer(test), 3.0 )
+    checkEquals( attr_Test_get_x_ref(test), 3.0 )
+    checkEquals( attr_Test_get_x_pointer(test), 3.0 )
 }
 
 test.Module.property <- function(){


From noreply at r-forge.r-project.org  Wed Jul 24 10:08:38 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 24 Jul 2013 10:08:38 +0200 (CEST)
Subject: [Rcpp-commits] r4402 - pkg/Rcpp/inst/include/Rcpp
Message-ID: <20130724080838.79758180AC9@r-forge.r-project.org>

Author: romain
Date: 2013-07-24 10:08:38 +0200 (Wed, 24 Jul 2013)
New Revision: 4402

Modified:
   pkg/Rcpp/inst/include/Rcpp/as.h
Log:
format

Modified: pkg/Rcpp/inst/include/Rcpp/as.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/as.h	2013-07-23 20:57:08 UTC (rev 4401)
+++ pkg/Rcpp/inst/include/Rcpp/as.h	2013-07-24 08:08:38 UTC (rev 4402)
@@ -105,8 +105,7 @@
         }
         
         /** handling T such that T is a reference of a class handled by a module */
-        template <typename T> 
-        T as(SEXP x, ::Rcpp::traits::r_type_module_object_reference_tag ){
+        template <typename T> T as(SEXP x, ::Rcpp::traits::r_type_module_object_reference_tag ){
             typedef typename traits::remove_reference<T>::type KLASS ;
             KLASS* obj = as_module_object<KLASS>(x) ;
             return *obj ;


From noreply at r-forge.r-project.org  Wed Jul 24 10:23:05 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 24 Jul 2013 10:23:05 +0200 (CEST)
Subject: [Rcpp-commits] r4403 - in pkg/Rcpp: inst/unitTests/cpp src
Message-ID: <20130724082305.225FB18102B@r-forge.r-project.org>

Author: romain
Date: 2013-07-24 10:23:04 +0200 (Wed, 24 Jul 2013)
New Revision: 4403

Modified:
   pkg/Rcpp/inst/unitTests/cpp/Module.cpp
   pkg/Rcpp/src/attributes.cpp
Log:
adding copyrights

Modified: pkg/Rcpp/inst/unitTests/cpp/Module.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/Module.cpp	2013-07-24 08:08:38 UTC (rev 4402)
+++ pkg/Rcpp/inst/unitTests/cpp/Module.cpp	2013-07-24 08:23:04 UTC (rev 4403)
@@ -3,6 +3,7 @@
 // Module.cpp: Rcpp R/C++ interface class library -- module unit tests
 //
 // Copyright (C) 2013 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2013 Rice University
 //
 // This file is part of Rcpp.
 //

Modified: pkg/Rcpp/src/attributes.cpp
===================================================================
--- pkg/Rcpp/src/attributes.cpp	2013-07-24 08:08:38 UTC (rev 4402)
+++ pkg/Rcpp/src/attributes.cpp	2013-07-24 08:23:04 UTC (rev 4403)
@@ -3,6 +3,7 @@
 // attributes.cpp: Rcpp R/C++ interface class library -- Rcpp attributes
 //
 // Copyright (C) 2012 - 2013 JJ Allaire, Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2013 Rice University
 //
 // This file is part of Rcpp.
 //


From noreply at r-forge.r-project.org  Wed Jul 24 18:18:55 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Wed, 24 Jul 2013 18:18:55 +0200 (CEST)
Subject: [Rcpp-commits] r4404 - in pkg/Rcpp: . inst/include/Rcpp
	inst/include/Rcpp/api/meat inst/include/Rcpp/macros
	inst/include/Rcpp/traits src
Message-ID: <20130724161855.AB59D184FD6@r-forge.r-project.org>

Author: romain
Date: 2013-07-24 18:18:55 +0200 (Wed, 24 Jul 2013)
New Revision: 4404

Added:
   pkg/Rcpp/inst/include/Rcpp/traits/is_module_object.h
Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/include/Rcpp/api/meat/is.h
   pkg/Rcpp/inst/include/Rcpp/is.h
   pkg/Rcpp/inst/include/Rcpp/macros/module.h
   pkg/Rcpp/inst/include/Rcpp/traits/traits.h
   pkg/Rcpp/src/Module.cpp
Log:
support for is<T> where T is module exposed

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/ChangeLog	2013-07-24 16:18:55 UTC (rev 4404)
@@ -1,3 +1,14 @@
+2013-07-24  Romain Francois <romain at r-enthusiasts.com>
+
+        * include/Rcpp/traits/is_module_object.h: trait class that identifies
+        at compile time if a given type is a type exposed by a module, i.e. if 
+        we used the RCPP_EXPOSED_AS macro
+        * include/Rcpp/is.h: able to identify if an object is of a given type
+        exposed by a module (supports references and pointers too). 
+        * src/Module.cpp: implementation of is_module_object_internal that 
+        checks if an object is of a given typeid, used by is<T> where T is 
+        module exposed
+
 2013-07-23  Romain Francois <romain at r-enthusiasts.com>
 
         * include/Rcpp/as.h: support as<T*> and as<const T*> where T is a class

Modified: pkg/Rcpp/inst/include/Rcpp/api/meat/is.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/api/meat/is.h	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/inst/include/Rcpp/api/meat/is.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -23,121 +23,130 @@
 #define Rcpp_api_meat_is_h
 
 namespace Rcpp{ 
-    
+namespace internal{
+        
     inline bool is_atomic( SEXP x){ return Rf_length(x) == 1 ; } 
     inline bool is_matrix(SEXP x){
         SEXP dim = Rf_getAttrib( x, R_DimSymbol) ;
         return dim != R_NilValue && Rf_length(dim) == 2 ;
     }
     
-    template <> inline bool is<int>( SEXP x ){
+    template <> inline bool is__simple<int>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == INTSXP ;
     }
 
-    template <> inline bool is<double>( SEXP x ){
+    template <> inline bool is__simple<double>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == REALSXP ;
     }
     
-    template <> inline bool is<bool>( SEXP x ){
+    template <> inline bool is__simple<bool>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == LGLSXP ;
     }
     
-    template <> inline bool is<std::string>( SEXP x ){
+    template <> inline bool is__simple<std::string>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == STRSXP ;
     }
     
-    template <> inline bool is<String>( SEXP x ){
+    template <> inline bool is__simple<String>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == STRSXP ;
     }
     
-    template <> inline bool is<RObject>( SEXP x ){
+    template <> inline bool is__simple<RObject>( SEXP x ){
         return true ;
     }
-    template <> inline bool is<IntegerVector>( SEXP x ){
+    template <> inline bool is__simple<IntegerVector>( SEXP x ){
         return TYPEOF(x) == INTSXP ;
     }
-    template <> inline bool is<ComplexVector>( SEXP x ){
+    template <> inline bool is__simple<ComplexVector>( SEXP x ){
         return TYPEOF(x) == CPLXSXP ;
     }
-    template <> inline bool is<RawVector>( SEXP x ){
+    template <> inline bool is__simple<RawVector>( SEXP x ){
         return TYPEOF(x) == RAWSXP ;
     }
-    template <> inline bool is<NumericVector>( SEXP x ){
+    template <> inline bool is__simple<NumericVector>( SEXP x ){
         return TYPEOF(x) == REALSXP ;
     }
-    template <> inline bool is<LogicalVector>( SEXP x ){
+    template <> inline bool is__simple<LogicalVector>( SEXP x ){
         return TYPEOF(x) == LGLSXP ;
     }
-    template <> inline bool is<List>( SEXP x ){
+    template <> inline bool is__simple<List>( SEXP x ){
         return TYPEOF(x) == VECSXP ;
     }
-    template <> inline bool is<IntegerMatrix>( SEXP x ){
+    template <> inline bool is__simple<IntegerMatrix>( SEXP x ){
         return TYPEOF(x) == INTSXP && is_matrix(x) ;
     }
-    template <> inline bool is<ComplexMatrix>( SEXP x ){
+    template <> inline bool is__simple<ComplexMatrix>( SEXP x ){
         return TYPEOF(x) == CPLXSXP && is_matrix(x) ;
     }
-    template <> inline bool is<RawMatrix>( SEXP x ){
+    template <> inline bool is__simple<RawMatrix>( SEXP x ){
         return TYPEOF(x) == RAWSXP && is_matrix(x) ;
     }
-    template <> inline bool is<NumericMatrix>( SEXP x ){
+    template <> inline bool is__simple<NumericMatrix>( SEXP x ){
         return TYPEOF(x) == REALSXP && is_matrix(x) ;
     }
-    template <> inline bool is<LogicalMatrix>( SEXP x ){
+    template <> inline bool is__simple<LogicalMatrix>( SEXP x ){
         return TYPEOF(x) == LGLSXP && is_matrix(x) ;
     }
-    template <> inline bool is<GenericMatrix>( SEXP x ){
+    template <> inline bool is__simple<GenericMatrix>( SEXP x ){
         return TYPEOF(x) == VECSXP && is_matrix(x) ;
     }
     
     
-    template <> inline bool is<DataFrame>( SEXP x ){
+    template <> inline bool is__simple<DataFrame>( SEXP x ){
         if( TYPEOF(x) != VECSXP ) return false ;
         return Rf_inherits( x, "data.frame" ) ;
     }
-    template <> inline bool is<WeakReference>( SEXP x ){
+    template <> inline bool is__simple<WeakReference>( SEXP x ){
         return TYPEOF(x) == WEAKREFSXP ;
     }
-    template <> inline bool is<Symbol>( SEXP x ){
+    template <> inline bool is__simple<Symbol>( SEXP x ){
         return TYPEOF(x) == SYMSXP ;
     }
-    template <> inline bool is<S4>( SEXP x ){
+    template <> inline bool is__simple<S4>( SEXP x ){
         return ::Rf_isS4(x);
     }
-    template <> inline bool is<Reference>( SEXP x ){
+    template <> inline bool is__simple<Reference>( SEXP x ){
         if( ! ::Rf_isS4(x) ) return false ;
         return ::Rf_inherits(x, "envRefClass" ) ;
     }
-    template <> inline bool is<Promise>( SEXP x ){
+    template <> inline bool is__simple<Promise>( SEXP x ){
         return TYPEOF(x) == PROMSXP ;
     }
-    template <> inline bool is<Pairlist>( SEXP x ){
+    template <> inline bool is__simple<Pairlist>( SEXP x ){
         return TYPEOF(x) == LISTSXP ;
     }
-    template <> inline bool is<Function>( SEXP x ){
+    template <> inline bool is__simple<Function>( SEXP x ){
         return TYPEOF(x) == CLOSXP || TYPEOF(x) == SPECIALSXP || TYPEOF(x) == BUILTINSXP ;
     }
-    template <> inline bool is<Environment>( SEXP x ){
+    template <> inline bool is__simple<Environment>( SEXP x ){
         return TYPEOF(x) == ENVSXP ;
     }
-    template <> inline bool is<Formula>( SEXP x ){
+    template <> inline bool is__simple<Formula>( SEXP x ){
         if( TYPEOF(x) != LANGSXP ) return false ; 
         return Rf_inherits( x, "formula" ) ;
     }
     
-    template <> inline bool is<Date>( SEXP x ){
+    template <> inline bool is__simple<Date>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == REALSXP && Rf_inherits( x, "Date" ) ;
     }
-    template <> inline bool is<Datetime>( SEXP x ){
+    template <> inline bool is__simple<Datetime>( SEXP x ){
         return is_atomic(x) && TYPEOF(x) == REALSXP && Rf_inherits( x, "POSIXt" ) ;
     }
-    template <> inline bool is<DateVector>( SEXP x ){
+    template <> inline bool is__simple<DateVector>( SEXP x ){
         return TYPEOF(x) == REALSXP && Rf_inherits( x, "Date" ) ;
     }
-    template <> inline bool is<DatetimeVector>( SEXP x ){
+    template <> inline bool is__simple<DatetimeVector>( SEXP x ){
         return TYPEOF(x) == REALSXP && Rf_inherits( x, "POSIXt" ) ;
     }
      
+    bool is_module_object_internal(SEXP, const char*) ;
+    template <typename T> bool is__module__object( SEXP x){
+        typedef typename Rcpp::traits::un_pointer<T>::type CLASS ;
+        return is_module_object_internal(x, typeid(CLASS).name() ) ;     
+    }
+        
+    
+} // namespace internal
 } // namespace Rcpp
 
 #endif

Modified: pkg/Rcpp/inst/include/Rcpp/is.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/is.h	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/inst/include/Rcpp/is.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -24,13 +24,35 @@
 #define Rcpp__is__h
 
 namespace Rcpp{
-
+      
+    namespace internal{  
+        
+        // simple implementation, for most default types
+        template <typename T> bool is__simple( SEXP x) ;
+        
+        // implementation for module objects
+        template <typename T> bool is__module__object( SEXP x) ;
+        
+        // not a module object
+        template <typename T>
+        inline bool is__dispatch( SEXP x, Rcpp::traits::false_type ){
+            return is__simple<T>( x ) ;
+        }
+        
+        template <typename T>
+        inline bool is__dispatch( SEXP x, Rcpp::traits::true_type ){
+            return is__module__object<T>( x ) ;
+        }
+    }
+    
     /** identify if an x can be seen as the T type
      *  
      *  example:
      *     bool is_list = is<List>( x ) ;
      */
-    template <typename T> bool is( SEXP x ) ;
+    template <typename T> bool is( SEXP x ){
+        return internal::is__dispatch<T>( x, typename traits::is_module_object<T>::type() ) ;    
+    }
     
 } // Rcpp 
 

Modified: pkg/Rcpp/inst/include/Rcpp/macros/module.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/macros/module.h	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/inst/include/Rcpp/macros/module.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -27,23 +27,23 @@
  *  as a parameter of a function or method exposed by modules. This defines
  *  the necessary trait that makes the class as<>'able
  */
-#define RCPP_EXPOSED_AS(CLASS)                                         \
-    namespace Rcpp{ namespace traits{                                  \
-    template<> struct r_type_traits< CLASS* >{                         \
-        typedef r_type_module_object_pointer_tag r_category ;          \
-    } ;                                                                \
-    template<> struct r_type_traits< const CLASS* >{                   \
-        typedef r_type_module_object_const_pointer_tag r_category ;    \
-    } ;                                                                \
-    template<> struct r_type_traits< CLASS >{                          \
-        typedef r_type_module_object_tag r_category ;                  \
-    } ;                                                                \
-    template<> struct r_type_traits< CLASS& >{                         \
-        typedef r_type_module_object_reference_tag r_category ;        \
-    } ;                                                                \
-    template<> struct r_type_traits< const CLASS& >{                   \
-        typedef r_type_module_object_const_reference_tag r_category ;  \
-    } ;                                                                \
+#define RCPP_EXPOSED_AS(CLASS)                                                \
+    namespace Rcpp{ namespace traits{                                         \
+    template<> struct r_type_traits< CLASS* >{                                \
+        typedef r_type_module_object_pointer_tag r_category ;                 \
+    } ;                                                                       \
+    template<> struct r_type_traits< const CLASS* >{                          \
+        typedef r_type_module_object_const_pointer_tag r_category ;           \
+    } ;                                                                       \
+    template<> struct r_type_traits< CLASS >{                                 \
+        typedef r_type_module_object_tag r_category ;                         \
+    } ;                                                                       \
+    template<> struct r_type_traits< CLASS& >{                                \
+        typedef r_type_module_object_reference_tag r_category ;               \
+    } ;                                                                       \
+    template<> struct r_type_traits< const CLASS& >{                          \
+        typedef r_type_module_object_const_reference_tag r_category ;         \
+    } ;                                                                       \
     }}
     
 #define RCPP_EXPOSED_WRAP(CLASS) namespace Rcpp{ namespace traits{ template<> struct wrap_type_traits< CLASS >{typedef wrap_type_module_object_tag wrap_category ; } ; }}

Added: pkg/Rcpp/inst/include/Rcpp/traits/is_module_object.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/is_module_object.h	                        (rev 0)
+++ pkg/Rcpp/inst/include/Rcpp/traits/is_module_object.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -0,0 +1,41 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+/* :tabSize=4:indentSize=4:noTabs=false:folding=explicit:collapseFolds=1: */
+//
+// is_module_object.h: Rcpp R/C++ interface class library -- 
+//
+// 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/>.
+
+#ifndef Rcpp__traits__is_module_object__h
+#define Rcpp__traits__is_module_object__h
+
+namespace Rcpp{
+namespace traits{
+      
+	template <typename T> struct is_module_object : 
+		public integral_constant<bool,
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_tag >::value                ||
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_pointer_tag >::value        ||
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_const_pointer_tag >::value  ||
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_reference_tag >::value      ||
+			same_type< typename r_type_traits<T>::r_category, r_type_module_object_const_reference_tag >::value
+		>{} ;
+
+} // traits
+} // Rcpp
+
+#endif

Modified: pkg/Rcpp/inst/include/Rcpp/traits/traits.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/traits/traits.h	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/inst/include/Rcpp/traits/traits.h	2013-07-24 16:18:55 UTC (rev 4404)
@@ -59,6 +59,7 @@
 #include <Rcpp/traits/remove_reference.h>
 #include <Rcpp/traits/remove_const_and_reference.h>
 #include <Rcpp/traits/result_of.h>
+#include <Rcpp/traits/is_module_object.h>
 
 #endif
 

Modified: pkg/Rcpp/src/Module.cpp
===================================================================
--- pkg/Rcpp/src/Module.cpp	2013-07-24 08:23:04 UTC (rev 4403)
+++ pkg/Rcpp/src/Module.cpp	2013-07-24 16:18:55 UTC (rev 4404)
@@ -502,6 +502,11 @@
 	        SEXP xp = env.get(".pointer") ;
 	        return R_ExternalPtrAddr(xp );
 	    }
+	    bool is_module_object_internal(SEXP obj, const char* clazz){
+	        Environment env(obj) ;
+	        XPtr<class_Base> xp( env.get(".cppclass") );
+	        return xp->has_typeinfo_name( clazz ) ;
+	    }
 	}
 	
 	FunctionProxy GetCppCallable( const std::string& pkg, const std::string& mod, const std::string& fun){


From noreply at r-forge.r-project.org  Thu Jul 25 10:15:35 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 25 Jul 2013 10:15:35 +0200 (CEST)
Subject: [Rcpp-commits] r4405 - in pkg/Rcpp: . inst inst/include/Rcpp
	inst/include/Rcpp/sugar/functions
Message-ID: <20130725081535.3D48C185111@r-forge.r-project.org>

Author: romain
Date: 2013-07-25 10:15:34 +0200 (Thu, 25 Jul 2013)
New Revision: 4405

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/NEWS.Rd
   pkg/Rcpp/inst/include/Rcpp/Date.h
   pkg/Rcpp/inst/include/Rcpp/Datetime.h
   pkg/Rcpp/inst/include/Rcpp/sugar/functions/is_na.h
Log:
added is_na impl for DateVector and DatetimeVector

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-24 16:18:55 UTC (rev 4404)
+++ pkg/Rcpp/ChangeLog	2013-07-25 08:15:34 UTC (rev 4405)
@@ -1,3 +1,10 @@
+2013-07-25 Romain Francois <romain at r-enthusiasts.com>
+
+        * include/Rcpp/sugar/functions/is_na.h : added is_na for DateVector and
+        DatetimeVector
+        * include/Rcpp/Date.h : added is_na method
+        * include/Rcpp/Datetime.h : added is_na method
+        
 2013-07-24  Romain Francois <romain at r-enthusiasts.com>
 
         * include/Rcpp/traits/is_module_object.h: trait class that identifies

Modified: pkg/Rcpp/inst/NEWS.Rd
===================================================================
--- pkg/Rcpp/inst/NEWS.Rd	2013-07-24 16:18:55 UTC (rev 4404)
+++ pkg/Rcpp/inst/NEWS.Rd	2013-07-25 08:15:34 UTC (rev 4405)
@@ -42,6 +42,12 @@
       objects are no longer copied as they used to be. 
     }
 
+    \item Changes in sugar:
+    \itemize{
+        \item \code{is_na} supports classes \code{DatetimeVector} and 
+        \code{DateVector}
+    }
+    
     \item Deprecation of \code{RCPP_FUNCTION_*}:
     \itemize{
       \item The macros from the \code{preprocessor_generated.h} file

Modified: pkg/Rcpp/inst/include/Rcpp/Date.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Date.h	2013-07-24 16:18:55 UTC (rev 4404)
+++ pkg/Rcpp/inst/include/Rcpp/Date.h	2013-07-25 08:15:34 UTC (rev 4405)
@@ -64,6 +64,8 @@
 		friend bool   operator<=(const Date &date1, const Date& date2);
 		friend bool   operator!=(const Date &date1, const Date& date2);
 
+		inline int is_na() const { return traits::is_na<REALSXP>( m_d ) ; }
+		
     private:
         double m_d;					// (fractional) day number, relative to epoch of Jan 1, 1970
         struct tm m_tm;				// standard time representation

Modified: pkg/Rcpp/inst/include/Rcpp/Datetime.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/Datetime.h	2013-07-24 16:18:55 UTC (rev 4404)
+++ pkg/Rcpp/inst/include/Rcpp/Datetime.h	2013-07-25 08:15:34 UTC (rev 4405)
@@ -2,7 +2,7 @@
 //
 // Datetime.h: Rcpp R/C++ interface class library -- Datetime (POSIXct)
 //
-// Copyright (C) 2010 - 2011 Dirk Eddelbuettel and Romain Francois
+// Copyright (C) 2010 - 2013 Dirk Eddelbuettel and Romain Francois
 //
 // This file is part of Rcpp.
 //
@@ -59,13 +59,15 @@
 		friend bool      operator<=(const Datetime &dt1, const Datetime& dt2);
 		friend bool      operator!=(const Datetime &dt1, const Datetime& dt2);
 
+		inline int is_na() const { return traits::is_na<REALSXP>( m_dt ) ; }
+		
     private:
         double m_dt;				// fractional seconds since epoch
-        struct tm m_tm;				// standard time representation
-		unsigned int m_us;			// microsecond (to complement m_tm)
+        struct tm m_tm;			// standard time representation
+        unsigned int m_us;		// microsecond (to complement m_tm)
+                                
+        void update_tm();		// update m_tm based on m_dt
 
-		void update_tm();			// update m_tm based on m_dt
-
     };
 
 

Modified: pkg/Rcpp/inst/include/Rcpp/sugar/functions/is_na.h
===================================================================
--- pkg/Rcpp/inst/include/Rcpp/sugar/functions/is_na.h	2013-07-24 16:18:55 UTC (rev 4404)
+++ pkg/Rcpp/inst/include/Rcpp/sugar/functions/is_na.h	2013-07-25 08:15:34 UTC (rev 4405)
@@ -66,7 +66,21 @@
 	
 } ;
 
-	
+template <typename T>
+class IsNa_Vector_is_na : public Rcpp::VectorBase<LGLSXP, false, IsNa_Vector_is_na<T> >{
+   public:
+       IsNa_Vector_is_na( const T& x) : ref(x){}
+       
+       inline int operator[]( int i) const {
+           return ref[i].is_na() ;
+       }
+       
+       inline int size() const { return ref.size() ; } 
+       
+   private:
+        const T& ref ;       
+} ;
+
 } // sugar
 
 template <int RTYPE, bool NA, typename T>
@@ -74,6 +88,13 @@
 	return sugar::IsNa<RTYPE,NA,T>( t ) ;
 }
 
+inline sugar::IsNa_Vector_is_na<DatetimeVector> is_na( const DatetimeVector& x){
+    return sugar::IsNa_Vector_is_na<DatetimeVector>( x ) ;
+}
+inline sugar::IsNa_Vector_is_na<DateVector> is_na( const DateVector& x){
+    return sugar::IsNa_Vector_is_na<DateVector>( x ) ;
+}
+
 } // Rcpp
 #endif
 


From noreply at r-forge.r-project.org  Thu Jul 25 11:00:55 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 25 Jul 2013 11:00:55 +0200 (CEST)
Subject: [Rcpp-commits] r4406 - in pkg/Rcpp: . inst/unitTests
	inst/unitTests/cpp
Message-ID: <20130725090055.1A2C91812ED@r-forge.r-project.org>

Author: romain
Date: 2013-07-25 11:00:54 +0200 (Thu, 25 Jul 2013)
New Revision: 4406

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/inst/unitTests/cpp/dates.cpp
   pkg/Rcpp/inst/unitTests/runit.Date.R
Log:
remove the ignoreme useless parameters

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-25 08:15:34 UTC (rev 4405)
+++ pkg/Rcpp/ChangeLog	2013-07-25 09:00:54 UTC (rev 4406)
@@ -4,6 +4,8 @@
         DatetimeVector
         * include/Rcpp/Date.h : added is_na method
         * include/Rcpp/Datetime.h : added is_na method
+        * unitTests/cpp/dates.cpp : removed the ignoreme useless parameters
+        * unitTests/runit.Date.R : idem
         
 2013-07-24  Romain Francois <romain at r-enthusiasts.com>
 

Modified: pkg/Rcpp/inst/unitTests/cpp/dates.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/dates.cpp	2013-07-25 08:15:34 UTC (rev 4405)
+++ pkg/Rcpp/inst/unitTests/cpp/dates.cpp	2013-07-25 09:00:54 UTC (rev 4406)
@@ -29,13 +29,13 @@
 }
 
 // [[Rcpp::export]]
-SEXP ctor_mdy(int ignoreme) {
+SEXP ctor_mdy() {
     Date dt = Date(12,31,2005);
     return wrap(dt);
 }
 
 // [[Rcpp::export]]
-SEXP ctor_ymd(int ignoreme) {
+SEXP ctor_ymd() {
     Date dt = Date(2005,12,31);
     return wrap(dt);
 }
@@ -53,7 +53,7 @@
 }
 
 // [[Rcpp::export]]
-List operators(int ignoreme) {
+List operators() {
     Date d1 = Date(2005,12,31);
     Date d2 = d1 + 1;
     return List::create(Named("diff") = d1 - d2,
@@ -66,7 +66,7 @@
 }
 
 // [[Rcpp::export]]
-List components(int ignoreme) {
+List components() {
     Date d = Date(2005,12,31);
     return List::create(Named("day") = d.getDay(),
                         Named("month") = d.getMonth(),
@@ -76,7 +76,7 @@
 }
 
 // [[Rcpp::export]]
-SEXP vector_Date(int ignoreme) {
+SEXP vector_Date() {
     std::vector<Date> v(2) ;
     v[0] = Date(2005,12,31) ;
     v[1] = Date(12,31,2005) ;
@@ -84,7 +84,7 @@
 }
 
 // [[Rcpp::export]]
-SEXP Datevector_wrap(int ignoreme) {
+SEXP Datevector_wrap() {
     DateVector v(2) ;
     v[0] = Date(2005,12,31) ;
     v[1] = Date(12,31,2005) ;
@@ -92,7 +92,7 @@
 }
 
 // [[Rcpp::export]]
-SEXP Datevector_sexp(int ignoreme) {
+SEXP Datevector_sexp() {
     DateVector v(2) ;
     v[0] = Date(2005,12,31) ;
     v[1] = Date(12,31,2005) ;
@@ -123,7 +123,7 @@
 }
 
 // [[Rcpp::export]]
-List Datetime_operators(int ignoreme) {
+List Datetime_operators() {
     Datetime d1 = Datetime(946774923.123456);
     Datetime d2 = d1 + 60*60;
     return List::create(Named("diff") = d1 - d2,
@@ -136,7 +136,7 @@
 }
 
 // [[Rcpp::export]]
-SEXP Datetime_wrap(int ignoreme) {
+SEXP Datetime_wrap() {
     Datetime dt = Datetime(981162123.123456);
     return wrap(dt);
 }

Modified: pkg/Rcpp/inst/unitTests/runit.Date.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.Date.R	2013-07-25 08:15:34 UTC (rev 4405)
+++ pkg/Rcpp/inst/unitTests/runit.Date.R	2013-07-25 09:00:54 UTC (rev 4406)
@@ -49,13 +49,11 @@
 }
 
 test.Date.ctor.mdy <- function() {
-    fun <- ctor_mdy
-    checkEquals(fun(1), as.Date("2005-12-31"), msg = "Date.ctor.mdy")
+    checkEquals(ctor_mdy(), as.Date("2005-12-31"), msg = "Date.ctor.mdy")
 }
 
 test.Date.ctor.ymd <- function() {
-    fun <- ctor_ymd
-    checkEquals(fun(1), as.Date("2005-12-31"), msg = "Date.ctor.ymd")
+    checkEquals(ctor_ymd(), as.Date("2005-12-31"), msg = "Date.ctor.ymd")
 }
 
 test.Date.ctor.int <- function() {
@@ -77,32 +75,27 @@
 }
 
 test.Date.operators <- function() {
-    fun <- operators
-    checkEquals(fun(1),
+    checkEquals(operators(),
                 list(diff=-1, bigger=TRUE, smaller=FALSE, equal=FALSE, ge=TRUE, le=FALSE, ne=TRUE),
                 msg = "Date.operators")
 }
 
 test.Date.components <- function() {
-    fun <- components
-    checkEquals(fun(1),
+    checkEquals(components(),
                 list(day=31, month=12, year=2005, weekday=7, yearday=365),
                 msg = "Date.components")
 }
 
 test.vector.Date <- function(){
-    fun <- vector_Date
-    checkEquals(fun(1), rep(as.Date("2005-12-31"),2), msg = "Date.vector.wrap")
+    checkEquals(vector_Date(), rep(as.Date("2005-12-31"),2), msg = "Date.vector.wrap")
 }
 
 test.DateVector.wrap <- function(){
-    fun <- Datevector_wrap
-    checkEquals(fun(1), rep(as.Date("2005-12-31"),2), msg = "DateVector.wrap")
+    checkEquals(Datevector_wrap(), rep(as.Date("2005-12-31"),2), msg = "DateVector.wrap")
 }
 
 test.DateVector.operator.SEXP <- function(){
-    fun <- Datevector_sexp
-    checkEquals(fun(1), rep(as.Date("2005-12-31"),2), msg = "DateVector.SEXP")
+    checkEquals(Datevector_sexp(), rep(as.Date("2005-12-31"),2), msg = "DateVector.SEXP")
 }
 
 test.Date.getFunctions <- function(){
@@ -123,15 +116,13 @@
 }
 
 test.Datetime.operators <- function() {
-    fun <- Datetime_operators
-    checkEquals(fun(1),
+    checkEquals(Datetime_operators(),
                 list(diff=-60*60, bigger=TRUE, smaller=FALSE, equal=FALSE, ge=TRUE, le=FALSE, ne=TRUE),
                 msg = "Datetime.operators")
 }
 
 test.Datetime.wrap <- function() {
-    fun <- Datetime_wrap
-    checkEquals(as.numeric(fun(1)), as.numeric(as.POSIXct("2001-02-03 01:02:03.123456", tz="UTC")),
+    checkEquals(as.numeric(Datetime_wrap()), as.numeric(as.POSIXct("2001-02-03 01:02:03.123456", tz="UTC")),
                 msg = "Datetime.wrap")
 }
 


From noreply at r-forge.r-project.org  Thu Jul 25 11:50:41 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Thu, 25 Jul 2013 11:50:41 +0200 (CEST)
Subject: [Rcpp-commits] r4407 - in pkg/Rcpp: . src
Message-ID: <20130725095041.88E6318444A@r-forge.r-project.org>

Author: romain
Date: 2013-07-25 11:50:41 +0200 (Thu, 25 Jul 2013)
New Revision: 4407

Modified:
   pkg/Rcpp/ChangeLog
   pkg/Rcpp/src/attributes.cpp
Log:
collect function in a FunctionMap

Modified: pkg/Rcpp/ChangeLog
===================================================================
--- pkg/Rcpp/ChangeLog	2013-07-25 09:00:54 UTC (rev 4406)
+++ pkg/Rcpp/ChangeLog	2013-07-25 09:50:41 UTC (rev 4407)
@@ -6,6 +6,8 @@
         * include/Rcpp/Datetime.h : added is_na method
         * unitTests/cpp/dates.cpp : removed the ignoreme useless parameters
         * unitTests/runit.Date.R : idem
+        * src/attributes.cpp: collecting functions in a FunctionMap. Will use this
+        for dispatching
         
 2013-07-24  Romain Francois <romain at r-enthusiasts.com>
 

Modified: pkg/Rcpp/src/attributes.cpp
===================================================================
--- pkg/Rcpp/src/attributes.cpp	2013-07-25 09:00:54 UTC (rev 4406)
+++ pkg/Rcpp/src/attributes.cpp	2013-07-25 09:50:41 UTC (rev 4407)
@@ -252,6 +252,18 @@
         std::vector<std::string> roxygen_;
     };
 
+    class FunctionMap {
+        std::map< std::string, std::vector<Function> > map_ ;
+        
+    public:
+        FunctionMap(){};
+        ~FunctionMap(){} ;
+        
+        void insert( const Function& fun ){
+            map_[ fun.name() ].push_back( fun ) ;
+        }
+    } ;
+    
     // Operator << for parsed types
     std::ostream& operator<<(std::ostream& os, const Type& type); 
     std::ostream& operator<<(std::ostream& os, const Argument& argument); 
@@ -389,6 +401,7 @@
         std::string sourceFile_;
         CharacterVector lines_;
         std::vector<Attribute> attributes_;
+        FunctionMap functionMap_ ;
         std::vector<std::string> modules_;
         std::vector<std::string> embeddedR_;
         std::vector<std::vector<std::string> > roxygenChunks_; 
@@ -868,8 +881,13 @@
                         continue;
                     
                     // add the attribute
-                    attributes_.push_back(parseAttribute(
-                        Rcpp::as<std::vector<std::string> >(match),  i));
+                    Attribute attr = parseAttribute(
+                        Rcpp::as<std::vector<std::string> >(match),  i); 
+                    attributes_.push_back(attr);
+                    
+                    if( attr.isExportedFunction() ){
+                        functionMap_.insert(attr.function());
+                    }
                 } 
                 
                 // if it's not an attribute line then it could still be a 
@@ -889,8 +907,8 @@
                     }
                 } 
             }
-            
-             // Scan for Rcpp modules 
+             
+            // Scan for Rcpp modules 
             commentState.reset();
             Rcpp::List modMatches = regexMatches(lines_, 
                 "^\\s*RCPP_MODULE\\s*\\(\\s*(\\w+)\\s*\\).*$");


From noreply at r-forge.r-project.org  Sat Jul 27 13:59:22 2013
From: noreply at r-forge.r-project.org (noreply at r-forge.r-project.org)
Date: Sat, 27 Jul 2013 13:59:22 +0200 (CEST)
Subject: [Rcpp-commits] r4408 - in pkg/RcppClassic: . src
Message-ID: <20130727115923.01F41185730@r-forge.r-project.org>

Author: edd
Date: 2013-07-27 13:59:22 +0200 (Sat, 27 Jul 2013)
New Revision: 4408

Modified:
   pkg/RcppClassic/ChangeLog
   pkg/RcppClassic/DESCRIPTION
   pkg/RcppClassic/src/RcppFunction.cpp
Log:
DESCRIPTION: Release 0.9.4
passing an env, not NULL, to eval() as requested by BDR


Modified: pkg/RcppClassic/ChangeLog
===================================================================
--- pkg/RcppClassic/ChangeLog	2013-07-25 09:50:41 UTC (rev 4407)
+++ pkg/RcppClassic/ChangeLog	2013-07-27 11:59:22 UTC (rev 4408)
@@ -1,3 +1,10 @@
+2013-07-27  Dirk Eddelbuettel  <edd at debian.org>
+
+	* DESCRIPTION: Release 0.9.4
+
+	* src/RcppFunction.cpp: In Rf_eval() ensure second argument is an
+	environment as per request by Brian Ripley
+
 2012-12-21  Dirk Eddelbuettel  <edd at debian.org>
 
 	* DESCRIPTION: Release 0.9.3

Modified: pkg/RcppClassic/DESCRIPTION
===================================================================
--- pkg/RcppClassic/DESCRIPTION	2013-07-25 09:50:41 UTC (rev 4407)
+++ pkg/RcppClassic/DESCRIPTION	2013-07-27 11:59:22 UTC (rev 4408)
@@ -1,6 +1,6 @@
 Package: RcppClassic
 Title: Deprecated 'classic' Rcpp API 
-Version: 0.9.3
+Version: 0.9.4
 Date: $Date$
 Author: Dirk Eddelbuettel and Romain Francois, with contributions by David Reiss,
  and based on code written during 2005 and 2006 by Dominick Samperi

Modified: pkg/RcppClassic/src/RcppFunction.cpp
===================================================================
--- pkg/RcppClassic/src/RcppFunction.cpp	2013-07-25 09:50:41 UTC (rev 4407)
+++ pkg/RcppClassic/src/RcppFunction.cpp	2013-07-27 11:59:22 UTC (rev 4408)
@@ -3,7 +3,7 @@
 // RcppFunction.cpp: RcppClassic R/C++ interface class library -- function support
 //
 // Copyright (C) 2005 - 2006 Dominick Samperi
-// Copyright (C) 2008 - 2009 Dirk Eddelbuettel
+// Copyright (C) 2008 - 2013 Dirk Eddelbuettel
 //
 // This file is part of RcppClassic.
 //
@@ -49,7 +49,7 @@
     PROTECT(R_fcall = Rf_lang2(fn, R_NilValue));
     numProtected++;
     SETCADR(R_fcall, listArg);
-    SEXP result = Rf_eval(R_fcall, R_NilValue);
+    SEXP result = Rf_eval(R_fcall, R_EmptyEnv);
     names.clear();
     listSize = currListPosn = 0; // Ready for next call.
     return result;
@@ -62,7 +62,7 @@
     PROTECT(R_fcall = Rf_lang2(fn, R_NilValue));
     numProtected++;
     SETCADR(R_fcall, vectorArg);
-    SEXP result = Rf_eval(R_fcall, R_NilValue);
+    SEXP result = Rf_eval(R_fcall, R_EmptyEnv);
     vectorArg = R_NilValue; // Ready for next call.
     return result;
 }