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

noreply at r-forge.r-project.org noreply at r-forge.r-project.org
Sun Jun 30 22:12:33 CEST 2013


Author: romain
Date: 2013-06-30 22:12:33 +0200 (Sun, 30 Jun 2013)
New Revision: 4376

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

Added: pkg/Rcpp/inst/unitTests/cpp/as.cpp
===================================================================
--- pkg/Rcpp/inst/unitTests/cpp/as.cpp	                        (rev 0)
+++ pkg/Rcpp/inst/unitTests/cpp/as.cpp	2013-06-30 20:12:33 UTC (rev 4376)
@@ -0,0 +1,60 @@
+// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*-
+//
+// as.cpp: Rcpp R/C++ interface class library -- as<> 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]]
+int as_int( SEXP x){ return as<int>( x ); }
+
+// [[Rcpp::export]]
+double as_double( SEXP x){ return as<double>( x ); }
+
+// [[Rcpp::export]]
+Rbyte as_Rbyte( SEXP x){ return as<Rbyte>( x ); }
+
+// [[Rcpp::export]]
+bool as_bool( SEXP x){ return as<bool>( x ); }
+
+// [[Rcpp::export]]
+std::string as_string( SEXP x){ return as<std::string>( x ); }
+
+// [[Rcpp::export]]
+std::vector<int> as_vector_int( SEXP x){ return as< std::vector<int> >(x) ; }
+
+// [[Rcpp::export]]
+std::vector<double> as_vector_double( SEXP x){ return as< std::vector<double> >(x) ; }
+
+// [[Rcpp::export]]
+std::vector<Rbyte> as_vector_raw( SEXP x){ return as< std::vector<Rbyte> >(x) ; }
+
+// [[Rcpp::export]]
+std::vector<bool> as_vector_bool( SEXP x){ return as< std::vector<bool> >(x) ; }
+
+// [[Rcpp::export]]
+std::vector<std::string> as_vector_string( SEXP x){ return as< std::vector<std::string> >(x) ; }
+
+// [[Rcpp::export]]
+std::deque<int> as_deque_int( SEXP x){ return as< std::deque<int> >(x) ; }
+
+// [[Rcpp::export]]
+std::list<int> as_list_int( SEXP x){ return as< std::list<int> >(x) ; }
+

