1
2##  Copyright (C) 2009 - 2019  Romain Francois and Dirk Eddelbuettel
3##
4##  This file is part of Rcpp.
5##
6##  Rcpp is free software: you can redistribute it and/or modify it
7##  under the terms of the GNU General Public License as published by
8##  the Free Software Foundation, either version 2 of the License, or
9##  (at your option) any later version.
10##
11##  Rcpp is distributed in the hope that it will be useful, but
12##  WITHOUT ANY WARRANTY; without even the implied warranty of
13##  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
14##  GNU General Public License for more details.
15##
16##  You should have received a copy of the GNU General Public License
17##  along with Rcpp.  If not, see <http://www.gnu.org/licenses/>.
18
19if (Sys.getenv("RunAllRcppTests") != "yes") exit_file("Set 'RunAllRcppTests' to 'yes' to run.")
20
21Rcpp::sourceCpp("cpp/RObject.cpp")
22
23#    test.RObject.asDouble <- function(){
24expect_equal( asDouble(2.123), 4.246, info = "as<double>( REALSXP ) " )
25expect_equal( asDouble(2L), 4.0, info = "as<double>( INTSXP ) " )
26expect_equal( asDouble(as.raw(2L)), 4.0, info = "as<double>( RAWSXP )" )
27expect_error( asDouble('2'), info = "as<double>( STRSXP ) -> exception" )
28expect_error( asDouble(2:3), info = "as<double> expects the vector to be of length 1" )
29
30#    test.RObject.asInt <- function(){
31expect_equal( asInt(2.123), 4L, info = "as<int>( REALSXP )" )
32expect_equal( asInt(2), 4L, info = "as<int>( REALSXP )" )
33expect_equal( asInt(2L), 4.0, info = "as<int>( INTSXP )" )
34expect_equal( asInt(as.raw(2L)), 4.0, info = "as<int>( RAWSXP )" )
35expect_error( asInt( '2'), info = "as<int> can not convert character" )
36expect_error( asInt( 2:3), info = "as<int> expects the vector to be of length 1" )
37
38#    test.RObject.asStdString <- function(){
39expect_equal( asStdString("abc"), "abcabc", info = "as<std::string>" )
40expect_error( asStdString(NULL), info = "as<std::string> expects character vector" )
41expect_error( asStdString(0L), info = "as<std::string> expects character vector" )
42expect_error( asStdString(0.1), info = "as<std::string> expects character vector" )
43expect_error( asStdString(as.raw(0L)), info = "as<std::string> expects character vector" )
44
45expect_error( asStdString(letters), info = "as<std::string> expects single string" )
46
47#    test.RObject.asRaw <- function(){
48expect_equal( asRaw(1L), as.raw(2L), info = "as<Rbyte>(integer)" )
49expect_equal( asRaw(1.3), as.raw(2L), info = "as<Rbyte>(numeric)" )
50expect_equal( asRaw(as.raw(1)), as.raw(2L), info = "as<Rbyte>(raw)" )
51expect_error( asRaw(NULL) , info = "as<Rbyte>(NULL) -> exception" )
52expect_error( asRaw("foo") , info = "as<Rbyte>(character) -> exception" )
53expect_error( asRaw(1:2), info = "as<Rbyte>(>1 integer) -> exception" )
54expect_error( asRaw(as.numeric(1:2)), info = "as<Rbyte>(>1 numeric) -> exception" )
55expect_error( asRaw(as.raw(1:3)), info = "as<Rbyte>(>1 raw) -> exception" )
56expect_error( asRaw(integer(0)), info = "as<Rbyte>(0 integer) -> exception" )
57expect_error( asRaw(numeric(0)), info = "as<Rbyte>(0 numeric) -> exception" )
58expect_error( asRaw(raw(0)), info = "as<Rbyte>(0 raw) -> exception" )
59
60#    test.RObject.asLogical <- function(){
61expect_true( !asLogical(TRUE), info = "as<bool>(TRUE) -> true" )
62expect_true( asLogical(FALSE), info = "as<bool>(FALSE) -> false" )
63expect_true( !asLogical(1L), info = "as<bool>(1L) -> true" )
64expect_true( asLogical(0L), info = "as<bool>(0L) -> false" )
65expect_true( !asLogical(1.0), info = "as<bool>(1.0) -> true" )
66expect_true( asLogical(0.0), info = "as<bool>0.0) -> false" )
67expect_true( !asLogical(as.raw(1)), info = "as<bool>(aw.raw(1)) -> true" )
68expect_true( asLogical(as.raw(0)), info = "as<bool>(as.raw(0)) -> false" )
69
70expect_error( asLogical(NULL), info = "as<bool>(NULL) -> exception" )
71expect_error( asLogical(c(TRUE,FALSE)), info = "as<bool>(>1 logical) -> exception" )
72expect_error( asLogical(1:2), info = "as<bool>(>1 integer) -> exception" )
73expect_error( asLogical(1:2+.1), info = "as<bool>(>1 numeric) -> exception" )
74expect_error( asLogical(as.raw(1:2)), info = "as<bool>(>1 raw) -> exception" )
75
76expect_error( asLogical(integer(0)), info = "as<bool>(0 integer) -> exception" )
77expect_error( asLogical(numeric(0)), info = "as<bool>(0 numeric) -> exception" )
78expect_error( asLogical(raw(0)), info = "as<bool>(0 raw) -> exception" )
79
80#    test.RObject.asStdVectorInt <- function(){
81expect_equal( asStdVectorInt(x=2:5), 2:5*2L, info = "as< std::vector<int> >(integer)" )
82expect_equal( asStdVectorInt(x=2:5+.1), 2:5*2L, info = "as< std::vector<int> >(numeric)" )
83expect_equal( asStdVectorInt(x=as.raw(2:5)), 2:5*2L, info = "as< std::vector<int> >(raw)" )
84expect_error( asStdVectorInt("foo"), info = "as< std::vector<int> >(character) -> exception" )
85expect_error( asStdVectorInt(NULL), info = "as< std::vector<int> >(NULL) -> exception" )
86
87#    test.RObject.asStdVectorDouble <- function(){
88expect_equal( asStdVectorDouble(x=0.1+2:5), 2*(0.1+2:5), info = "as< std::vector<double> >( numeric )" )
89expect_equal( asStdVectorDouble(x=2:5), 2*(2:5), info = "as< std::vector<double> >(integer)" )
90expect_equal( asStdVectorDouble(x=as.raw(2:5)), 2*(2:5), info = "as< std::vector<double> >(raw)" )
91expect_error( asStdVectorDouble("foo"), info = "as< std::vector<double> >(character) -> exception" )
92expect_error( asStdVectorDouble(NULL), info = "as< std::vector<double> >(NULL) -> exception" )
93
94#    test.RObject.asStdVectorRaw <- function(){
95expect_equal( asStdVectorRaw(x=as.raw(0:9)), as.raw(2*(0:9)), info = "as< std::vector<Rbyte> >(raw)" )
96expect_equal( asStdVectorRaw(x=0:9), as.raw(2*(0:9)), info = "as< std::vector<Rbyte> >( integer )" )
97expect_equal( asStdVectorRaw(x=as.numeric(0:9)), as.raw(2*(0:9)), info = "as< std::vector<Rbyte> >(numeric)" )
98expect_error( asStdVectorRaw("foo"), info = "as< std::vector<Rbyte> >(character) -> exception" )
99expect_error( asStdVectorRaw(NULL), info = "as< std::vector<Rbyte> >(NULL) -> exception" )
100
101#    test.RObject.asStdVectorBool <- function(){
102expect_equal( asStdVectorBool(x=c(TRUE,FALSE)), c(FALSE, TRUE), info = "as< std::vector<bool> >(logical)" )
103expect_equal( asStdVectorBool(x=c(1L, 0L)), c(FALSE, TRUE), info = "as< std::vector<bool> >(integer)" )
104expect_equal( asStdVectorBool(x=c(1.0, 0.0)), c(FALSE, TRUE), info = "as< std::vector<bool> >(numeric)" )
105expect_equal( asStdVectorBool(x=as.raw(c(1,0))), c(FALSE, TRUE), info = "as< std::vector<bool> >(raw)" )
106expect_error( asStdVectorBool("foo"), info = "as< std::vector<bool> >(character) -> exception" )
107expect_error( asStdVectorBool(NULL), info = "as< std::vector<bool> >(NULL) -> exception" )
108
109#    test.RObject.asStdVectorString <- function(){
110expect_equal( asStdVectorString(c("foo", "bar")), c("foofoo", "barbar"), info = "as< std::vector<std::string> >(character)" )
111expect_error( asStdVectorString(1L), info = "as< std::vector<std::string> >(integer) -> exception" )
112expect_error( asStdVectorString(1.0), info = "as< std::vector<std::string> >(numeric) -> exception" )
113expect_error( asStdVectorString(as.raw(1)), info = "as< std::vector<std::string> >(raw) -> exception" )
114expect_error( asStdVectorString(TRUE), info = "as< std::vector<std::string> >(logical) -> exception" )
115expect_error( asStdVectorString(NULL), info = "as< std::vector<std::string> >(NULL) -> exception" )
116
117#    test.RObject.stdsetint <- function(){
118expect_equal( stdsetint(), c(0L, 1L), info = "wrap( set<int> )" )
119
120#    test.RObject.stdsetdouble <- function(){
121expect_equal( stdsetdouble(), as.numeric(0:1), info = "wrap( set<double>" )
122
123#    test.RObject.stdsetraw <- function(){
124expect_equal( stdsetraw(), as.raw(0:1), info = "wrap(set<raw>)" )
125
126#    test.RObject.stdsetstring <- function(){
127expect_equal( stdsetstring(), c("bar", "foo"), info = "wrap(set<string>)" )
128
129#    test.RObject.attributeNames <- function(){
130df <- data.frame( x = 1:10, y = 1:10 )
131expect_true( all( c("names","row.names","class") %in% attributeNames(df)), info = "RObject.attributeNames" )
132
133#    test.RObject.hasAttribute <- function(){
134df <- data.frame( x = 1:10 )
135expect_true( hasAttribute( df ), info = "RObject.hasAttribute" )
136
137#    test.RObject.attr <- function(){
138df <- data.frame( x = 1:150 )
139rownames(df) <- 1:150
140expect_equal( attr_( iris ), 1:150, info = "RObject.attr" )
141
142#    test.RObject.attr.set <- function(){
143expect_equal( attr(attr_set(), "foo"), 10L, info = "RObject.attr() = " )
144
145#    test.RObject.isNULL <- function(){
146df <- data.frame( x = 1:10 )
147expect_true( !isNULL( df ), info = "RObject.isNULL(data frame) -> false" )
148expect_true( !isNULL(1L), info = "RObject.isNULL(integer) -> false" )
149expect_true( !isNULL(1.0), info = "RObject.isNULL(numeric) -> false" )
150expect_true( !isNULL(as.raw(1)), info = "RObject.isNULL(raw) -> false" )
151expect_true( !isNULL(letters), info = "RObject.isNULL(character) -> false")
152#expect_true( !isNULL(test.RObject.isNULL), info = "RObject.isNULL(function) -> false" )
153expect_true( !isNULL(base::ls), info = "RObject.isNULL(function) -> false" )
154expect_true( !isNULL(.GlobalEnv), info = "RObject.isNULL(environment) -> false" )
155expect_true( isNULL(NULL), info = "RObject.isNULL(NULL) -> true" )
156
157#    test.RObject.inherits <- function(){
158x <- 1:10
159expect_true( !inherits_(x) )
160class(x) <- "foo"
161expect_true( inherits_(x) )
162class(x) <- c("foo", "bar" )
163expect_true( inherits_(x) )
164