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
|
render_galley_ext <- function(input_path, pkg, installed, output_dir, output_file) {
# stopifnot(!installed)
if (installed) {
library(pkg, character.only = TRUE)
} else {
pkgload::load_all()
}
testthat::local_reproducible_output()
Sys.time <- function() {
structure(1627618285.45488, class = c("POSIXct", "POSIXt"), tzone = "UTC")
}
Sys.Date <- function() {
structure(18838, class = "Date")
}
set.seed(20210730)
Sys.setenv("IN_PKGDOWN" = "true", "IN_GALLEY" = "true")
rmarkdown::render(
input_path,
output_dir = output_dir,
output_file = output_file,
run_pandoc = FALSE,
output_format = rmarkdown::md_document(preserve_yaml = TRUE)
)
}
galley_use_installed <- function() {
grepl("[.]Rcheck$", basename(normalizePath("../..")))
}
render_galley <- function(name, md_name) {
pkg <- utils::packageName()
# FIXME: Hack!
installed <- galley_use_installed()
# stopifnot(!installed)
if (installed) {
input_path <- system.file("doc", name, package = pkg)
} else {
input_path <- system.file("vignettes", name, package = pkg)
}
# Need fixed file name for stability
output_dir <- tempdir()
output_file <- md_name
out_text <- character()
knit_path <- tryCatch(
callr::r(
render_galley_ext,
args = list(
input_path = input_path, pkg = pkg, installed = installed,
output_dir = output_dir, output_file = output_file
),
callback = function(x) {
out_text <<- c(out_text, x)
}
),
error = function(e) {
writeLines(c("", out_text, ""))
stop(e)
# rlang::abort(paste0("Error rendering ", name))
}
)
path <- file.path(output_dir, output_file)
full_knit_path <- file.path(dirname(input_path), knit_path)
scrub_file(path, full_knit_path)
unlink(full_knit_path)
path
}
scrub_tempdir <- function(x) {
stable_tmpdir <- "${TEMP}"
tmpdir_rx <- utils::glob2rx(paste0("*", dirname(tempdir()), "*"), trim.head = TRUE)
gsub(paste0("(/private)?", tmpdir_rx, "[/\\\\]+Rtmp[0-9a-zA-Z]+"), stable_tmpdir, x)
}
scrub <- function(x) {
x <- gsub("[<]bytecode: 0x.*[>]", "<bytecode: 0x1ee4c0de>", x)
x <- gsub("[<]environment: 0x.*[>]", "<environment: 0xdeadbeef>", x)
x <- scrub_tempdir(x)
paste0(x, "\n", collapse = "")
}
scrub_file <- function(path, in_path = path) {
text <- brio::read_lines(in_path)
brio::write_file(scrub(text), path)
}
test_galley <- function(name, variant = NULL) {
testthat::skip_on_cran()
testthat::skip_if("covr" %in% loadedNamespaces())
rmd_name <- paste0(name, ".Rmd")
md_name <- paste0(name, ".md")
path <- render_galley(rmd_name, md_name)
if (!is.null(variant)) {
testthat::skip_if_not_installed("testthat", "3.1.1")
testthat::expect_snapshot_file(
path,
name = md_name, compare = testthat::compare_file_text,
variant = variant
)
} else {
testthat::expect_snapshot_file(
path,
name = md_name, compare = testthat::compare_file_text
)
}
# FIXME: Test generated files
}
|
