Skip to content

Commit fc60f67

Browse files
eddelbuetteleddelbuettel
committed
tinytest step nine: convert language and listof
1 parent 6027a55 commit fc60f67

File tree

7 files changed

+223
-273
lines changed

7 files changed

+223
-273
lines changed

‎ChangeLog‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,8 @@
1717
* inst/tinytest/test_interface.R: Idem (but inactive for now)
1818
* inst/tinytest/test_internal_function.R: Idem
1919
* inst/tinytest/test_internal_function_cpp11.R: Idem
20+
* inst/tinytest/test_language.R: Idem
21+
* inst/tinytest/test_listof.R: Idem
2022

2123
2019-11-23 Dirk Eddelbuettel <edd@debian.org>
2224

inst/unitTests/cpp/ListOf.cpp renamed to inst/tinytest/cpp/ListOf.cpp

File renamed without changes.

inst/unitTests/cpp/language.cpp renamed to inst/tinytest/cpp/language.cpp

File renamed without changes.

‎inst/tinytest/test_language.R‎

Lines changed: 144 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,144 @@
1+
2+
## Copyright (C) 2010 - 2014 Dirk Eddelbuettel and Romain Francois
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+
19+
.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
20+
21+
if (!.runThisTest) exit_file("Skipping, set 'RunAllRcppTests=yes' to run.")
22+
23+
library(Rcpp)
24+
sourceCpp("cpp/language.cpp")
25+
26+
# test.Language <- function(){
27+
expect_equal( runit_language( call("rnorm") ), call("rnorm" ), info = "Language( LANGSXP )" )
28+
expect_error( runit_language(test.Language), info = "Language not compatible with function" )
29+
expect_error( runit_language(new.env()), info = "Language not compatible with environment" )
30+
expect_error( runit_language(1:10), info = "Language not compatible with integer" )
31+
expect_error( runit_language(TRUE), info = "Language not compatible with logical" )
32+
expect_error( runit_language(1.3), info = "Language not compatible with numeric" )
33+
expect_error( runit_language(as.raw(1) ), info = "Language not compatible with raw" )
34+
35+
# test.Language.variadic <- function(){
36+
expect_equal( runit_lang_variadic_1(), call("rnorm", 10L, 0.0, 2.0 ),
37+
info = "variadic templates" )
38+
39+
expect_equal( runit_lang_variadic_2(), call("rnorm", 10L, mean = 0.0, 2.0 ),
40+
info = "variadic templates (with names)" )
41+
42+
## same as above but without variadic templates
43+
# test.Language.push.back <- function(){
44+
expect_equal( runit_lang_push_back(),
45+
call("rnorm", 10L, mean = 0.0, 2.0 ),
46+
info = "Language::push_back" )
47+
48+
# test.Language.square <- function(){
49+
expect_equal( runit_lang_square_rv(), 10.0, info = "Language::operator[] used as rvalue" )
50+
expect_equal( runit_lang_square_lv(), call("rnorm", "foobar", 20.0, 20.0) , info = "Pairlist::operator[] used as lvalue" )
51+
52+
# test.Language.function <- function(){
53+
expect_equal( runit_lang_fun(sort, sample(1:10)), 1:10, info = "Language( Function ) " )
54+
55+
# test.Language.inputoperator <- function(){
56+
expect_equal( runit_lang_inputop(), call("rnorm", 10L, sd = 10L ) , info = "Language<<" )
57+
58+
# test.Language.unary.call <- function(){
59+
expect_equal(
60+
runit_lang_unarycall( 1:10 ),
61+
lapply( 1:10, function(n) seq(from=n, to = 0 ) ),
62+
info = "c++ lapply using calls" )
63+
64+
# test.Language.unary.call.index <- function(){
65+
expect_equal(
66+
runit_lang_unarycallindex( 1:10 ),
67+
lapply( 1:10, function(n) seq(from=10, to = n ) ),
68+
info = "c++ lapply using calls" )
69+
70+
# test.Language.binary.call <- function(){
71+
expect_equal(
72+
runit_lang_binarycall( 1:10, 11:20 ),
73+
lapply( 1:10, function(n) seq(n, n+10) ),
74+
info = "c++ lapply using calls" )
75+
76+
# test.Language.fixed.call <- function(){
77+
set.seed(123)
78+
res <- runit_lang_fixedcall()
79+
set.seed(123)
80+
exp <- lapply( 1:10, function(n) rnorm(10) )
81+
expect_equal( res, exp, info = "std::generate" )
82+
83+
# test.Language.in.env <- function(){
84+
e <- new.env()
85+
e[["y"]] <- 1:10
86+
expect_equal( runit_lang_inenv(e), sum(1:10), info = "Language::eval( SEXP )" )
87+
88+
# test.Pairlist <- function(){
89+
expect_equal( runit_pairlist( pairlist("rnorm") ), pairlist("rnorm" ), info = "Pairlist( LISTSXP )" )
90+
expect_equal( runit_pairlist( call("rnorm") ), pairlist(as.name("rnorm")), info = "Pairlist( LANGSXP )" )
91+
expect_equal( runit_pairlist(1:10), as.pairlist(1:10) , info = "Pairlist( INTSXP) " )
92+
expect_equal( runit_pairlist(TRUE), as.pairlist( TRUE) , info = "Pairlist( LGLSXP )" )
93+
expect_equal( runit_pairlist(1.3), as.pairlist(1.3), info = "Pairlist( REALSXP) " )
94+
expect_equal( runit_pairlist(as.raw(1) ), as.pairlist(as.raw(1)), info = "Pairlist( RAWSXP)" )
95+
96+
expect_error( runit_pairlist(runit_pairlist), info = "Pairlist not compatible with function" )
97+
expect_error( runit_pairlist(new.env()), info = "Pairlist not compatible with environment" )
98+
99+
# test.Pairlist.variadic <- function(){
100+
expect_equal( runit_pl_variadic_1(), pairlist("rnorm", 10L, 0.0, 2.0 ),
101+
info = "variadic templates" )
102+
expect_equal( runit_pl_variadic_2(), pairlist("rnorm", 10L, mean = 0.0, 2.0 ),
103+
info = "variadic templates (with names)" )
104+
105+
# test.Pairlist.push.front <- function(){
106+
expect_equal( runit_pl_push_front(),
107+
pairlist( foobar = 10, "foo", 10.0, 1L),
108+
info = "Pairlist::push_front" )
109+
110+
# test.Pairlist.push.back <- function(){
111+
expect_equal( runit_pl_push_back(),
112+
pairlist( 1L, 10.0, "foo", foobar = 10),
113+
info = "Pairlist::push_back" )
114+
115+
# test.Pairlist.insert <- function(){
116+
expect_equal( runit_pl_insert(),
117+
pairlist( 30.0, 1L, bla = "bla", 10.0, 20.0, "foobar" ),
118+
info = "Pairlist::replace" )
119+
120+
# test.Pairlist.replace <- function(){
121+
expect_equal( runit_pl_replace(),
122+
pairlist( first = 1, 20.0 , FALSE), info = "Pairlist::replace" )
123+
124+
# test.Pairlist.size <- function(){
125+
expect_equal( runit_pl_size(), 3L, info = "Pairlist::size()" )
126+
127+
# test.Pairlist.remove <- function(){
128+
expect_equal( runit_pl_remove_1(), pairlist(10.0, 20.0), info = "Pairlist::remove(0)" )
129+
expect_equal( runit_pl_remove_2(), pairlist(1L, 10.0), info = "Pairlist::remove(0)" )
130+
expect_equal( runit_pl_remove_3(), pairlist(1L, 20.0), info = "Pairlist::remove(0)" )
131+
132+
# test.Pairlist.square <- function(){
133+
expect_equal( runit_pl_square_1(), 10.0, info = "Pairlist::operator[] used as rvalue" )
134+
expect_equal( runit_pl_square_2(), pairlist(1L, "foobar", 1L) , info = "Pairlist::operator[] used as lvalue" )
135+
136+
# test.Formula <- function(){
137+
expect_equal( runit_formula_(), x ~ y + z, info = "Formula( string )" )
138+
139+
# test.Formula.SEXP <- function(){
140+
expect_equal( runit_formula_SEXP( x ~ y + z), x ~ y + z, info = "Formula( SEXP = formula )" )
141+
expect_equal( runit_formula_SEXP( "x ~ y + z" ), x ~ y + z, info = "Formula( SEXP = STRSXP )" )
142+
expect_equal( runit_formula_SEXP( parse( text = "x ~ y + z") ), x ~ y + z, info = "Formula( SEXP = EXPRSXP )" )
143+
expect_equal( runit_formula_SEXP( list( "x ~ y + z") ), x ~ y + z, info = "Formula( SEXP = VECSXP(1 = STRSXP) )" )
144+
expect_equal( runit_formula_SEXP( list( x ~ y + z) ), x ~ y + z, info = "Formula( SEXP = VECSXP(1 = formula) )" )

