Skip to content

Commit dc2839a

Browse files
eddelbuetteleddelbuettel
committed
Merge pull request #85 from kevinushey/Rcpp.package.skeleton
Add unit tests for Rcpp.package.skeleton Thank you -- but don't forget to put your name in the header when you are the one writing it!
2 parents 73229ed + f5a2c6d commit dc2839a

File tree

2 files changed

+161
-4
lines changed

2 files changed

+161
-4
lines changed

‎ChangeLog‎

Lines changed: 10 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -1,3 +1,9 @@
1+
2013-12-01 Kevin Ushey <kevinushey@gmail.com>
2+
3+
* R/Rcpp.package.skeleton.R: Fixed bug relating to user-supplied
4+
functions in 'list' argument
5+
* inst/unitTests/runit.Rcpp.package.skeleton.R: Added unit tests
6+
17
2013-11-30 Dirk Eddelbuettel <edd@debian.org>
28

39
* vignettes/Rcpp-FAQ.Rnw: Updated and corrected in several spots
@@ -1416,14 +1422,14 @@
14161422
* src/Language.cpp: Language gains a fast_eval method, without the whole try/catch
14171423
* src/barrier.cpp: function char_nocheck to avoid the check in using CHAR
14181424
* include/Rcpp/sugar/functions/unique.h: sugar unique and sort_unique
1419-
using unordered_set (perhaps we could use it from c++11).
1425+
using unordered_set (perhaps we could use it from c++11).
14201426

14211427
2012-11-06 JJ Allaire <jj@rstudio.org>
14221428

14231429
* R/Attributes.R: tweak whitespace in verbose mode
14241430
* src/AttributesParser.h: support for interfaces attribute
14251431
* src/AttributesParser.cpp: support for interfaces attribute
1426-
* src/Attributes.cpp: support for interfaces attribute; refactor
1432+
* src/Attributes.cpp: support for interfaces attribute; refactor
14271433
code generators; use single module for exports; return list of
14281434
updated files from compileAttributes
14291435
* src/Module.cpp: add package parameter to GetCppCallable
@@ -1432,7 +1438,7 @@
14321438

14331439
2012-11-05 Romain Francois <romain@r-enthusiasts.com>
14341440

1435-
* include/Rcpp/Module.h: added class CppInheritedProperty to handle
1441+
* include/Rcpp/Module.h: added class CppInheritedProperty to handle
14361442
inherited properties
14371443
* include/Rcpp/module/class.h: implemented inheritance of properties
14381444

@@ -4382,7 +4388,7 @@
43824388
2010-02-01 Romain Francois <francoisromain@free.fr>
43834389

43844390
* src/traits/wrap_type_traits.h: new namespace Rcpp::traits::
4385-
to host Rcpp type traits used by the template meta programming
4391+
to host Rcpp type traits used by the template meta programming
43864392
dispatching of wrap
43874393

43884394
2010-01-31 Dirk Eddelbuettel <edd@debian.org>

‎inst/unitTests/runit.Rcpp.package.skeleton.R‎

