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
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
|
# To allow the Java-style class name format that Jenkins prefers,
# "package_name_or_domain.ClassName", allow "."s in the class name.
classnameOK <- function(text) {
gsub("[^._A-Za-z0-9]+", "_", text)
}
#' Test reporter: summary of errors in jUnit XML format.
#'
#' This reporter includes detailed results about each test and summaries,
#' written to a file (or stdout) in jUnit XML format. This can be read by
#' the Jenkins Continuous Integration System to report on a dashboard etc.
#' Requires the _xml2_ package.
#'
#' To fit into the jUnit structure, context() becomes the `<testsuite>`
#' name as well as the base of the `<testcase> classname`. The
#' test_that() name becomes the rest of the `<testcase> classname`.
#' The deparsed expect_that() call becomes the `<testcase>` name.
#' On failure, the message goes into the `<failure>` node message
#' argument (first line only) and into its text content (full message).
#'
#' Execution time and some other details are also recorded.
#'
#' References for the jUnit XML format:
#' \url{http://llg.cubic.org/docs/junit/}
#'
#' @export
#' @family reporters
JunitReporter <- R6::R6Class("JunitReporter",
inherit = Reporter,
public = list(
results = NULL,
timer = NULL,
doc = NULL,
errors = NULL,
failures = NULL,
skipped = NULL,
tests = NULL,
root = NULL,
suite = NULL,
suite_time = NULL,
file_name = NULL,
elapsed_time = function() {
time <- (private$proctime() - self$timer)[["elapsed"]]
self$timer <- private$proctime()
time
},
reset_suite = function() {
self$errors <- 0
self$failures <- 0
self$skipped <- 0
self$tests <- 0
self$suite_time <- 0
},
start_reporter = function() {
check_installed("xml2", "to use JunitReporter")
self$timer <- private$proctime()
self$doc <- xml2::xml_new_document()
self$root <- xml2::xml_add_child(self$doc, "testsuites")
self$reset_suite()
},
start_file = function(file) {
self$file_name <- file
},
start_test = function(context, test) {
if (is.null(context)) {
context_start_file(self$file_name)
}
},
start_context = function(context) {
self$suite <- xml2::xml_add_child(
self$root,
"testsuite",
name = context,
timestamp = private$timestamp(),
hostname = private$hostname()
)
},
end_context = function(context) {
# Always uses . as decimal place in output regardless of options set in test
withr::local_options(list(OutDec = "."))
xml2::xml_attr(self$suite, "tests") <- as.character(self$tests)
xml2::xml_attr(self$suite, "skipped") <- as.character(self$skipped)
xml2::xml_attr(self$suite, "failures") <- as.character(self$failures)
xml2::xml_attr(self$suite, "errors") <- as.character(self$errors)
#jenkins junit plugin requires time has at most 3 digits
xml2::xml_attr(self$suite, "time") <- as.character(round(self$suite_time, 3))
self$reset_suite()
},
add_result = function(context, test, result) {
withr::local_options(list(OutDec = "."))
self$tests <- self$tests + 1
time <- self$elapsed_time()
self$suite_time <- self$suite_time + time
# XML node for test case
name <- test %||% "(unnamed)"
testcase <- xml2::xml_add_child(
self$suite, "testcase",
time = toString(time),
classname = classnameOK(context),
name = classnameOK(name)
)
first_line <- function(x) {
loc <- expectation_location(x, " (", ")")
paste0(strsplit(x$message, split = "\n")[[1]][1], loc)
}
# add an extra XML child node if not a success
if (expectation_error(result)) {
# "type" in Java is the exception class
error <- xml2::xml_add_child(testcase, "error", type = "error", message = first_line(result))
xml2::xml_text(error) <- cli::ansi_strip(format(result))
self$errors <- self$errors + 1
} else if (expectation_failure(result)) {
# "type" in Java is the type of assertion that failed
failure <- xml2::xml_add_child(testcase, "failure", type = "failure", message = first_line(result))
xml2::xml_text(failure) <- cli::ansi_strip(format(result))
self$failures <- self$failures + 1
} else if (expectation_skip(result)) {
xml2::xml_add_child(testcase, "skipped", message = first_line(result))
self$skipped <- self$skipped + 1
}
},
end_reporter = function() {
if (is.character(self$out)) {
xml2::write_xml(self$doc, self$out, format = TRUE)
} else if (inherits(self$out, "connection")) {
file <- withr::local_tempfile()
xml2::write_xml(self$doc, file, format = TRUE)
cat(brio::read_file(file), file = self$out)
} else {
stop("unsupported output type: ", toString(self$out))
}
} # end_reporter
), # public
private = list(
proctime = function() {
proc.time()
},
timestamp = function() {
strftime(Sys.time(), "%Y-%m-%dT%H:%M:%SZ", tz = "UTC")
},
hostname = function() {
Sys.info()[["nodename"]]
}
) # private
)
# Fix components of JunitReporter that otherwise vary from run-to-run
#
# The following functions need to be mocked out to run a unit test
# against static contents of reporters/junit.txt:
# - proctime - originally wrapper for proc.time()
# - timestamp - originally wrapper for toString(Sys.time())
# - hostname - originally wrapper for Sys.info()[["nodename"]]
#
JunitReporterMock <- R6::R6Class("JunitReporterMock",
inherit = JunitReporter,
public = list(),
private = list(
proctime = function() {
c(user = 0, system = 0, elapsed = 0)
},
timestamp = function() {
"1999:12:31 23:59:59"
},
hostname = function() {
"nodename"
}
)
)
|
