1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
|
#' Add tinytest to package source directory
#'
#' Creates \code{inst/tinytest}, and an example test file in that
#' directory. Creates \code{tests/tinytest.R} so the package is
#' tested with \code{R CMD check}. Adds \code{tinytests} as a suggested
#' package to the \code{DESCRIPTION}.
#'
#' @param pkgdir \code{[character]} Package source directory
#' @param force \code{[logical]} Toggle overwrite existing files? (not folders)
#' @param verbose \code{[logical]} Toggle print progress
#'
#' @section Note on \code{DESCRIPTION}:
#'
#' Fails when it does not exist. It is assumed that the
#' package is named in the \code{DESCRIPTION}.
#'
#'
#' @examples
#' \dontrun{
#' # an easy way to set up a package 'haha' that passes
#' # R CMD check
#' pkgKitten::kitten("haha")
#' tinytest::setup_tinytest("haha")
#'}
#'
#' @return \code{NULL}, invisibly.
#'
#' @export
setup_tinytest <- function(pkgdir, force=FALSE, verbose=TRUE){
# local, verbosity-aware catf
catf <- function(fmt, ...) if (verbose) cat(sprintf(fmt,...))
if (!dir.exists(pkgdir)){
stopf("%s does not exist or is not a directory", pkgdir)
}
# fields in DESCRIPTION that escape reformatting
kw <- c("Title"
, "Maintainer"
, "Authors", "Authors@R"
, "Description"
, "Depends"
, "Imports"
, "Suggests"
, "Enhances")
## Get pkg name form DESCRIPTION
dfile <- file.path(pkgdir,"DESCRIPTION")
if (file.exists(dfile)){
dcf <- read.dcf(dfile, keep.white=kw)
pkgname <- dcf[, "Package"]
} else {
stopf("No DESCRIPTION file in %s",pkgdir)
}
## Create pkgdir/tests
testdir <- file.path(pkgdir,'tests')
if ( !dir.exists(testdir) ){
catf("Creating %s\n", testdir)
dir.create(testdir)
}
## Write pkgdir/tests/tinytest.R
testfile <- file.path(testdir,"tinytest.R")
test_statement <- sprintf('
if ( requireNamespace("tinytest", quietly=TRUE) ){
tinytest::test_package("%s")
}
', pkgname)
if ( !file.exists(testfile) || force ){
catf("Creating %s\n", testfile )
write(test_statement, file = testfile)
}
## Create inst/tinytest
# (dir.create with recursive=TRUE does not always work
# on the OS that we shall not name)
instdir <- file.path(pkgdir, "inst")
if (!dir.exists(instdir)){
catf("Creating %s\n", instdir)
dir.create(instdir)
}
ttdir <- file.path(instdir,"tinytest")
if (!dir.exists(ttdir)){
catf("Creating %s\n",ttdir)
dir.create(ttdir)
}
## Write example test file
example_test <- '
# Placeholder with simple test
expect_equal(1 + 1, 2)
'
ttfile <- file.path(ttdir, sprintf("test_%s.R",pkgname))
if ( !file.exists(ttfile) || force ){
catf("Creating %s\n", ttfile)
write(example_test, file=ttfile)
}
## Add tinytest to DESCRIPTION file
suggests <- if ("Suggests" %in% colnames(dcf)) dcf[1,"Suggests"] else NA
if (!is.na(suggests) && !grepl("tinytest",suggests)){
catf("Adding 'tinytest' to DESCRIPTION/Suggests\n")
dcf[1,"Suggests"] <- sprintf("%s, tinytest",suggests)
write.dcf(dcf, dfile, keep.white=kw)
} else if ( is.na(suggests) ) {
catf("Adding 'Suggests: tinytest' to DESCRIPTION\n")
dcf <- cbind(dcf, Suggests = "tinytest")
write.dcf(dcf, dfile, keep.white=kw)
}
# If another test package is already present, perhaps the user
# wants to take it out.
other_test_package <- c("RUnit","testthat","unity","testit")
suggested <- trimws(strsplit(dcf[1,"Suggests"], ",")[[1]])
if (any(other_test_package %in% suggested)){
pkgs <- paste(other_test_package[other_test_package %in% suggested], collapse=", ")
catf("You may want to remove the following packages from DESCRIPTION/Suggests: %s\n", pkgs)
}
invisible(NULL)
}
#' The puppy for a pkgKitten
#'
#' Does exactly the same as \code{\link{setup_tinytest}}, but prints
#' a loving message aferwards (and who doesn't want that!?). Just
#' think about those puppies.
#'
#' @inheritParams setup_tinytest
#'
#'
#' @keywords internal
#' @export
puppy <- function(pkgdir, force=FALSE, verbose=TRUE){
setup_tinytest(pkgdir=pkgdir, force=force, verbose=verbose)
catf("\nThank you %s, for showing us some PUPPY LOVE <3\n",Sys.info()["user"])
catf(doggy)
}
doggy <- "
,-.___,-.
\\_/_ _\\_/
)O_O(
{ (_) } W00F!
`-^-'
"
|
