diff --git a/ChangeLog b/ChangeLog index 1ee4202f5..dd3755cdb 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,11 @@ +2016-08-09 Artem Klevtsov + + * inst/include/Rcpp/macros/dispatch.h: Add variadic conditional macro + when C++11 compiler used + * ints/include/unitTests/cpp/dispatch.cpp: Add unit tests for + RCPP_RETURN_VECTOR and RCPP_RETURN_MATRIX macro + * ints/include/unitTests/runit.dispatch.R: Idem + 2016-08-05 James J Balamuta * inst/examples/FastLM/fastLMviaArmadillo.r: format fix diff --git a/inst/NEWS.Rd b/inst/NEWS.Rd index 68d1f0f1e..1219a99be 100644 --- a/inst/NEWS.Rd +++ b/inst/NEWS.Rd @@ -20,6 +20,9 @@ \ghit{387}). \item String constructors now set default UTF-8 encoding (Qiang Kou in \ghpr{529} fixing \ghit{263}). + \item Add variadic variants of the \code{RCPP_RETURN_VECTOR} and + \code{RCPP_RETURN_MATRIX} macro when C++11 compiler used (Artem Klevtsov + in \ghpr{537} fixing \ghit{38}). } \item Changes in Rcpp unit tests \itemize{ diff --git a/inst/include/Rcpp/macros/dispatch.h b/inst/include/Rcpp/macros/dispatch.h index b9c220d91..15c88bd49 100644 --- a/inst/include/Rcpp/macros/dispatch.h +++ b/inst/include/Rcpp/macros/dispatch.h @@ -22,27 +22,65 @@ #ifndef Rcpp__macros__dispatch_h #define Rcpp__macros__dispatch_h -#define ___RCPP_HANDLE_CASE___( ___RTYPE___ , ___FUN___ , ___OBJECT___ , ___RCPPTYPE___ ) \ - case ___RTYPE___ : \ - return ___FUN___( ::Rcpp::___RCPPTYPE___< ___RTYPE___ >( ___OBJECT___ ) ) ; +#ifdef RCPP_USING_CXX11 +#define ___RCPP_HANDLE_CASE___(___RTYPE___, ___FUN___, ___OBJECT___, \ + ___RCPPTYPE___, ...) \ + case ___RTYPE___: \ + return ___FUN___(::Rcpp::___RCPPTYPE___<___RTYPE___>(___OBJECT___), \ + ##__VA_ARGS__); -#define ___RCPP_RETURN___( __FUN__, __SEXP__ , __RCPPTYPE__ ) \ - SEXP __TMP__ = __SEXP__ ; \ - switch( TYPEOF( __TMP__ ) ){ \ - ___RCPP_HANDLE_CASE___( INTSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \ - ___RCPP_HANDLE_CASE___( REALSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \ - ___RCPP_HANDLE_CASE___( RAWSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \ - ___RCPP_HANDLE_CASE___( LGLSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \ - ___RCPP_HANDLE_CASE___( CPLXSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \ - ___RCPP_HANDLE_CASE___( STRSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \ - ___RCPP_HANDLE_CASE___( VECSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \ - ___RCPP_HANDLE_CASE___( EXPRSXP , __FUN__ , __TMP__ , __RCPPTYPE__ ) \ - default: \ - throw std::range_error( "not a vector" ) ; \ - } +#define ___RCPP_RETURN___(__FUN__, __SEXP__, __RCPPTYPE__, ...) \ + SEXP __TMP__ = __SEXP__; \ + switch (TYPEOF(__TMP__)) { \ + ___RCPP_HANDLE_CASE___(INTSXP, __FUN__, __TMP__, __RCPPTYPE__, \ + ##__VA_ARGS__) \ + ___RCPP_HANDLE_CASE___(REALSXP, __FUN__, __TMP__, __RCPPTYPE__, \ + ##__VA_ARGS__) \ + ___RCPP_HANDLE_CASE___(RAWSXP, __FUN__, __TMP__, __RCPPTYPE__, \ + ##__VA_ARGS__) \ + ___RCPP_HANDLE_CASE___(LGLSXP, __FUN__, __TMP__, __RCPPTYPE__, \ + ##__VA_ARGS__) \ + ___RCPP_HANDLE_CASE___(CPLXSXP, __FUN__, __TMP__, __RCPPTYPE__, \ + ##__VA_ARGS__) \ + ___RCPP_HANDLE_CASE___(STRSXP, __FUN__, __TMP__, __RCPPTYPE__, \ + ##__VA_ARGS__) \ + ___RCPP_HANDLE_CASE___(VECSXP, __FUN__, __TMP__, __RCPPTYPE__, \ + ##__VA_ARGS__) \ + ___RCPP_HANDLE_CASE___(EXPRSXP, __FUN__, __TMP__, __RCPPTYPE__, \ + ##__VA_ARGS__) \ + default: \ + throw std::range_error("Not a vector"); \ + } -#define RCPP_RETURN_VECTOR( _FUN_, _SEXP_ ) ___RCPP_RETURN___( _FUN_, _SEXP_ , Vector ) -#define RCPP_RETURN_MATRIX( _FUN_, _SEXP_ ) ___RCPP_RETURN___( _FUN_, _SEXP_ , Matrix ) +#define RCPP_RETURN_VECTOR(_FUN_, _SEXP_, ...) \ + ___RCPP_RETURN___(_FUN_, _SEXP_, Vector, ##__VA_ARGS__) +#define RCPP_RETURN_MATRIX(_FUN_, _SEXP_, ...) \ + ___RCPP_RETURN___(_FUN_, _SEXP_, Matrix, ##__VA_ARGS__) +#else +#define ___RCPP_HANDLE_CASE___(___RTYPE___, ___FUN___, ___OBJECT___, \ + ___RCPPTYPE___) \ + case ___RTYPE___: \ + return ___FUN___(::Rcpp::___RCPPTYPE___<___RTYPE___>(___OBJECT___)); +#define ___RCPP_RETURN___(__FUN__, __SEXP__, __RCPPTYPE__) \ + SEXP __TMP__ = __SEXP__; \ + switch (TYPEOF(__TMP__)) { \ + ___RCPP_HANDLE_CASE___(INTSXP, __FUN__, __TMP__, __RCPPTYPE__) \ + ___RCPP_HANDLE_CASE___(REALSXP, __FUN__, __TMP__, __RCPPTYPE__) \ + ___RCPP_HANDLE_CASE___(RAWSXP, __FUN__, __TMP__, __RCPPTYPE__) \ + ___RCPP_HANDLE_CASE___(LGLSXP, __FUN__, __TMP__, __RCPPTYPE__) \ + ___RCPP_HANDLE_CASE___(CPLXSXP, __FUN__, __TMP__, __RCPPTYPE__) \ + ___RCPP_HANDLE_CASE___(STRSXP, __FUN__, __TMP__, __RCPPTYPE__) \ + ___RCPP_HANDLE_CASE___(VECSXP, __FUN__, __TMP__, __RCPPTYPE__) \ + ___RCPP_HANDLE_CASE___(EXPRSXP, __FUN__, __TMP__, __RCPPTYPE__) \ + default: \ + throw std::range_error("Not a vector"); \ + } + +#define RCPP_RETURN_VECTOR(_FUN_, _SEXP_) \ + ___RCPP_RETURN___(_FUN_, _SEXP_, Vector) +#define RCPP_RETURN_MATRIX(_FUN_, _SEXP_) \ + ___RCPP_RETURN___(_FUN_, _SEXP_, Matrix) +#endif #endif diff --git a/inst/unitTests/cpp/dispatch.cpp b/inst/unitTests/cpp/dispatch.cpp new file mode 100644 index 000000000..dded61352 --- /dev/null +++ b/inst/unitTests/cpp/dispatch.cpp @@ -0,0 +1,47 @@ +// -*- mode: C++; c-indent-level: 4; c-basic-offset: 4; tab-width: 8 -*- +// +// dispatch.cpp: Rcpp R/C++ interface class library -- dispatch macro 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 . + +#include +using namespace Rcpp ; + +template +T first_el_impl(const T& x) { + T res(1); + res[0] = x[0]; + return res; +} + +// [[Rcpp::export]] +SEXP first_el(SEXP x) { + RCPP_RETURN_VECTOR(first_el_impl, x); +} + +template +T first_cell_impl(const T& x) { + T res(1, 1); + res(0, 0) = x(0, 0); + return res; +} + +// [[Rcpp::export]] +SEXP first_cell(SEXP x) { + RCPP_RETURN_MATRIX(first_cell_impl, x) +} diff --git a/inst/unitTests/runit.dispatch.R b/inst/unitTests/runit.dispatch.R new file mode 100644 index 000000000..c40f7e717 --- /dev/null +++ b/inst/unitTests/runit.dispatch.R @@ -0,0 +1,91 @@ +#!/usr/bin/env r +# -*- mode: R; tab-width: 4; -*- +# +# Copyright (C) 2009 - 2014 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 . + +.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes" + +if (.runThisTest) { + .setUp <- Rcpp:::unitTestSetup("dispatch.cpp") + + test.RawVector <- function() { + x <- as.raw(0:9) + checkEquals(first_el(x), x[1], msg = "RCPP_RETURN_VECTOR (raw)") + } + + test.ComplexVector <- function() { + x <- as.complex(0:9) + checkEquals(first_el(x), x[1], msg = "RCPP_RETURN_VECTOR (complex)") + } + + test.IntegerVector <- function() { + x <- as.integer(0:9) + checkEquals(first_el(x), x[1], msg = "RCPP_RETURN_VECTOR (integer)") + } + + test.NumericVector <- function() { + x <- as.numeric(0:9) + checkEquals(first_el(x), x[1], msg = "RCPP_RETURN_VECTOR (numeric)") + } + + test.ExpressionVector <- function() { + x <- parse(text = "rnrom; rnrom(10); mean(1:10)") + checkEquals(first_el(x), x[1], msg = "RCPP_RETURN_VECTOR (numeric)") + } + + test.GenericVector <- function() { + x <- list("foo", 10L, 10.2, FALSE) + checkEquals(first_el(x), x[1], msg = "RCPP_RETURN_VECTOR (list)") + } + + test.CharacterVector <- function() { + x <- as.character(0:9) + checkEquals(first_el(x), x[1], msg = "RCPP_RETURN_VECTOR (character)") + } + + test.RawMatrix <- function() { + x <- matrix(as.raw(0:9), ncol = 2L) + checkEquals(first_cell(x), x[1, 1, drop = FALSE], msg = "RCPP_RETURN_MATRIX (raw)") + } + + test.ComplexMatrix <- function() { + x <- matrix(as.complex(0:9), ncol = 2L) + checkEquals(first_cell(x), x[1, 1, drop = FALSE], msg = "RCPP_RETURN_MATRIX (complex)") + } + + test.IntegerMatrix <- function() { + x <- matrix(as.integer(0:9), ncol = 2L) + checkEquals(first_cell(x), x[1, 1, drop = FALSE], msg = "RCPP_RETURN_MATRIX (integer)") + } + + test.NumericMatrix <- function() { + x <- matrix(as.numeric(0:9), ncol = 2L) + checkEquals(first_cell(x), x[1, 1, drop = FALSE], msg = "RCPP_RETURN_MATRIX (numeric)") + } + + test.GenericMatrix <- function() { + x <- matrix(lapply(0:9, function(.) 0:9), ncol = 2L) + checkEquals(first_cell(x), x[1, 1, drop = FALSE], msg = "RCPP_RETURN_MATRIX (list)") + } + + test.CharacterMatrix <- function() { + x <- matrix(as.character(0:9), ncol = 2L) + checkEquals(first_cell(x), x[1, 1, drop = FALSE], msg = "RCPP_RETURN_MATRIX (character)") + } + +}