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
|
#' Test package examples
#'
#' These helper functions make it easier to test the examples in a package.
#' Each example counts as one test, and it succeeds if the code runs without
#' an error. Generally, this is redundant with R CMD check, and is not
#' recommended in routine practice.
#'
#' @keywords internal
#' @param path For `test_examples()`, path to directory containing Rd files.
#' For `test_example()`, path to a single Rd file. Remember the working
#' directory for tests is `tests/testthat`.
#' @param title Test title to use
#' @param rd A parsed Rd object, obtained from [tools::Rd_db()] or otherwise.
#' @export
test_examples <- function(path = "../..") {
res <- test_examples_source(path) %||% test_examples_installed()
if (is.null(res)) {
stop("Could not find examples", call. = FALSE)
}
invisible(res)
}
test_examples_source <- function(path = "../..") {
if (!dir.exists(file.path(path, "man"))) {
return()
}
Rd <- tools::Rd_db(dir = path)
if (length(Rd) == 0) {
return()
}
lapply(Rd, test_rd)
}
test_examples_installed <- function(package = testing_package()) {
if (identical(package, "") || is.null(package)) {
return()
}
Rd <- tools::Rd_db(package = package)
if (length(Rd) == 0) {
return()
}
lapply(Rd, test_rd)
}
#' @export
#' @rdname test_examples
test_rd <- function(rd, title = attr(rd, "Rdfile")) {
test_example(rd, title)
}
#' @export
#' @rdname test_examples
test_example <- function(path, title = path) {
ex_path <- withr::local_tempfile(pattern = "test_example-", fileext = ".R")
tools::Rd2ex(path, ex_path)
if (!file.exists(ex_path)) {
return(invisible(FALSE))
}
env <- new.env(parent = globalenv())
ok <- test_code(
test = title,
code = parse(ex_path, encoding = "UTF-8"),
env = env,
reporter = get_reporter() %||% StopReporter$new(),
skip_on_empty = FALSE
)
if (ok) succeed(path)
invisible(ok)
}
|
