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
|
#' Manage test reporting
#'
#' The job of a reporter is to aggregate the results from files, tests, and
#' expectations and display them in an informative way. Every testthat function
#' that runs multiple tests provides a `reporter` argument which you can
#' use to override the default (which is selected by [default_reporter()]).
#'
#' You only need to use this `Reporter` object directly if you are creating
#' a new reporter. Currently, creating new Reporters is undocumented,
#' so if you want to create your own, you'll need to make sure that you're
#' familiar with [R6](https://adv-r.hadley.nz/R6.html) and then need read the
#' source code for a few.
#'
#' @keywords internal
#' @export
#' @export Reporter
#' @aliases Reporter
#' @importFrom R6 R6Class
#' @family reporters
#' @examples
#' path <- testthat_example("success")
#'
#' test_file(path)
#' # Override the default by supplying the name of a reporter
#' test_file(path, reporter = "minimal")
Reporter <- R6::R6Class("Reporter",
public = list(
capabilities = list(parallel_support = FALSE, parallel_updates = FALSE),
start_reporter = function() {},
start_context = function(context) {},
start_test = function(context, test) {},
start_file = function(filename) {},
add_result = function(context, test, result) {},
end_test = function(context, test) {},
end_context = function(context) {},
end_reporter = function() {},
end_file = function() {},
is_full = function() FALSE,
update = function() {},
width = 80,
unicode = TRUE,
crayon = TRUE,
rstudio = TRUE,
hyperlinks = TRUE,
out = NULL,
initialize = function(file = getOption("testthat.output_file", stdout())) {
if (is.character(file)) {
file <- normalizePath(file, mustWork = FALSE)
}
self$out <- file
if (is.character(self$out) && file.exists(self$out)) {
# If writing to a file, overwrite it if it exists
file.remove(self$out)
}
# Capture at init so not affected by test settings
self$width <- cli::console_width()
self$unicode <- cli::is_utf8_output()
self$crayon <- cli::num_ansi_colors() > 1
self$rstudio <- Sys.getenv("RSTUDIO") == "1"
self$hyperlinks <- cli::ansi_hyperlink_types()[["run"]]
},
# To be used when the reporter needs to produce output inside of an active
# test, which is almost always from $add_result()
local_user_output = function(.env = parent.frame()) {
local_reproducible_output(
width = self$width,
crayon = self$crayon,
rstudio = self$rstudio,
hyperlinks = self$hyperlinks,
.env = .env
)
# Can't set unicode with local_reproducible_output() because it can
# generate a skip if you're temporarily using a non-UTF-8 locale
withr::local_options(cli.unicode = self$unicode, .local_envir = .env)
},
cat_tight = function(...) {
cat(..., sep = "", file = self$out, append = TRUE)
},
cat_line = function(...) {
cli::cat_line(..., file = self$out)
},
rule = function(...) {
cli::cat_rule(..., file = self$out)
},
# The hierarchy of contexts are implied - a context starts with a
# call to context(), and ends either with the end of the file, or
# with the next call to context() in the same file. These private
# methods paper over the details so that context appear to work
# in the same way as tests and expectations.
.context = NULL,
.start_context = function(context) {
if (!is.null(self$.context)) {
self$end_context(self$.context)
}
self$.context <- context
self$start_context(context)
invisible()
},
end_context_if_started = function(context) {
if (!is.null(self$.context)) {
self$end_context(self$.context)
self$.context <- NULL
}
invisible()
}
)
)
#' Retrieve the default reporter
#'
#' The defaults are:
#' * [ProgressReporter] for interactive, non-parallel; override with
#' `testthat.default_reporter`
#' * [ParallelProgressReporter] for interactive, parallel packages;
#' override with `testthat.default_parallel_reporter`
#' * [CompactProgressReporter] for single-file interactive; override with
#' `testthat.default_compact_reporter`
#' * [CheckReporter] for R CMD check; override with `testthat.default_check_reporter`
#'
#' @export
#' @keywords internal
default_reporter <- function() {
getOption("testthat.default_reporter", "Progress")
}
#' @export
#' @rdname default_reporter
default_parallel_reporter <- function() {
getOption("testthat.default_parallel_reporter", "ParallelProgress")
}
#' @export
#' @rdname default_reporter
default_compact_reporter <- function() {
getOption("testthat.default_compact_reporter", "CompactProgress")
}
#' @export
#' @rdname default_reporter
check_reporter <- function() {
getOption("testthat.default_check_reporter", "Check")
}
|
