Add unit tests for RCPP_RETURN_VECTOR/MATRIX macro

Author: artemklevtsov

ChangeLog

@@ -2,6 +2,9 @@
 
         * 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/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,96 @@
+#!/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.ExpressionVector <- function() {
+        x <- as.expression(0:9)
+        checkEquals(first_el(x), x[1], msg = "RCPP_RETURN_VECTOR (expression)")
+    }
+    
+    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.GenericVector <- function() {
+        x <- as.list(0:9)
+        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.ExpressionMatrix <- function() {
+        x <- matrix(as.expression(0:9), ncol = 2L)
+        checkEquals(first_cell(x), x[1, 1, drop = FALSE], msg = "RCPP_RETURN_MATRIX (expression)")
+    }
+    
+    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(.) as.list(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)")
+    }
+    
+}