Nothing
test_that("returns condition or value", {
expect_equal(expect_error(1, NA), 1)
expect_s3_class(expect_error(stop("!")), "simpleError")
})
test_that("regexp = NULL checks for presence of error", {
expect_success(expect_error(stop()))
expect_snapshot_failure(expect_error(null()))
})
test_that("regexp = NA checks for absence of error", {
expect_success(expect_error(null(), NA))
expect_failure(expect_error(stop("Yes"), NA))
})
test_that("regexp = string matches for error message", {
expect_success(expect_error(stop("Yes"), "Yes"))
expect_error(expect_error(stop("Yes"), "No"))
expect_snapshot_failure(expect_error("OK", "No"))
})
test_that("class = string matches class of error", {
blah <- function() {
abort("hi", class = c("blah", "error", "condition"))
}
expect_success(expect_error(blah(), class = "blah"))
expect_error(expect_error(blah(), class = "blech"), class = "blah")
})
test_that("base_class must match when class is set", {
foo <- function() warn("foo", class = "bar")
expect_warning(expect_failure(expect_error(foo(), class = "bar")))
expect_success(expect_warning(foo(), class = "bar"))
})
test_that("check type of class and pattern", {
expect_snapshot(error = TRUE, {
expect_error(stop("!"), regexp = 1)
expect_error(stop("!"), class = 1)
})
})
test_that("... passed on to grepl", {
expect_success(expect_error(stop("X"), "x", ignore.case = TRUE))
})
test_that("message method is called when expecting error", {
local_bindings(
conditionMessage.foobar = function(err) "dispatched!",
.env = globalenv()
)
fb <- function() abort("foobar", "foobar")
expect_error(fb(), "dispatched!", class = "foobar")
expect_snapshot_failure(expect_error(fb(), NA))
})
test_that("rlang backtrace reminders are not included in error message", {
f <- function() g()
g <- function() h()
h <- function() abort("foo")
expect_error(f(), "foo$")
})
test_that("can capture Throwable conditions from rJava", {
local_bindings(
conditionMessage.Throwable = function(c, ...) unclass(c)$message,
conditionCall.Throwable = function(c, ...) unclass(c)$call,
`$.Throwable` = function(...) stop("forbidden"),
`$<-.Throwable` = function(...) stop("forbidden"),
.env = globalenv()
)
throw <- function(msg) stop(error_cnd("Throwable", message = msg))
expect_error(throw("foo"), "foo", class = "Throwable")
})
# expect_warning() ----------------------------------------------------------
test_that("warnings are converted to errors when options('warn') >= 2", {
withr::with_options(c(warn = 2), {
expect_warning(warning("foo"))
expect_error(warning("foo"))
})
})
test_that("can silence warnings", {
expect_warning(suppressWarnings(warning("foo")), NA)
# Can't test with `expect_warning()` because the warning is still
# signalled, it's just not printed
# https://github.com/wch/r-source/blob/886ab4a0/src/main/errors.c#L388-L484
withr::with_options(c(warn = -1), warning("foo"))
})
test_that("when checking for no warnings, exclude deprecation warnings", {
foo <- function() {
lifecycle::deprecate_warn("1.0.0", "foo()")
}
expect_warning(
expect_warning(foo(), NA),
class = "lifecycle_warning_deprecated"
)
})
test_that("when checking for no warnings, exclude deprecation warnings (2e)", {
local_edition(2)
foo <- function() {
options(lifecycle_verbosity = "warning")
lifecycle::deprecate_warn("1.0.0", "foo()")
}
expect_warning(
expect_warning(foo(), NA),
class = "lifecycle_warning_deprecated"
)
})
# expect_message ----------------------------------------------------------
test_that("regexp = NA checks for absence of message", {
expect_success(expect_message(null(), NA))
expect_failure(expect_message(message("!"), NA))
})
# expect_condition --------------------------------------------------------
test_that("continues evaluation", {
expect_condition({
message("Hi")
new_variable <- 1
})
expect_equal(exists("new_variable"), TRUE)
})
test_that("but not after error", {
expect_condition({
stop("Hi")
new_variable <- 1
})
expect_equal(exists("new_variable"), FALSE)
})
test_that("captured condition is muffled", {
expect_message(expect_condition(message("Hi")), NA)
expect_warning(expect_condition(warning("Hi")), NA)
expect_error(expect_condition(stop("Hi")), NA)
})
test_that("only matching condition is captured, others bubble up", {
f1 <- function() {
message("Hi")
message("Bye")
}
expect_condition(expect_condition(f1(), "Hi"), "Bye")
expect_condition(expect_condition(f1(), "Bye"), "Hi")
f2 <- function() {
message("Hi")
stop("Bye")
}
expect_error(expect_condition(f2(), "Hi"), "Bye")
})
test_that("cnd expectations consistently return condition (#1371)", {
f <- function(out, action) {
action
out
}
expect_s3_class(expect_message(f(NULL, message(""))), "simpleMessage")
expect_s3_class(expect_warning(f(NULL, warning(""))), "simpleWarning")
expect_s3_class(expect_error(f(NULL, stop(""))), "simpleError")
# Used to behave differently with non-`NULL` values
expect_s3_class(expect_message(f("return value", message(""))), "simpleMessage")
expect_s3_class(expect_warning(f("return value", warning(""))), "simpleWarning")
expect_s3_class(expect_error(f("return value", stop(""))), "simpleError")
# If there is no condition expected we return the value
expect_equal(expect_message(f("return value", NULL), regexp = NA), "return value")
expect_equal(expect_warning(f("return value", NULL), regexp = NA), "return value")
expect_equal(expect_error(f("return value", NULL), regexp = NA), "return value")
})
test_that("cli width wrapping doesn't affect text matching", {
skip_if_not_installed("cli", "3.0.2")
skip_if_not_installed("rlang", "1.0.0")
local_use_cli()
expect_error(
abort("foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz"),
"foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz foobarbaz"
)
})
test_that("can match parent conditions (#1493)", {
parent <- error_cnd("foo", message = "Parent message.")
f <- function() abort("Tilt.", parent = parent)
expect_error(f(), class = "foo")
expect_error(f(), "^Parent message.$")
# Pattern and class must match the same condition
expect_error(expect_error(f(), "Tilt.", class = "foo"))
# Can disable parent matching
expect_error(expect_error(f(), class = "foo", inherit = FALSE))
expect_error(expect_error(f(), "Parent message.", inherit = FALSE))
})
# second edition ----------------------------------------------------------
test_that("other conditions are swallowed", {
f <- function(...) {
conds <- c(...)
for (cond in conds) {
switch(cond,
message = message("message"),
warning = warning("warning"),
error = stop("error"),
condition = signal("signal", class = "signal")
)
}
}
local_edition(2)
# if condition text doesn't match, expectation fails (not errors)
expect_failure(expect_error(f("error"), "not a match"))
expect_failure(expect_warning(f("warning"), "not a match"))
expect_failure(expect_message(f("message"), "not a match"))
expect_failure(expect_condition(f("condition"), "not a match"))
# if error/condition class doesn't match, expectation fails
expect_failure(expect_error(f("error"), class = "not a match"))
expect_failure(expect_condition(f("message"), class = "not a match"))
# expect_message() and expect_warning() swallow all messages/warnings
expect_message(expect_message(f("message", "message")), NA)
expect_warning(expect_warning(f("warning", "warning")), NA)
})
test_that("can match parent conditions (edition 2, #1493)", {
local_edition(2)
parent <- error_cnd("foo", message = "Parent message.")
f <- function() abort("Tilt.", parent = parent)
expect_error(f(), class = "foo")
expect_error(f(), "^Parent message.$")
# Can disable parent matching
expect_error(expect_error(f(), class = "foo", inherit = FALSE))
expect_error(expect_error(f(), "Parent message.", inherit = FALSE))
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.