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
|
rule_class <- function(x) {
structure(x, class = c("rule", "character"))
}
capture_messages <- function(expr) {
msgs <- character()
i <- 0
suppressMessages(withCallingHandlers(
expr,
message = function(e) msgs[[i <<- i + 1]] <<- conditionMessage(e)))
paste0(msgs, collapse = "")
}
capt <- function(expr, print_it = TRUE) {
pr <- if (print_it) print else identity
paste(capture.output(pr(expr)), collapse = "\n")
}
capt00 <- function(expr) {
capt(expr, print_it = FALSE)
}
capt0 <- function(expr) {
capture_messages(expr)
}
capt_cat <- function(expr) {
paste(capture.output(cat(expr)), collapse = "\n")
}
## This function always needs to return the same as the actual correct output
## on the current platform, with the current settings.
## There are four cases:
## 1. Platform is UTF-8 and cli.unicode = TRUE
## There is nothing we need to do
## 2. Platform is UTF-8 and cli.unicode = FALSE
## Need to convert to non-unicode alternative characters
## 3. Platform is not UTF-8 and cli.unicode = TRUE
## Need to use enc2native to convert to platform replacement characters
## 4. Platform is not UTF-8 and cli.unicode = FALSE
## Need to convert to non-unicode alternative characters
rebox <- function(..., mode = c("box", "tree")) {
mode <- match.arg(mode)
bx <- as.character(c(...))
## Older versions of testthat do not set the encoding on the
## parsed files, so we set it manually here
Encoding(bx) <- "UTF-8"
bx <- paste(bx, collapse = "\n")
utf8 <- l10n_info()$`UTF-8`
on <- is_utf8_output()
if (utf8 && on) {
bx
} else if (utf8 && !on) {
fallback(bx, mode)
} else if (!utf8 && on) {
enc2native(bx)
} else {
fallback(bx, mode)
}
}
fallback <- function(bx, mode) {
if (mode == "box") {
## single
bx <- chartr(
c("\u250c", "\u2510", "\u2518", "\u2514", "\u2502", "\u2500"),
c("+", "+", "+", "+", "|", "-"), bx)
## double
bx <- chartr(
c("\u2554", "\u2557", "\u255d", "\u255a", "\u2551", "\u2550"),
c("+", "+", "+", "+", "|", "-"), bx)
## round
bx <- chartr(
c("\u256d", "\u256e", "\u256f", "\u2570", "\u2502", "\u2500"),
c("+", "+", "+", "+", "|", "-"), bx)
## single-double
bx <- chartr(
c("\u2553", "\u2556", "\u255c", "\u2559", "\u2551", "\u2500"),
c("+", "+", "+", "+", "|", "-"), bx)
## double-single
bx <- chartr(
c("\u2552", "\u2555", "\u255b", "\u2558", "\u2502", "\u2550"),
c("+", "+", "+", "+", "|", "-"), bx)
## Bullets
bx <- chartr("\u25CF", "*", bx)
} else if (mode == "tree") {
bx <- chartr(
c("\u2500", "\u2502", "\u2514", "\u251c"),
c("-", "|", "\\", "+"), bx)
}
bx
}
chartr <- function(old, new, x) {
assertthat::assert_that(
is.character(old),
is.character(new),
is.character(x),
length(old) == length(new)
)
for (i in seq_along(old)) {
x <- gsub(old[i], new[i], x, fixed = TRUE)
}
x
}
|
