Add variadic variants of the RCPP_RETURN_VECTOR/MATRIX macro

ChangeLog

@@ -1,3 +1,11 @@
+2016-08-09  Artem Klevtsov <a.a.klevtsov@gmail.com>
+
+        * 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  <balamut2@illinois.edu>
 
         * inst/examples/FastLM/fastLMviaArmadillo.r: format fix

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{

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

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 <http://www.gnu.org/licenses/>. 
+
+#include <Rcpp.h>
+using namespace Rcpp ;
+
+template <typename T>
+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 <typename T>
+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)
+}

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 <http://www.gnu.org/licenses/>.
+
+.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)")
+    }
+
+}