1#!/usr/bin/env r 2# 3# Copyright (C) 2009 - 2016 Dirk Eddelbuettel and Romain Francois 4# Copyright (C) 2016 - 2019 Dirk Eddelbuettel, Romain Francois and Nathan Russell 5# 6# This file is part of Rcpp. 7# 8# Rcpp is free software: you can redistribute it and/or modify it 9# under the terms of the GNU General Public License as published by 10# the Free Software Foundation, either version 2 of the License, or 11# (at your option) any later version. 12# 13# Rcpp is distributed in the hope that it will be useful, but 14# WITHOUT ANY WARRANTY; without even the implied warranty of 15# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 16# GNU General Public License for more details. 17# 18# You should have received a copy of the GNU General Public License 19# along with Rcpp. If not, see <http://www.gnu.org/licenses/>. 20 21if (Sys.getenv("RunAllRcppTests") != "yes") exit_file("Set 'RunAllRcppTests' to 'yes' to run.") 22 23Rcpp::sourceCpp("cpp/dispatch.cpp") 24 25# test.RawVector <- function() { 26x <- as.raw(0:9) 27expect_equal(first_el(x), x[1], info = "RCPP_RETURN_VECTOR (raw)") 28 29# test.ComplexVector <- function() { 30x <- as.complex(0:9) 31expect_equal(first_el(x), x[1], info = "RCPP_RETURN_VECTOR (complex)") 32 33# test.IntegerVector <- function() { 34x <- as.integer(0:9) 35expect_equal(first_el(x), x[1], info = "RCPP_RETURN_VECTOR (integer)") 36 37# test.NumericVector <- function() { 38x <- as.numeric(0:9) 39expect_equal(first_el(x), x[1], info = "RCPP_RETURN_VECTOR (numeric)") 40 41# test.ExpressionVector <- function() { 42x <- expression(rnorm, rnorm(10), mean(1:10)) 43expect_equal(first_el(x), x[1], info = "RCPP_RETURN_VECTOR (expression)") 44 45# test.GenericVector <- function() { 46x <- list("foo", 10L, 10.2, FALSE) 47expect_equal(first_el(x), x[1], info = "RCPP_RETURN_VECTOR (list)") 48 49# test.CharacterVector <- function() { 50x <- as.character(0:9) 51expect_equal(first_el(x), x[1], info = "RCPP_RETURN_VECTOR (character)") 52 53# test.RawMatrix <- function() { 54x <- matrix(as.raw(0:9), ncol = 2L) 55expect_equal(first_cell(x), x[1, 1, drop = FALSE], info = "RCPP_RETURN_MATRIX (raw)") 56 57# test.ComplexMatrix <- function() { 58x <- matrix(as.complex(0:9), ncol = 2L) 59expect_equal(first_cell(x), x[1, 1, drop = FALSE], info = "RCPP_RETURN_MATRIX (complex)") 60 61# test.IntegerMatrix <- function() { 62x <- matrix(as.integer(0:9), ncol = 2L) 63expect_equal(first_cell(x), x[1, 1, drop = FALSE], info = "RCPP_RETURN_MATRIX (integer)") 64 65# test.NumericMatrix <- function() { 66x <- matrix(as.numeric(0:9), ncol = 2L) 67expect_equal(first_cell(x), x[1, 1, drop = FALSE], info = "RCPP_RETURN_MATRIX (numeric)") 68 69# test.GenericMatrix <- function() { 70x <- matrix(lapply(0:9, function(.) 0:9), ncol = 2L) 71expect_equal(first_cell(x), x[1, 1, drop = FALSE], info = "RCPP_RETURN_MATRIX (list)") 72 73# test.CharacterMatrix <- function() { 74x <- matrix(as.character(0:9), ncol = 2L) 75expect_equal(first_cell(x), x[1, 1, drop = FALSE], info = "RCPP_RETURN_MATRIX (character)") 76