Modified: pkg/Rcpp/inst/unitTests/runit.as.R
===================================================================
--- pkg/Rcpp/inst/unitTests/runit.as.R	2013-06-27 02:33:20 UTC (rev 4375)
+++ pkg/Rcpp/inst/unitTests/runit.as.R	2013-06-30 20:12:33 UTC (rev 4376)
@@ -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,160 +21,82 @@
 
 if (.runThisTest) {
 
-definitions <- function() {
-    list("as_int"=list(
-              signature(x="numeric"),
-              'int y = as<int>(x);
-           return wrap(y) ;')
-
-              ,"as_double"=list(
-               signature(x="numeric"),
-               'double y = as<double>(x) ;
-        return wrap(y) ;')
-
-              ,"as_raw"=list(
-               signature(x="numeric"),
-               'Rbyte y = as<Rbyte>(x) ;
-            return wrap(y) ;')
-
-              ,"as_bool"=list(
-               signature(x="numeric"),
-               'bool y = as<bool>(x) ;
-            return wrap(y) ;')
-
-              ,"as_string"=list(
-               signature(x="character"),
-               'std::string y = as<std::string>(x) ;
-            return wrap(y) ;')
-
-              ,"as_vector_int"=list(
-               signature(x="numeric"),
-               'vector<int> y = as< vector<int> >(x) ;
-            return wrap(y) ;')
-
-              ,"as_vector_double"=list(
-               signature(x="numeric"),
-               'vector<double> y = as< vector<double> >(x) ;
-            return wrap(y) ;')
-
-              ,"as_vector_raw"=list(
-               signature(x="numeric"),
-               'vector<Rbyte> y = as< vector<Rbyte> >(x) ;
-            return wrap(y) ;')
-
-              ,"as_vector_bool"=list(
-               signature(x="numeric"),
-               'vector<bool> y = as< vector<bool> >(x) ;
-            return wrap(y) ;')
-
-              ,"as_vector_string"=list(
-               signature(x="character"),
-               'vector<string> y = as< vector<string> >(x) ;
-            return wrap(y) ;')
-
-              ,"as_deque_int"=list(
-               signature(x="integer"),
-               'deque<int> y = as< deque<int> >(x) ;
-        return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;')
-
-              ,"as_list_int"=list(
-               signature(x="integer"),
-               'list<int> y = as< list<int> >(x) ;
-            return wrap( accumulate( y.begin(), y.end(), 0.0 ) ) ;')
-            )
-}
 .setUp <- function() {
-    tests <- ".rcpp.as"
-    if( ! exists( tests, globalenv() )) {
-        fun <- Rcpp:::compile_unit_tests(definitions())
-        assign( tests, fun, globalenv() )
-    }
+    sourceCpp(file.path(pathRcppTests, "cpp/as.cpp"))
 }
 
 
 test.as.int <- function(){
-    fun <- .rcpp.as$as_int
-    checkEquals( fun(10), 10L, msg = "as<int>( REALSXP ) " )
-    checkEquals( fun(10L), 10L, msg = "as<int>( INTSXP ) " )
-    checkEquals( fun(as.raw(10L)), 10L, msg = "as<int>( RAWSXP ) " )
-    checkEquals( fun(TRUE), 1L, msg = "as<int>( LGLSXP ) " )
+    checkEquals( as_int(10), 10L, msg = "as<int>( REALSXP ) " )
+    checkEquals( as_int(10L), 10L, msg = "as<int>( INTSXP ) " )
+    checkEquals( as_int(as.raw(10L)), 10L, msg = "as<int>( RAWSXP ) " )
+    checkEquals( as_int(TRUE), 1L, msg = "as<int>( LGLSXP ) " )
 }
 
 test.as.double <- function(){
-    fun <- .rcpp.as$as_double
-    checkEquals( fun(10), 10.0, msg = "as<double>( REALSXP ) " )
-    checkEquals( fun(10L), 10.0, msg = "as<double>( INTSXP ) " )
-    checkEquals( fun(as.raw(10L)), 10.0, msg = "as<double>( RAWSXP ) " )
-    checkEquals( fun(TRUE), 1.0, msg = "as<double>( LGLSXP ) " )
+    checkEquals( as_double(10), 10.0, msg = "as<double>( REALSXP ) " )
+    checkEquals( as_double(10L), 10.0, msg = "as<double>( INTSXP ) " )
+    checkEquals( as_double(as.raw(10L)), 10.0, msg = "as<double>( RAWSXP ) " )
+    checkEquals( as_double(TRUE), 1.0, msg = "as<double>( LGLSXP ) " )
 }
 
 test.as.raw <- function(){
-    fun <- .rcpp.as$as_raw
-    checkEquals( fun(10), as.raw(10), msg = "as<Rbyte>( REALSXP ) " )
-    checkEquals( fun(10L), as.raw(10), msg = "as<Rbyte>( INTSXP ) " )
-    checkEquals( fun(as.raw(10L)), as.raw(10), msg = "as<Rbyte>( RAWSXP ) " )
-    checkEquals( fun(TRUE), as.raw(1), msg = "as<Rbyte>( LGLSXP ) " )
+    checkEquals( as_raw(10), as.raw(10), msg = "as<Rbyte>( REALSXP ) " )
+    checkEquals( as_raw(10L), as.raw(10), msg = "as<Rbyte>( INTSXP ) " )
+    checkEquals( as_raw(as.raw(10L)), as.raw(10), msg = "as<Rbyte>( RAWSXP ) " )
+    checkEquals( as_raw(TRUE), as.raw(1), msg = "as<Rbyte>( LGLSXP ) " )
 }
 
 test.as.bool <- function(){
-    fun <- .rcpp.as$as_bool
-    checkEquals( fun(10), as.logical(10), msg = "as<bool>( REALSXP ) " )
-    checkEquals( fun(10L), as.logical(10), msg = "as<bool>( INTSXP ) " )
-    checkEquals( fun(as.raw(10L)), as.logical(10), msg = "as<bool>( RAWSXP ) " )
-    checkEquals( fun(TRUE), as.logical(1), msg = "as<bool>( LGLSXP ) " )
+    checkEquals( as_bool(10), as.logical(10), msg = "as<bool>( REALSXP ) " )
+    checkEquals( as_bool(10L), as.logical(10), msg = "as<bool>( INTSXP ) " )
+    checkEquals( as_bool(as.raw(10L)), as.logical(10), msg = "as<bool>( RAWSXP ) " )
+    checkEquals( as_bool(TRUE), as.logical(1), msg = "as<bool>( LGLSXP ) " )
 }
 
 test.as.string <- function(){
-    fun <- .rcpp.as$as_string
-    checkEquals( fun("foo"), "foo", msg = "as<string>( STRSXP ) " )
+    checkEquals( as_string("foo"), "foo", msg = "as<string>( STRSXP ) " )
 }
 
 test.as.vector.int <- function(){
-    fun <- .rcpp.as$as_vector_int
-    checkEquals( fun(1:10), 1:10 , msg = "as<vector<int>>( INTSXP ) " )
-    checkEquals( fun(as.numeric(1:10)), 1:10 , msg = "as<vector<int>>( REALSXP ) " )
-    checkEquals( fun(as.raw(1:10)), 1:10 , msg = "as<vector<int>>( RAWSXP ) " )
-    checkEquals( fun(c(TRUE,FALSE)), 1:0 , msg = "as<vector<int>>( LGLSXP ) " )
+    checkEquals( as_vector_int(1:10), 1:10 , msg = "as<vector<int>>( INTSXP ) " )
+    checkEquals( as_vector_int(as.numeric(1:10)), 1:10 , msg = "as<vector<int>>( REALSXP ) " )
+    checkEquals( as_vector_int(as.raw(1:10)), 1:10 , msg = "as<vector<int>>( RAWSXP ) " )
+    checkEquals( as_vector_int(c(TRUE,FALSE)), 1:0 , msg = "as<vector<int>>( LGLSXP ) " )
 }
 
 test.as.vector.double <- function(){
-    fun <- .rcpp.as$as_vector_double
-    checkEquals( fun(1:10), as.numeric(1:10) , msg = "as<vector<double>>( INTSXP ) " )
-    checkEquals( fun(as.numeric(1:10)), as.numeric(1:10) , msg = "as<vector<double>>( REALSXP ) " )
-    checkEquals( fun(as.raw(1:10)), as.numeric(1:10), msg = "as<vector<double>>( RAWSXP ) " )
-    checkEquals( fun(c(TRUE,FALSE)), c(1.0, 0.0) , msg = "as<vector<double>>( LGLSXP ) " )
+    checkEquals( as_vector_double(1:10), as.numeric(1:10) , msg = "as<vector<double>>( INTSXP ) " )
+    checkEquals( as_vector_double(as.numeric(1:10)), as.numeric(1:10) , msg = "as<vector<double>>( REALSXP ) " )
+    checkEquals( as_vector_double(as.raw(1:10)), as.numeric(1:10), msg = "as<vector<double>>( RAWSXP ) " )
+    checkEquals( as_vector_double(c(TRUE,FALSE)), c(1.0, 0.0) , msg = "as<vector<double>>( LGLSXP ) " )
 }
 
 test.as.vector.raw <- function(){
-    fun <- .rcpp.as$as_vector_raw
-    checkEquals( fun(1:10), as.raw(1:10) , msg = "as<vector<Rbyte>>( INTSXP ) " )
-    checkEquals( fun(as.numeric(1:10)), as.raw(1:10) , msg = "as<vector<Rbyte>>( REALSXP ) " )
-    checkEquals( fun(as.raw(1:10)), as.raw(1:10) , msg = "as<vector<Rbyte>>( RAWSXP ) " )
-    checkEquals( fun(c(TRUE,FALSE)), as.raw(1:0) , msg = "as<vector<Rbyte>>( LGLSXP ) " )
+    checkEquals( as_vector_raw(1:10), as.raw(1:10) , msg = "as<vector<Rbyte>>( INTSXP ) " )
+    checkEquals( as_vector_raw(as.numeric(1:10)), as.raw(1:10) , msg = "as<vector<Rbyte>>( REALSXP ) " )
+    checkEquals( as_vector_raw(as.raw(1:10)), as.raw(1:10) , msg = "as<vector<Rbyte>>( RAWSXP ) " )
+    checkEquals( as_vector_raw(c(TRUE,FALSE)), as.raw(1:0) , msg = "as<vector<Rbyte>>( LGLSXP ) " )
 }
 
 test.as.vector.bool <- function(){
-    fun <- .rcpp.as$as_vector_bool
-    checkEquals( fun(0:10), as.logical(0:10) , msg = "as<vector<bool>>( INTSXP ) " )
-    checkEquals( fun(as.numeric(0:10)), as.logical(0:10) , msg = "as<vector<bool>>( REALSXP ) " )
-    checkEquals( fun(as.raw(0:10)), as.logical(0:10) , msg = "as<vector<bool>>( RAWSXP ) " )
-    checkEquals( fun(c(TRUE,FALSE)), as.logical(1:0) , msg = "as<vector<bool>>( LGLSXP ) " )
+    checkEquals( as_vector_bool(0:10), as.logical(0:10) , msg = "as<vector<bool>>( INTSXP ) " )
+    checkEquals( as_vector_bool(as.numeric(0:10)), as.logical(0:10) , msg = "as<vector<bool>>( REALSXP ) " )
+    checkEquals( as_vector_bool(as.raw(0:10)), as.logical(0:10) , msg = "as<vector<bool>>( RAWSXP ) " )
+    checkEquals( as_vector_bool(c(TRUE,FALSE)), as.logical(1:0) , msg = "as<vector<bool>>( LGLSXP ) " )
 }
 
 
 test.as.vector.string <- function(){
-    fun <- .rcpp.as$as_vector_string
-    checkEquals( fun(letters), letters , msg = "as<vector<string>>( STRSXP ) " )
+    checkEquals( as_vector_string(letters), letters , msg = "as<vector<string>>( STRSXP ) " )
 }
 
 test.as.deque.int <- function(){
-    fun <- .rcpp.as$as_deque_int
-    checkEquals( fun(1:10), sum(1:10) , msg = "as<deque<int>>( INTSXP ) " )
+    checkEquals( as_deque_int(1:10), 1:10 , msg = "as<deque<int>>( INTSXP ) " )
 }
 
 test.as.list.int <- function(){
-    fun <- .rcpp.as$as_list_int
-    checkEquals( fun(1:10), sum(1:10) , msg = "as<list<int>>( INTSXP ) " )
+    checkEquals( as_list_int(1:10), 1:10 , msg = "as<list<int>>( INTSXP ) " )
 }
 
 }



More information about the Rcpp-commits mailing list