Lines changed: 151 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,151 @@
1+
# Copyright (C) 2013 Dirk Eddelbuettel and Romain Francois
2+
#
3+
# This file is part of Rcpp.
4+
#
5+
# Rcpp is free software: you can redistribute it and/or modify it
6+
# under the terms of the GNU General Public License as published by
7+
# the Free Software Foundation, either version 2 of the License, or
8+
# (at your option) any later version.
9+
#
10+
# Rcpp is distributed in the hope that it will be useful, but
11+
# WITHOUT ANY WARRANTY; without even the implied warranty of
12+
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13+
# GNU General Public License for more details.
14+
#
15+
# You should have received a copy of the GNU General Public License
16+
# along with Rcpp. If not, see <http://www.gnu.org/licenses/>.
17+
18+
.runThisTest <- Sys.getenv("RunAllRcppTests") == "yes"
19+
20+
if (.runThisTest) {
21+
22+
test.Rcpp.package.skeleton <- function(){
23+
24+
tempdir <- tempdir()
25+
path <- tempdir
26+
pkg_path <- file.path(path, "foo")
27+
R_path <- file.path(pkg_path, "R")
28+
src_path <- file.path(pkg_path, "src")
29+
env <- new.env()
30+
31+
env$funA <- function(alpha, beta) "gamma"
32+
env$funB <- function(first, ..., last) "foo"
33+
34+
Rcpp.package.skeleton("foo", path=path, list=c("funA", "funB"),
35+
author="Boo-Boo Bear",
36+
maintainer="Yogi Bear",
37+
license="An Opensource License",
38+
email="yogibear@yogimail.com",
39+
environment=env
40+
)
41+
42+
on.exit(unlink(pkg_path, recursive=TRUE))
43+
44+
checkTrue( "foo" %in% list.files(path), "pkg path generated as named" )
45+
46+
## check the DESCRIPTION
47+
DESCRIPTION <- as.list( read.dcf( file.path(pkg_path, "DESCRIPTION") )[1,] )
48+
checkTrue( DESCRIPTION["Author"] == "Boo-Boo Bear",
49+
"wrote the Author field in DESCRIPTION" )
50+
checkTrue( DESCRIPTION["Maintainer"] == "Yogi Bear <yogibear@yogimail.com>",
51+
"wrote the Maintainer field in DESCRIPTION")
52+
checkTrue( DESCRIPTION["License"] == "An Opensource License",
53+
"wrote the License field in DESCRIPTION" )
54+
checkTrue( DESCRIPTION["LinkingTo"] == "Rcpp",
55+
"we make sure that we 'link' to Rcpp (use its headers)" )
56+
57+
## make sure we have useDynLib in the namespace
58+
NAMESPACE <- readLines( file.path(pkg_path, "NAMESPACE") )
59+
60+
## note: we use regular expressions anticipating a possible future
61+
## usage of e.g. '.registration=TRUE' in Rcpp.package.skeleton
62+
checkTrue( any(grepl( "useDynLib(foo", NAMESPACE, fixed=TRUE )),
63+
"NAMESPACE has useDynLib(foo)" )
64+
65+
R_files <- list.files(R_path, full.names=TRUE)
66+
checkTrue( all( c("funA.R", "funB.R") %in% list.files(R_path)),
67+
"created R files from functions" )
68+
for (file in grep("RcppExports.R", R_files, invert=TRUE, value=TRUE)) {
69+
code <- readLines(file)
70+
fn <- eval(parse(text=paste(code, collapse="\n")))
71+
fn_name <- gsub(".*/(.*)\\.R$", "\\1", file)
72+
checkIdentical(fn, get(fn_name),
73+
sprintf("we parsed the function '%s' correctly", fn_name)
74+
)
75+
}
76+
77+
## make sure we can build the package as generated
78+
## note: the generated .Rd placeholders are insufficient to be able
79+
## to successfully install the pkg; e.g. I see
80+
81+
## Error in Rd_info(db[[i]]) :
82+
## missing/empty \title field in '<path>/funA.Rd'
83+
invisible(sapply( list.files( file.path(pkg_path, "man"), full.names=TRUE), unlink ))
84+
85+
owd <- getwd()
86+
setwd(path)
87+
on.exit( setwd(owd), add=TRUE )
88+
R <- shQuote( file.path( R.home( component = "bin" ), "R" ))
89+
system( paste(R, "CMD build", pkg_path) )
90+
checkTrue( file.exists("foo_1.0.tar.gz"), "can successfully R CMD build the pkg")
91+
dir.create("templib")
92+
install.packages("foo_1.0.tar.gz", file.path(path, "templib"), repos=NULL, type="source")
93+
on.exit( unlink( file.path(path, "foo_1.0.tar.gz") ), add=TRUE)
94+
require("foo", file.path(path, "templib"), character.only=TRUE)
95+
on.exit( unlink( file.path(path, "templib"), recursive=TRUE), add=TRUE )
96+
97+
}
98+
99+
test.Rcpp.package.skeleton.Attributes <- function(){
100+
101+
tempdir <- tempdir()
102+
path <- tempdir
103+
pkg_path <- file.path(path, "foo")
104+
R_path <- file.path(pkg_path, "R")
105+
src_path <- file.path(pkg_path, "src")
106+
107+
Rcpp.package.skeleton("foo", path=path, attributes=TRUE, example_code=TRUE,
108+
environment=environment())
109+
on.exit( unlink(pkg_path, recursive=TRUE) )
110+
checkTrue( file.exists( file.path(src_path, "RcppExports.cpp") ),
111+
"RcppExports.cpp was created")
112+
checkTrue( file.exists( file.path(src_path, "rcpp_hello_world.cpp") ),
113+
"rcpp_hello_world.cpp was created" )
114+
checkTrue( file.exists( file.path(R_path, "RcppExports.R") ),
115+
"RcppExports.R was created")
116+
}
117+
118+
test.Rcpp.package.skeleton.NoAttributes <- function(){
119+
120+
tempdir <- tempdir()
121+
path <- tempdir
122+
pkg_path <- file.path(path, "foo")
123+
R_path <- file.path(pkg_path, "R")
124+
src_path <- file.path(pkg_path, "src")
125+
126+
Rcpp.package.skeleton("foo", path=path, attributes=FALSE, example_code=TRUE,
127+
environment=environment())
128+
on.exit( unlink(pkg_path, recursive=TRUE) )
129+
checkTrue( file.exists( file.path(src_path, "rcpp_hello_world.cpp") ),
130+
"rcpp_hello_world.cpp was created")
131+
checkTrue( file.exists( file.path(src_path, "rcpp_hello_world.h") ),
132+
"rcpp_hello_world.h was created")
133+
checkTrue( file.exists( file.path(R_path, "rcpp_hello_world.R") ),
134+
"rcpp_hello_world.R was created" )
135+
}
136+
137+
test.Rcpp.package.skeleton.Module <- function(){
138+
139+
tempdir <- tempdir()
140+
path <- tempdir
141+
pkg_path <- file.path(path, "foo")
142+
R_path <- file.path(pkg_path, "R")
143+
src_path <- file.path(pkg_path, "src")
144+
145+
Rcpp.package.skeleton("foo", path=path, module=TRUE, environment=environment())
146+
on.exit( unlink(pkg_path, recursive=TRUE) )
147+
checkTrue( file.exists( file.path(src_path, "rcpp_module.cpp") ),
148+
"rcpp_module.cpp was created" )
149+
}
150+
151+
}

0 commit comments

Comments
 (0)