Skip to content

Commit dd772a0

Browse files
DavisVaughanDavisVaughan
authored
Rework run_cpp_tests() to avoid testthat internals (#2315)
* Bump `the$test_expectations` * Move towards less manual bookkeeping * Fix `with_description_push()` thinko * Use `test_code()` to avoid more internals! This also gets the `test_description()` correct so we don't report "code run outside of test_that" * Recognize that `with_description_push()` + `test_code()` is exactly `test_that()`! * Recognize that we can now use `fail()` Since we are now inside a `test_that()`, which has its own local `test_code()`, where each of those has its own `tryCatch()` * You really do need `<<-` here! * Use `conditionMessage()` just in case * Justify usage of `expectation()` * NEWS bullet * Refactor into a series of parsers * Remove unused variable
1 parent 67c09c7 commit dd772a0

File tree

2 files changed

+104
-95
lines changed

2 files changed

+104
-95
lines changed

‎NEWS.md‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# testthat (development version)
22

3+
* `run_cpp_tests()` no longer accidentally reports that a test has been skipped (#2315).
4+
35
# testthat 3.3.2
46

57
* testthat now emits OpenTelemetry traces for tests when tracing is enabled. Requires the otel and otelsdk packages (#2282).

‎R/test-compiled-code.R‎

Lines changed: 102 additions & 95 deletions
Original file line numberDiff line numberDiff line change
@@ -49,124 +49,131 @@ run_cpp_tests <- function(package) {
4949
run_testthat_tests <- get_routine(package, "run_testthat_tests")
5050

5151
output <- ""
52-
tests_passed <- TRUE
52+
catch_error <- NULL
5353

54-
catch_error <- FALSE
5554
tryCatch(
5655
{
5756
output <- capture_output_lines(
58-
tests_passed <- .Call(run_testthat_tests, TRUE)
57+
.Call(run_testthat_tests, TRUE)
5958
)
6059
},
6160
error = function(e) {
62-
catch_error <- TRUE
63-
reporter <- get_reporter()
64-
65-
context_start("Catch")
66-
reporter$start_test(context = "Catch", test = "Catch")
67-
reporter$add_result(
68-
context = "Catch",
69-
test = "Catch",
70-
result = new_expectation("failure", e$message)
71-
)
72-
reporter$end_test(context = "Catch", test = "Catch")
61+
catch_error <<- e
7362
}
7463
)
7564

76-
if (catch_error) {
65+
if (!is.null(catch_error)) {
66+
context_start("Catch")
67+
test_that("Catch", {
68+
fail(conditionMessage(catch_error))
69+
})
7770
return()
7871
}
7972

80-
report <- xml2::read_xml(paste(output, collapse = "\n"))
81-
82-
contexts <- xml2::xml_find_all(report, "//TestCase")
73+
output <- paste(output, collapse = "\n")
74+
contexts <- parse_catch_contexts(output)
8375

8476
for (context in contexts) {
85-
context_name <- sub(" [|][^|]+$", "", xml2::xml_attr(context, "name"))
77+
context_start(context$name)
78+
79+
for (test in context$tests) {
80+
test_that(test$name, {
81+
for (i in seq_len(test$n_successes)) {
82+
pass()
83+
}
84+
for (failure in test$failures) {
85+
fail(message = failure$message, srcref = failure$srcref)
86+
}
87+
for (exception in test$exceptions) {
88+
# There is no `fail()` equivalent for an error.
89+
# We could use `stop()`, but we want to pass through a `srcref`.
90+
expectation(
91+
type = "error",
92+
message = exception$message,
93+
srcref = exception$srcref
94+
)
95+
}
96+
})
97+
}
98+
}
99+
}
86100

87-
context_start(context_name)
101+
parse_catch_contexts <- function(text) {
102+
xml <- xml2::read_xml(text)
88103

89-
tests <- xml2::xml_find_all(context, "./Section")
90-
for (test in tests) {
91-
test_name <- xml2::xml_attr(test, "name")
104+
contexts <- xml2::xml_find_all(xml, "//TestCase")
105+
contexts <- map(contexts, parse_catch_context)
92106

93-
result <- xml2::xml_find_first(test, "./OverallResults")
94-
successes <- as.integer(xml2::xml_attr(result, "successes"))
107+
contexts
108+
}
95109

96-
get_reporter()$start_test(context = context_name, test = test_name)
110+
parse_catch_context <- function(context) {
111+
name <- sub(" [|][^|]+$", "", xml2::xml_attr(context, "name"))
112+
tests <- xml2::xml_find_all(context, "./Section")
113+
tests <- map(tests, parse_catch_test)
114+
list(name = name, tests = tests)
115+
}
97116

98-
for (i in seq_len(successes)) {
99-
exp <- new_expectation("success", "")
100-
exp$test <- test_name
101-
get_reporter()$add_result(
102-
context = context_name,
103-
test = test_name,
104-
result = exp
105-
)
106-
}
117+
parse_catch_test <- function(test) {
118+
name <- xml2::xml_attr(test, "name")
107119

108-
failures <- xml2::xml_find_all(test, "./Expression")
109-
for (failure in failures) {
110-
org <- xml2::xml_find_first(failure, "Original")
111-
org_text <- xml2::xml_text(org, trim = TRUE)
112-
113-
filename <- xml2::xml_attr(failure, "filename")
114-
type <- xml2::xml_attr(failure, "type")
115-
116-
type_msg <- switch(
117-
type,
118-
"CATCH_CHECK_FALSE" = "isn't false.",
119-
"CATCH_CHECK_THROWS" = "did not throw an exception.",
120-
"CATCH_CHECK_THROWS_AS" = "threw an exception with unexpected type.",
121-
"isn't true."
122-
)
123-
124-
org_text <- paste(org_text, type_msg)
125-
126-
line <- xml2::xml_attr(failure, "line")
127-
failure_srcref <- srcref(
128-
srcfile(file.path("src", filename)),
129-
c(line, line, 1, 1)
130-
)
131-
132-
exp <- new_expectation("failure", org_text, srcref = failure_srcref)
133-
exp$test <- test_name
134-
135-
get_reporter()$add_result(
136-
context = context_name,
137-
test = test_name,
138-
result = exp
139-
)
140-
}
120+
overall_results <- xml2::xml_find_first(test, "./OverallResults")
121+
n_successes <- as.integer(xml2::xml_attr(overall_results, "successes"))
141122

142-
exceptions <- xml2::xml_find_all(test, "./Exception")
143-
for (exception in exceptions) {
144-
exception_text <- xml2::xml_text(exception, trim = TRUE)
145-
filename <- xml2::xml_attr(exception, "filename")
146-
line <- xml2::xml_attr(exception, "line")
147-
148-
exception_srcref <- srcref(
149-
srcfile(file.path("src", filename)),
150-
c(line, line, 1, 1)
151-
)
152-
153-
exp <- new_expectation(
154-
"error",
155-
exception_text,
156-
srcref = exception_srcref
157-
)
158-
exp$test <- test_name
159-
160-
get_reporter()$add_result(
161-
context = context_name,
162-
test = test_name,
163-
result = exp
164-
)
165-
}
123+
failures <- xml2::xml_find_all(test, "./Expression")
124+
failures <- map(failures, parse_catch_failure)
166125

167-
get_reporter()$end_test(context = context_name, test = test_name)
168-
}
169-
}
126+
exceptions <- xml2::xml_find_all(test, "./Exception")
127+
exceptions <- map(exceptions, parse_catch_exception)
128+
129+
list(
130+
name = name,
131+
n_successes = n_successes,
132+
failures = failures,
133+
exceptions = exceptions
134+
)
135+
}
136+
137+
parse_catch_failure <- function(failure) {
138+
type <- switch(
139+
xml2::xml_attr(failure, "type"),
140+
"CATCH_CHECK_FALSE" = "isn't false.",
141+
"CATCH_CHECK_THROWS" = "did not throw an exception.",
142+
"CATCH_CHECK_THROWS_AS" = "threw an exception with unexpected type.",
143+
"isn't true."
144+
)
145+
146+
message <- xml2::xml_find_first(failure, "Original")
147+
message <- xml2::xml_text(message, trim = TRUE)
148+
message <- paste(message, type)
149+
150+
filename <- xml2::xml_attr(failure, "filename")
151+
line <- xml2::xml_attr(failure, "line")
152+
srcref <- srcref(
153+
srcfile(file.path("src", filename)),
154+
c(line, line, 1, 1)
155+
)
156+
157+
list(
158+
message = message,
159+
srcref = srcref
160+
)
161+
}
162+
163+
parse_catch_exception <- function(exception) {
164+
message <- xml2::xml_text(exception, trim = TRUE)
165+
166+
filename <- xml2::xml_attr(exception, "filename")
167+
line <- xml2::xml_attr(exception, "line")
168+
srcref <- srcref(
169+
srcfile(file.path("src", filename)),
170+
c(line, line, 1, 1)
171+
)
172+
173+
list(
174+
message = message,
175+
srcref = srcref
176+
)
170177
}
171178

172179
#' Use Catch for C++ unit testing

0 commit comments

Comments
 (0)