From 73774ae8bbbdd14dd7e60d6622d33abf8a6e2dd2 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Wed, 30 Jul 2025 13:39:23 -0500 Subject: [PATCH 1/9] Improve custom expectation docs --- vignettes/custom-expectation.Rmd | 158 ++++++++++++++++++++++++------- 1 file changed, 125 insertions(+), 33 deletions(-) diff --git a/vignettes/custom-expectation.Rmd b/vignettes/custom-expectation.Rmd index 63d441ab9..0b390af3b 100644 --- a/vignettes/custom-expectation.Rmd +++ b/vignettes/custom-expectation.Rmd @@ -16,54 +16,82 @@ snapper <- local_snapshotter() snapper$start_file("snapshotting.Rmd", "test") ``` -This vignette shows you how to write your expectations that work identically to the built-in `expect_` functions. - -You can use these either locally by putting them in a helper file, or export them from your package. +This vignette shows you how to write your expectations. You can use within your package by putting them in a helper file, or share them with others by exporting them from your package. ## Expectation basics -There are three main parts to writing an expectation, as illustrated by `expect_length()`: +An expectation has three main parts, as illustrated by `expect_length()`: ```{r} expect_length <- function(object, n) { # 1. Capture object and label act <- quasi_label(rlang::enquo(object), arg = "object") - # 2. Verify the expectations + # 2. Fail when expectations aren't met act_n <- length(act$val) if (act_n != n) { msg <- sprintf("%s has length %i, not length %i.", act$lab, act_n, n) return(fail(msg)) } - # 3. Pass + # 3. Pass when expectations are pass(act$val) } ``` -### Capture value and label +The first step in any expectation is to use `quasi_label()` to capture both the value (`$val`) of the first argument and a label (`$lab`) to use failure messages. This is a pattern that exists to support fairly esoteric testthat features; you don't need to understand, just copy and paste it 🙂. + +Next, you need to fail, for each way that the `object` violates our expectation. In my experience it's easier to check for problems one by one, because that yields the most informative failure messages. Note that it's really important to `return(fail())` here. You wont see the problem when interactively testing your function because when run outside of `test_that()`, `fail()` throws an error, causing the function to terminate early. When running inside of `test_that()` however, `fail()` does not stop execution because we want to collect all failures in a given test. + +Finally, if the object is expected, call `pass()` with the input value (usually `act$val`). Returning the input value is good practice since expectation functions are called primarily for their side-effects (triggering a failure). This allows expectations to be chained: -The first step in any expectation is to capture the actual object, and generate a label for it to use if a failure occur. All testthat expectations support quasiquotation so that you can unquote variables. This makes it easier to generate good labels when the expectation is called from a function or within a for loop. +```{r} +mtcars |> + expect_type("list") |> + expect_s3_class("data.frame") |> + expect_length(11) +``` -By convention, the first argument to every `expect_` function is called `object`, and you capture its value (`val`) and label (`lab`) with `act <- quasi_label(enquo(object))`, where `act` is short for actual (in constrast to expected). +## Testing your expectations -### Verify the expectation +testthat comes with three expectations designed specifically to test expectations: `expect_success()` and `expect_failure()`: -Now we can check if our expectation is met and return `fail()` if not. The most challenging job here is typically generating the error message because you want it to be as self-contained as possible. This means it should typically give both the expected and actual value, along with the name of the object passed to the expectation. testthat expectations use `sprintf()`, but if you're familiar with {glue}, you might want to use that instead. +* `expect_success()` checks that your expectation emits exactly one success and zero failures. +* `expect_failure()` checks that your expectation emits exactly one failure and zero successes. +* `expect_failure_snapshot()` captures the failure message in a snapshot, making it easier to review if it's useful or not. -More complicated expectations will have more `if` statements. For example, we might want to make our `expect_length()` function include an assertion that `object` is a vector: +It's important to check that expectations return either one failure or one success because the ensures that reporting is correct. If you + +```{r} +test_that("expect_length works as expected", { + x <- 1:10 + expect_success(expect_length(x, 10)) + expect_failure(expect_length(x, 11)) +}) + +test_that("expect_length gives useful feedback", { + x <- 1:10 + expect_snapshot_failure(expect_length(x, 11)) +}) +``` + +## Examples + +### `expect_vector_length()` + +For example, you could imagine a slightly more complex version that first checked if the object was a vector: ```{r} expect_vector_length <- function(object, n) { - act <- quasi_label(rlang::enquo(object), arg = "object") + act <- quasi_label(rlang::enquo(object)) - if (!is.atomic(act$val) || !is.list(act$val)) { + if (!is.atomic(act$val) && !is.list(act$val)) { msg <- sprintf("%s is a %s, not a vector", act$lab, typeof(act$val)) return(fail(msg)) } act_n <- length(act$val) - if (act$n != n) { + if (act_n != n) { msg <- sprintf("%s has length %i, not length %i.", act$lab, act_n, n) return(fail(msg)) } @@ -72,33 +100,97 @@ expect_vector_length <- function(object, n) { } ``` -Note that it's really important to `return(fail())` here. You wont see the problem when interactively testing your function because when run outside of `test_that()`, `fail()` throws an error, causing the function to terminate early. When running inside of `test_that()` however, `fail()` does not stop execution because we want to collect all failures in a given test. +To make your failure messages as actionable as possible, state both what the object is and what you expected: -### Pass the test +```{r} +#| error: true +expect_vector_length(mean, 10) +expect_vector_length(mtcars, 15) +``` -If no assertions fail, call `pass()` with the input value (usually `act$val`). Returning the input value is good practice since expectation functions are called primarily for their side-effects (triggering a failure). This allows expectations to be chained: +### `expect_s3_class()` + +As another example, imagine if you're checking to see if an object inherits from an S3 class. In R, there's no direct way to tell if an object is an S3 object: you can confirm that it's an object, then that it's not an S4 object. So you might organise your test this way: ```{r} -mtcars |> - expect_type("list") |> - expect_s3_class("data.frame") |> - expect_length(11) +expect_s3_class <- function(object, class) { + act <- quasi_label(rlang::enquo(object), arg = "object") + + if (!is.object(act$val)) { + return(fail(sprintf("%s is not an object.", act$lab))) + } + + if (isS4(act$val)) { + return(fail(sprintf("%s is an S4 object, not an S3 object.", act$lab))) + } + + if (!inherits(act$val, class)) { + msg <- sprintf( + "%s inherits from %s not %s.", + act$lab, + paste0(class(object), collapse = "/"), + paste0(class, collapse = "/") + ) + return(fail(msg)) + } + + pass(act$val) +} ``` -## Testing your expectations +```{r} +#| error: true +x1 <- 1:10 +TestClass <- methods::setClass("Test", contains = "integer") +x2 <- TestClass() +x3 <- factor() + +expect_s3_class(x1, "integer") +expect_s3_class(x2, "integer") +expect_s3_class(x3, "integer") +``` -testthat comes with three expectations designed specifically to test expectations: `expect_success()` and `expect_failure()`: +## Repeated code -* `expect_success()` checks that your expectation emits exactly one success and zero failures. -* `expect_failure()` checks that your expectation emits exactly one failure and zero successes. -* `expect_failure_snapshot()` captures the failure message in a snapshot, making it easier to review if it's useful or not. +As you write more expectations, you might discover repeated code that you want to extract out in to a helper. For example, testthat has `expect_true()`, `expect_false()`, and `expect_null()` which are special cases of `expect_equal()` ```{r} -test_that("expect_length works as expected", { - x <- 1:10 - expect_success(expect_length(x, 10)) - expect_failure(expect_length(x, 11)) +expect_true <- function(object) { + act <- quasi_label(enquo(object)) + expect_constant_(act, TRUE, ignore_attr = TRUE) +} +expect_false <- function(object) { + act <- quasi_label(enquo(object)) + expect_constant_(act, FALSE, ignore_attr = TRUE) +} +expect_null <- function(object, label = NULL) { + act <- quasi_label(enquo(object)) + expect_constant_(act, NULL) +} - expect_snapshot_failure(expect_length(x, 11)) -}) +expect_constant_ <- function( + act, + constant, + ignore_attr = TRUE, + trace_env = caller_env() +) { + comp <- waldo::compare( + act$val, + constant, + x_arg = "actual", + y_arg = "expected", + ignore_attr = ignore_attr + ) + if (length(comp) != 0) { + msg <- sprintf( + "%s is not %s\n\n%s", + act$lab, + format(constant), + paste0(comp, collapse = "\n\n") + ) + return(fail(msg, info = info, trace_env = trace_env)) + } + + pass(act$val) +} ``` From cb0f77e93ae7dc0e273d045ef004d0a0c3f58ffe Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 31 Jul 2025 11:45:11 -0500 Subject: [PATCH 2/9] More writing --- vignettes/custom-expectation.Rmd | 69 ++++++++++++++++++++------------ 1 file changed, 44 insertions(+), 25 deletions(-) diff --git a/vignettes/custom-expectation.Rmd b/vignettes/custom-expectation.Rmd index 0b390af3b..dc350ad52 100644 --- a/vignettes/custom-expectation.Rmd +++ b/vignettes/custom-expectation.Rmd @@ -39,11 +39,13 @@ expect_length <- function(object, n) { } ``` -The first step in any expectation is to use `quasi_label()` to capture both the value (`$val`) of the first argument and a label (`$lab`) to use failure messages. This is a pattern that exists to support fairly esoteric testthat features; you don't need to understand, just copy and paste it 🙂. +The first step in any expectation is to use `quasi_label()` to capture a "labelled value", i.e. an list that contains both the value (`$val`) for testing and a label (`$lab`) for messaging. This is a pattern that exists for fairly esoteric reasons; you don't need to understand, just copy and paste it 🙂. -Next, you need to fail, for each way that the `object` violates our expectation. In my experience it's easier to check for problems one by one, because that yields the most informative failure messages. Note that it's really important to `return(fail())` here. You wont see the problem when interactively testing your function because when run outside of `test_that()`, `fail()` throws an error, causing the function to terminate early. When running inside of `test_that()` however, `fail()` does not stop execution because we want to collect all failures in a given test. +Next you need to check each way that `object` could be broken. In most cases, it's easier to check for problems one by one, using early returns to `fail()` when any expectation is violated as that makes it easier to write failure messages. It's good practice to state both what the object is and what you expected in your failures. -Finally, if the object is expected, call `pass()` with the input value (usually `act$val`). Returning the input value is good practice since expectation functions are called primarily for their side-effects (triggering a failure). This allows expectations to be chained: +Also note that you need to use `return(fail())` here. You won't see the problem when interactively testing your function because when run outside of `test_that()`, `fail()` throws an error, causing the function to terminate early. When running inside of `test_that()`, however, `fail()` does not stop execution because we want to collect all failures in a given test. + +Finally, if the object is as expected, call `pass()` with `act$val`. Returning the input value is good practice since expectation functions are called primarily for their side-effects (triggering a failure). This allows expectations to be chained: ```{r} mtcars |> @@ -52,15 +54,15 @@ mtcars |> expect_length(11) ``` -## Testing your expectations +### Testing your expectations -testthat comes with three expectations designed specifically to test expectations: `expect_success()` and `expect_failure()`: +Once you've written your expectation, you need to test it, and luckily testthat comes with three expectations designed specifically to test expectations: * `expect_success()` checks that your expectation emits exactly one success and zero failures. * `expect_failure()` checks that your expectation emits exactly one failure and zero successes. * `expect_failure_snapshot()` captures the failure message in a snapshot, making it easier to review if it's useful or not. -It's important to check that expectations return either one failure or one success because the ensures that reporting is correct. If you +The first two expectations are particularly important because they ensure that your expectation reports the correct number of succeses and failures to the user. ```{r} test_that("expect_length works as expected", { @@ -77,9 +79,17 @@ test_that("expect_length gives useful feedback", { ## Examples +The following sections show you a few more variations, losely based on existing testthat expectations. + ### `expect_vector_length()` -For example, you could imagine a slightly more complex version that first checked if the object was a vector: +Lets make `expect_length()` a bit more strict by also checking that the input is a vector. R is a bit weird that it gives a length to pretty much every object, and you can imagine not wanting this code to succeed: + +```{r} +expect_length(mean, 1) +``` + +To do this we'll add an extra check that the input is either an atomic vector or a list: ```{r} expect_vector_length <- function(object, n) { @@ -100,17 +110,15 @@ expect_vector_length <- function(object, n) { } ``` -To make your failure messages as actionable as possible, state both what the object is and what you expected: - ```{r} #| error: true -expect_vector_length(mean, 10) +expect_vector_length(mean, 1) expect_vector_length(mtcars, 15) ``` ### `expect_s3_class()` -As another example, imagine if you're checking to see if an object inherits from an S3 class. In R, there's no direct way to tell if an object is an S3 object: you can confirm that it's an object, then that it's not an S4 object. So you might organise your test this way: +Or imagine if you're checking to see if an object inherits from an S3 class. In R, there's no direct way to tell if an object is an S3 object: you can confirm that it's an object, then that it's not an S4 object. So you might organise your expectation this way: ```{r} expect_s3_class <- function(object, class) { @@ -152,45 +160,56 @@ expect_s3_class(x3, "integer") ## Repeated code -As you write more expectations, you might discover repeated code that you want to extract out in to a helper. For example, testthat has `expect_true()`, `expect_false()`, and `expect_null()` which are special cases of `expect_equal()` +As you write more expectations, you might discover repeated code that you want to extract out in to a helper. For example, testthat has `expect_true()`, `expect_false()`, and `expect_null()` which are special cases of `expect_equal()`. ```{r} expect_true <- function(object) { act <- quasi_label(enquo(object)) - expect_constant_(act, TRUE, ignore_attr = TRUE) + expect_waldo_equal_("equal", act, TRUE, ignore_attr = TRUE) } expect_false <- function(object) { act <- quasi_label(enquo(object)) - expect_constant_(act, FALSE, ignore_attr = TRUE) + expect_waldo_equal_("equal", act, FALSE, ignore_attr = TRUE) } expect_null <- function(object, label = NULL) { act <- quasi_label(enquo(object)) - expect_constant_(act, NULL) + expect_waldo_equal_("equal", act, NULL) } +``` + +You might wonder why these functions don't call `expect_equal()` directly. Unfortunately creating helper functions is not straightforward in testthat because every `fail()` captures the calling environment in order to give maximally useful tracebacks. Getting this right is not critical (you'll just get a slightly suboptimal traceback in the case of failure) but it's good practice, particularly for testthat itself. + +To do things 100% correctly, in your helper function you need to have a `trace_env` argument that defaults to `caller_env()`, and then you need to pass it to every instance of -expect_constant_ <- function( +```{r} +expect_waldo_equal_ <- function( + type, act, - constant, - ignore_attr = TRUE, + exp, + info, + ..., trace_env = caller_env() ) { - comp <- waldo::compare( + comp <- waldo_compare( act$val, - constant, + exp$val, + ..., x_arg = "actual", - y_arg = "expected", - ignore_attr = ignore_attr + y_arg = "expected" ) if (length(comp) != 0) { msg <- sprintf( - "%s is not %s\n\n%s", + "%s (%s) not %s to %s (%s).\n\n%s", act$lab, - format(constant), + "`actual`", + type, + exp$lab, + "`expected`", paste0(comp, collapse = "\n\n") ) return(fail(msg, info = info, trace_env = trace_env)) } - pass(act$val) } + ``` From aef39b7bd4628428bf0a71668e92e8c4841946fc Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 31 Jul 2025 12:00:18 -0500 Subject: [PATCH 3/9] Polish vignette + docs --- R/expect-that.R | 34 ++++++++++++------ man/expect.Rd | 11 +++--- man/expectation.Rd | 3 +- man/fail.Rd | 34 ++++++++++++------ man/succeed.Rd | 5 +-- vignettes/custom-expectation.Rmd | 59 ++++++++------------------------ 6 files changed, 71 insertions(+), 75 deletions(-) diff --git a/R/expect-that.R b/R/expect-that.R index 9aab92ef6..76d452d5d 100644 --- a/R/expect-that.R +++ b/R/expect-that.R @@ -2,25 +2,37 @@ #' #' @description #' These are the primitives that you can use to implement your own expectations. -#' Every branch of code inside an expectation must call either `pass()` or -#' `fail()`; learn more in `vignette("custom-expectation")`. +#' Regardless of how it's called an expectation should either return `pass()`, +#' `fail()`, or throw an error (if for example, the arguments are invalid). #' -#' @param message a string to display. +#' Learn more about creating your own expectations in +#' `vignette("custom-expectation")`. +#' +#' @param message Failure message to send to the user. It's best practice to +#' describe both what is expected and what was actually received. #' @param info Character vector continuing additional information. Included #' for backward compatibility only and new expectations should not use it. #' @param srcref Location of the failure. Should only needed to be explicitly #' supplied when you need to forward a srcref captured elsewhere. +#' @param trace_env If `trace` is not specified, this is used to generate an +#' informative traceack for failures. You should only need to set this if +#' you're calling `fail()` from a helper function; see +#' `vignette("custom-expectation")` for details. #' @param trace An optional backtrace created by [rlang::trace_back()]. #' When supplied, the expectation is displayed with the backtrace. -#' @param trace_env If `is.null(trace)`, this is used to automatically -#' generate a traceback running from `test_code()`/`test_file()` to -#' `trace_env`. You'll generally only need to set this if you're wrapping -#' an expectation inside another function. +#' Expert use only. #' @export #' @examples -#' \dontrun{ -#' test_that("this test fails", fail()) -#' test_that("this test succeeds", succeed()) +#' expect_length <- function(object, n) { +#' act <- quasi_label(rlang::enquo(object), arg = "object") +#' +#' act_n <- length(act$val) +#' if (act_n != n) { +#' msg <- sprintf("%s has length %i, not length %i.", act$lab, act_n, n) +#' return(fail(msg)) +#' } +#' +#' pass(act$val) #' } fail <- function( message = "Failure has been forced", @@ -53,7 +65,7 @@ pass <- function(value) { #' Mark a test as successful #' #' This is an older version of [pass()] that exists for backwards compatibility. -#' You should now use `pass()` instead` +#' You should now use `pass()` instead. #' #' @export #' @inheritParams fail diff --git a/man/expect.Rd b/man/expect.Rd index 656d32be1..c38d2d9b5 100644 --- a/man/expect.Rd +++ b/man/expect.Rd @@ -25,12 +25,13 @@ for backward compatibility only and new expectations should not use it.} supplied when you need to forward a srcref captured elsewhere.} \item{trace}{An optional backtrace created by \code{\link[rlang:trace_back]{rlang::trace_back()}}. -When supplied, the expectation is displayed with the backtrace.} +When supplied, the expectation is displayed with the backtrace. +Expert use only.} -\item{trace_env}{If \code{is.null(trace)}, this is used to automatically -generate a traceback running from \code{test_code()}/\code{test_file()} to -\code{trace_env}. You'll generally only need to set this if you're wrapping -an expectation inside another function.} +\item{trace_env}{If \code{trace} is not specified, this is used to generate an +informative traceack for failures. You should only need to set this if +you're calling \code{fail()} from a helper function; see +\code{vignette("custom-expectation")} for details.} } \value{ An expectation object from either \code{succeed()} or \code{fail()}. diff --git a/man/expectation.Rd b/man/expectation.Rd index 24ec76982..c8509e9f1 100644 --- a/man/expectation.Rd +++ b/man/expectation.Rd @@ -31,7 +31,8 @@ is.expectation(x) \item{srcref}{Optional \code{srcref} giving location of test.} \item{trace}{An optional backtrace created by \code{\link[rlang:trace_back]{rlang::trace_back()}}. -When supplied, the expectation is displayed with the backtrace.} +When supplied, the expectation is displayed with the backtrace. +Expert use only.} \item{...}{Additional attributes for the expectation object.} diff --git a/man/fail.Rd b/man/fail.Rd index cf02ab4cf..2650c8002 100644 --- a/man/fail.Rd +++ b/man/fail.Rd @@ -16,7 +16,8 @@ fail( pass(value) } \arguments{ -\item{message}{a string to display.} +\item{message}{Failure message to send to the user. It's best practice to +describe both what is expected and what was actually received.} \item{info}{Character vector continuing additional information. Included for backward compatibility only and new expectations should not use it.} @@ -24,25 +25,36 @@ for backward compatibility only and new expectations should not use it.} \item{srcref}{Location of the failure. Should only needed to be explicitly supplied when you need to forward a srcref captured elsewhere.} -\item{trace_env}{If \code{is.null(trace)}, this is used to automatically -generate a traceback running from \code{test_code()}/\code{test_file()} to -\code{trace_env}. You'll generally only need to set this if you're wrapping -an expectation inside another function.} +\item{trace_env}{If \code{trace} is not specified, this is used to generate an +informative traceack for failures. You should only need to set this if +you're calling \code{fail()} from a helper function; see +\code{vignette("custom-expectation")} for details.} \item{trace}{An optional backtrace created by \code{\link[rlang:trace_back]{rlang::trace_back()}}. -When supplied, the expectation is displayed with the backtrace.} +When supplied, the expectation is displayed with the backtrace. +Expert use only.} \item{value}{Value to return, typically the result of evaluating the \code{object} argument to the expectation.} } \description{ These are the primitives that you can use to implement your own expectations. -Every branch of code inside an expectation must call either \code{pass()} or -\code{fail()}; learn more in \code{vignette("custom-expectation")}. +Regardless of how it's called an expectation should either return \code{pass()}, +\code{fail()}, or throw an error (if for example, the arguments are invalid). + +Learn more about creating your own expectations in +\code{vignette("custom-expectation")}. } \examples{ -\dontrun{ -test_that("this test fails", fail()) -test_that("this test succeeds", succeed()) +expect_length <- function(object, n) { + act <- quasi_label(rlang::enquo(object), arg = "object") + + act_n <- length(act$val) + if (act_n != n) { + msg <- sprintf("\%s has length \%i, not length \%i.", act$lab, act_n, n) + return(fail(msg)) + } + + pass(act$val) } } diff --git a/man/succeed.Rd b/man/succeed.Rd index 6d99b9ab0..c05398609 100644 --- a/man/succeed.Rd +++ b/man/succeed.Rd @@ -7,13 +7,14 @@ succeed(message = "Success has been forced", info = NULL) } \arguments{ -\item{message}{a string to display.} +\item{message}{Failure message to send to the user. It's best practice to +describe both what is expected and what was actually received.} \item{info}{Character vector continuing additional information. Included for backward compatibility only and new expectations should not use it.} } \description{ This is an older version of \code{\link[=pass]{pass()}} that exists for backwards compatibility. -You should now use \code{pass()} instead` +You should now use \code{pass()} instead. } \keyword{internal} diff --git a/vignettes/custom-expectation.Rmd b/vignettes/custom-expectation.Rmd index dc350ad52..60fe3db9f 100644 --- a/vignettes/custom-expectation.Rmd +++ b/vignettes/custom-expectation.Rmd @@ -160,56 +160,25 @@ expect_s3_class(x3, "integer") ## Repeated code -As you write more expectations, you might discover repeated code that you want to extract out in to a helper. For example, testthat has `expect_true()`, `expect_false()`, and `expect_null()` which are special cases of `expect_equal()`. +As you write more expectations, you might discover repeated code that you want to extract out in to a helper. Unfortunately creating helper functions is not straightforward in testthat because every `fail()` captures the calling environment in order to give maximally useful tracebacks. Because getting this right is not critical (you'll just get a slightly suboptimal traceback in the case of failure), we don't recommend bothering. However, we document it here because it's important to get it right in testthat itself. -```{r} -expect_true <- function(object) { - act <- quasi_label(enquo(object)) - expect_waldo_equal_("equal", act, TRUE, ignore_attr = TRUE) -} -expect_false <- function(object) { - act <- quasi_label(enquo(object)) - expect_waldo_equal_("equal", act, FALSE, ignore_attr = TRUE) -} -expect_null <- function(object, label = NULL) { - act <- quasi_label(enquo(object)) - expect_waldo_equal_("equal", act, NULL) -} -``` - -You might wonder why these functions don't call `expect_equal()` directly. Unfortunately creating helper functions is not straightforward in testthat because every `fail()` captures the calling environment in order to give maximally useful tracebacks. Getting this right is not critical (you'll just get a slightly suboptimal traceback in the case of failure) but it's good practice, particularly for testthat itself. - -To do things 100% correctly, in your helper function you need to have a `trace_env` argument that defaults to `caller_env()`, and then you need to pass it to every instance of +The key challenge is that `fail()` captures a `trace_env` which should be the execution environment of the expectation. This usually works, because the default value of `trace_env` is `caller_env()`. But when you introduce a helper, you'll need to explicitly pass it along: ```{r} -expect_waldo_equal_ <- function( - type, - act, - exp, - info, - ..., - trace_env = caller_env() -) { - comp <- waldo_compare( - act$val, - exp$val, - ..., - x_arg = "actual", - y_arg = "expected" - ) - if (length(comp) != 0) { - msg <- sprintf( - "%s (%s) not %s to %s (%s).\n\n%s", - act$lab, - "`actual`", - type, - exp$lab, - "`expected`", - paste0(comp, collapse = "\n\n") - ) - return(fail(msg, info = info, trace_env = trace_env)) +expect_length_ <- function(act, n, trace_env = caller_env()) { + act_n <- length(act$val) + if (act_n != n) { + msg <- sprintf("%s has length %i, not length %i.", act$lab, act_n, n) + return(fail(msg, trace_env = trace_env)) } + pass(act$val) } +expect_length <- function(object, n) { + act <- quasi_label(rlang::enquo(object), arg = "object") + expect_length_(act, n) +} ``` + +Note that the helper probably shouldn't be user facing, and we give it a `_` suffix to make that clear. It's also typically easiest for a helper to take the labelled value produced by `quasi_label()` rather than having to do that repeatedly. From fde643d59b2c3fd4939e53875bbc020fa5cd18d0 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 1 Aug 2025 08:03:29 -0500 Subject: [PATCH 4/9] Apply suggestions from code review Co-authored-by: Emil Hvitfeldt --- vignettes/custom-expectation.Rmd | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/vignettes/custom-expectation.Rmd b/vignettes/custom-expectation.Rmd index 60fe3db9f..78e97fa0c 100644 --- a/vignettes/custom-expectation.Rmd +++ b/vignettes/custom-expectation.Rmd @@ -24,7 +24,7 @@ An expectation has three main parts, as illustrated by `expect_length()`: ```{r} expect_length <- function(object, n) { - # 1. Capture object and label + # 1. Capture object and its label act <- quasi_label(rlang::enquo(object), arg = "object") # 2. Fail when expectations aren't met @@ -39,7 +39,7 @@ expect_length <- function(object, n) { } ``` -The first step in any expectation is to use `quasi_label()` to capture a "labelled value", i.e. an list that contains both the value (`$val`) for testing and a label (`$lab`) for messaging. This is a pattern that exists for fairly esoteric reasons; you don't need to understand, just copy and paste it 🙂. +The first step in any expectation is to use `quasi_label()` to capture a "labelled value", i.e. a list that contains both the value (`$val`) for testing and a label (`$lab`) for messaging. This is a pattern that exists for fairly esoteric reasons; you don't need to understand, just copy and paste it 🙂. Next you need to check each way that `object` could be broken. In most cases, it's easier to check for problems one by one, using early returns to `fail()` when any expectation is violated as that makes it easier to write failure messages. It's good practice to state both what the object is and what you expected in your failures. @@ -62,7 +62,7 @@ Once you've written your expectation, you need to test it, and luckily testthat * `expect_failure()` checks that your expectation emits exactly one failure and zero successes. * `expect_failure_snapshot()` captures the failure message in a snapshot, making it easier to review if it's useful or not. -The first two expectations are particularly important because they ensure that your expectation reports the correct number of succeses and failures to the user. +The first two expectations are particularly important because they ensure that your expectation reports the correct number of successes and failures to the user. ```{r} test_that("expect_length works as expected", { @@ -79,7 +79,7 @@ test_that("expect_length gives useful feedback", { ## Examples -The following sections show you a few more variations, losely based on existing testthat expectations. +The following sections show you a few more variations, loosely based on existing testthat expectations. ### `expect_vector_length()` From dbaf1cf1732a692e3daf3b45df674f7c7d4d68dc Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 1 Aug 2025 08:10:58 -0500 Subject: [PATCH 5/9] Add an example of argument checking --- vignettes/custom-expectation.Rmd | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/vignettes/custom-expectation.Rmd b/vignettes/custom-expectation.Rmd index 78e97fa0c..1bed69488 100644 --- a/vignettes/custom-expectation.Rmd +++ b/vignettes/custom-expectation.Rmd @@ -122,6 +122,10 @@ Or imagine if you're checking to see if an object inherits from an S3 class. In ```{r} expect_s3_class <- function(object, class) { + if (!rlang::is_string(class)) { + rlang::abort("`class` must be a string.") + } + act <- quasi_label(rlang::enquo(object), arg = "object") if (!is.object(act$val)) { @@ -158,6 +162,13 @@ expect_s3_class(x2, "integer") expect_s3_class(x3, "integer") ``` +Note that I also check that the `class` argument must be a string. This is an error, not a failure, because it suggests you're using the function incorrectly. + +```{r} +#| error: true +expect_s3_class(x1, 1) +``` + ## Repeated code As you write more expectations, you might discover repeated code that you want to extract out in to a helper. Unfortunately creating helper functions is not straightforward in testthat because every `fail()` captures the calling environment in order to give maximally useful tracebacks. Because getting this right is not critical (you'll just get a slightly suboptimal traceback in the case of failure), we don't recommend bothering. However, we document it here because it's important to get it right in testthat itself. From 5e8f2ef3c89a2abcb056dbdb9c7d6d09628c9b56 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 1 Aug 2025 08:14:03 -0500 Subject: [PATCH 6/9] Rephrasing --- vignettes/custom-expectation.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/custom-expectation.Rmd b/vignettes/custom-expectation.Rmd index bc4ecf967..f6fe917f0 100644 --- a/vignettes/custom-expectation.Rmd +++ b/vignettes/custom-expectation.Rmd @@ -41,7 +41,7 @@ expect_length <- function(object, n) { The first step in any expectation is to use `quasi_label()` to capture a "labelled value", i.e. a list that contains both the value (`$val`) for testing and a label (`$lab`) for messaging. This is a pattern that exists for fairly esoteric reasons; you don't need to understand, just copy and paste it 🙂. -Next you need to check each way that `object` could be broken. In most cases, it's easier to check for problems one by one, using early returns to `fail()` when any expectation is violated as that makes it easier to write failure messages. It's good practice to state both what the object is and what you expected in your failures. +Next you need to check each way that `object` could violate the expectation. In this case, there's only one check, but in the more complicated cases that you'll see later there can be multiple checks. In most cases, it's easier to check for violations one by one, using early returns to `fail()`. This makes it easier to write informative failure messages that state both what the object is and what you expected. Also note that you need to use `return(fail())` here. You won't see the problem when interactively testing your function because when run outside of `test_that()`, `fail()` throws an error, causing the function to terminate early. When running inside of `test_that()`, however, `fail()` does not stop execution because we want to collect all failures in a given test. From df22a1b711e2c7a2994fc30970486192045e0b35 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 1 Aug 2025 08:18:32 -0500 Subject: [PATCH 7/9] A few more clarifications --- vignettes/custom-expectation.Rmd | 11 +++++++++-- 1 file changed, 9 insertions(+), 2 deletions(-) diff --git a/vignettes/custom-expectation.Rmd b/vignettes/custom-expectation.Rmd index f6fe917f0..4592cec95 100644 --- a/vignettes/custom-expectation.Rmd +++ b/vignettes/custom-expectation.Rmd @@ -95,7 +95,9 @@ To do this we'll add an extra check that the input is either an atomic vector or expect_vector_length <- function(object, n) { act <- quasi_label(rlang::enquo(object)) - if (!is.atomic(act$val) && !is.list(act$val)) { + # It's non-trivial to check if an object is a vector in base R so we + # use an rlang helper + if (!rlang::is_vector(act$val)) { msg <- sprintf("%s is a %s, not a vector", act$lab, typeof(act$val)) return(fail(msg)) } @@ -160,6 +162,7 @@ x3 <- factor() expect_s3_class(x1, "integer") expect_s3_class(x2, "integer") expect_s3_class(x3, "integer") +expect_s3_class(x3, "factor") ``` Note that I also check that the `class` argument must be a string. This is an error, not a failure, because it suggests you're using the function incorrectly. @@ -192,4 +195,8 @@ expect_length <- function(object, n) { } ``` -Note that the helper probably shouldn't be user facing, and we give it a `_` suffix to make that clear. It's also typically easiest for a helper to take the labelled value produced by `quasi_label()` rather than having to do that repeatedly. +A few recommendations: + +* The helper shouldn't be user facing, so we give it a `_` suffix to make that clear. +* It's typically easiest for a helper to take the labelled value produced by `quasi_label()`. +* Your helper should usually call both `fail()` and `pass()` and be returned from the wrapping expectation. From 3156d3141d198e41f89759b0e27ee382a1e1307b Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 1 Aug 2025 08:35:58 -0500 Subject: [PATCH 8/9] =?UTF-8?q?=E2=9C=A8=20Proofreading=20=E2=9C=A8?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- vignettes/custom-expectation.Rmd | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/vignettes/custom-expectation.Rmd b/vignettes/custom-expectation.Rmd index 4592cec95..ca786a9ef 100644 --- a/vignettes/custom-expectation.Rmd +++ b/vignettes/custom-expectation.Rmd @@ -11,12 +11,12 @@ vignette: > library(testthat) knitr::opts_chunk$set(collapse = TRUE, comment = "#>") -# Pretend we're snapsotting +# Pretend we're snapshotting snapper <- local_snapshotter(fail_on_new = FALSE) snapper$start_file("snapshotting.Rmd", "test") ``` -This vignette shows you how to write your expectations. You can use within your package by putting them in a helper file, or share them with others by exporting them from your package. +This vignette shows you how to write your own expectations. You can use them within your package by putting them in a helper file, or share them with others by exporting them from your package. ## Expectation basics @@ -27,21 +27,21 @@ expect_length <- function(object, n) { # 1. Capture object and label act <- quasi_label(rlang::enquo(object)) - # 2. Fail when expectations aren't met + # 2. Check if expectations are violated act_n <- length(act$val) if (act_n != n) { msg <- sprintf("%s has length %i, not length %i.", act$lab, act_n, n) return(fail(msg)) } - # 3. Pass when expectations are + # 3. Pass when expectations are met pass(act$val) } ``` -The first step in any expectation is to use `quasi_label()` to capture a "labelled value", i.e. a list that contains both the value (`$val`) for testing and a label (`$lab`) for messaging. This is a pattern that exists for fairly esoteric reasons; you don't need to understand, just copy and paste it 🙂. +The first step in any expectation is to use `quasi_label()` to capture a "labelled value", i.e. a list that contains both the value (`$val`) for testing and a label (`$lab`) for messaging. This is a pattern that exists for fairly esoteric reasons; you don't need to understand it, just copy and paste it 🙂. -Next you need to check each way that `object` could violate the expectation. In this case, there's only one check, but in the more complicated cases that you'll see later there can be multiple checks. In most cases, it's easier to check for violations one by one, using early returns to `fail()`. This makes it easier to write informative failure messages that state both what the object is and what you expected. +Next you need to check each way that `object` could violate the expectation. In this case, there's only one check, but in more complicated cases there can be multiple checks. In most cases, it's easier to check for violations one by one, using early returns to `fail()`. This makes it easier to write informative failure messages that state both what the object is and what you expected. Also note that you need to use `return(fail())` here. You won't see the problem when interactively testing your function because when run outside of `test_that()`, `fail()` throws an error, causing the function to terminate early. When running inside of `test_that()`, however, `fail()` does not stop execution because we want to collect all failures in a given test. @@ -83,7 +83,7 @@ The following sections show you a few more variations, loosely based on existing ### `expect_vector_length()` -Lets make `expect_length()` a bit more strict by also checking that the input is a vector. R is a bit weird that it gives a length to pretty much every object, and you can imagine not wanting this code to succeed: +Let's make `expect_length()` a bit more strict by also checking that the input is a vector. R is a bit weird in that it gives a length to pretty much every object, and you can imagine not wanting this code to succeed: ```{r} expect_length(mean, 1) @@ -120,7 +120,7 @@ expect_vector_length(mtcars, 15) ### `expect_s3_class()` -Or imagine if you're checking to see if an object inherits from an S3 class. In R, there's no direct way to tell if an object is an S3 object: you can confirm that it's an object, then that it's not an S4 object. So you might organise your expectation this way: +Or imagine if you're checking to see if an object inherits from an S3 class. In R, there's no direct way to tell if an object is an S3 object: you can confirm that it's an object, then that it's not an S4 object. So you might organize your expectation this way: ```{r} expect_s3_class <- function(object, class) { @@ -174,7 +174,7 @@ expect_s3_class(x1, 1) ## Repeated code -As you write more expectations, you might discover repeated code that you want to extract out in to a helper. Unfortunately creating helper functions is not straightforward in testthat because every `fail()` captures the calling environment in order to give maximally useful tracebacks. Because getting this right is not critical (you'll just get a slightly suboptimal traceback in the case of failure), we don't recommend bothering. However, we document it here because it's important to get it right in testthat itself. +As you write more expectations, you might discover repeated code that you want to extract out into a helper. Unfortunately, creating helper functions is not straightforward in testthat because every `fail()` captures the calling environment in order to give maximally useful tracebacks. Because getting this right is not critical (you'll just get a slightly suboptimal traceback in the case of failure), we don't recommend bothering. However, we document it here because it's important to get it right in testthat itself. The key challenge is that `fail()` captures a `trace_env` which should be the execution environment of the expectation. This usually works, because the default value of `trace_env` is `caller_env()`. But when you introduce a helper, you'll need to explicitly pass it along: From 2b552bdf117991c512ac8c7035eec5781c9ea010 Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Fri, 1 Aug 2025 08:38:30 -0500 Subject: [PATCH 9/9] Add news bullet --- NEWS.md | 1 + 1 file changed, 1 insertion(+) diff --git a/NEWS.md b/NEWS.md index 8eee24ce1..6da6fe6e6 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,6 @@ # testthat (development version) +* `vignette("custom-expectations)` has been overhauled to make it much clearer how to create high-quality expectations (#2113, #2132, #2072). * `expect_snapshot()` and friends will now fail when creating a new snapshot on CI. This is usually a signal that you've forgotten to run it locally before committing (#1461). * `expect_snapshot_value()` can now handle expressions that generate `-` (#1678) or zero length atomic vectors (#2042). * `expect_matches()` failures should be a little easier to read (#2135).