[Rcpp-commits] r4378 - in pkg/Rcpp: . inst/unitTests inst/unitTests/cpp
noreply at r-forge.r-project.org
noreply at r-forge.r-project.org
Tue Jul 2 11:00:31 CEST 2013
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(){
More information about the Rcpp-commits
mailing list