‎inst/tinytest/test_listof.R‎

Lines changed: 77 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,77 @@
1+
2+
## Copyright (C) 2014 - 2019 Dirk Eddelbuettel, Romain Francois and Kevin Ushey
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+
19+
.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
20+
21+
if (!.runThisTest) exit_file("Skipping, set 'RunAllRcppTests=yes' to run.")
22+
23+
library(Rcpp)
24+
sourceCpp("cpp/ListOf.cpp")
25+
26+
x <- list( c(1, 5), c(2, 6), c(3, 7) )
27+
28+
# test.ListOf.identity <- function() {
29+
expect_identical(test_identity(setNames(x, c('a', 'b', 'c'))), setNames(x, c('a', 'b', 'c')))
30+
31+
# test.ListOf.lapply.sum <- function() {
32+
x <- list( c(1, 5), c(2, 6), c(3, 7) )
33+
expect_identical( test_lapply_sum(x), lapply(x, sum) )
34+
35+
# test.ListOf.sapply.sum <- function() {
36+
x <- list( c(1, 5), c(2, 6), c(3, 7) )
37+
expect_identical( test_sapply_sum(x), sapply(x, sum) )
38+
39+
# test.ListOf.assign <- function() {
40+
x <- list( c(1, 5), c(2, 6), c(3, 7) )
41+
test_assign(x, 100, "apple")
42+
expect_identical( x[[2]], 100 )
43+
44+
# test.ListOf.assign.names <- function() {
45+
x <- setNames(list(1, 2, 3), c('a', 'b', 'c'))
46+
test_assign_names(x)
47+
expect_identical( x[["a"]], x[["b"]] )
48+
49+
# test.ListOf.arith <- function() {
50+
expect_identical(test_add(list(1, 2, 3)), 6)
51+
expect_identical(test_add_subtract(list(1, 2, 3)), 0)
52+
expect_identical(test_mult( list(1, 2, 3) ), 6)
53+
expect_identical(test_char( list("banana") ), list("apple"))
54+
55+
# test.ListOf.assign.names <- function() {
56+
expect_error(test_assign_names(list(alpha=1, beta=2, gamma=3)))
57+
58+
# test.ListOf.sub.calls <- function() {
59+
expect_equal(test_sub_calls( list(1, 2, 3) ), 3)
60+
61+
# test.ListOf.nested <- function() {
62+
expect_equal(test_nested_listof( list(list(1)) ), 1)
63+
64+
# test.ListOf.convert.implicit <- function() {
65+
expect_equal(test_return_IVList(list(1, 2, 3)), list(1L, 2L, 3L))
66+
67+
# test.ListOf.convert.fail <- function() {
68+
expect_error(test_return_IVList(list("a", "b", "c")))
69+
70+
# test.ListOf.names <- function() {
71+
l <- list(a = 1L, b = 2L, c = 3L)
72+
expect_equal(listof_names(l), c("a", "b", "c"))
73+
74+
# test.ListOf.attr.foo <- function() {
75+
l <- list(a = 1L)
76+
attr(l, "foo") <- "bar"
77+
expect_equal(listof_attr_foo(l), "bar")

0 commit comments

Comments
 (0)