More expectation object tidying/refactoring

R/expectation.R

@@ -1,27 +1,24 @@
 #' The building block of all `expect_` functions
 #'
-#' Use this if you are writing your own expectation. See
+#' Call this function when writing your own expectations. See
 #' `vignette("custom-expectation")` for details.
 #'
-#' @param ok Was the expectation successful?
-#' @param failure_message What message should be shown if the expectation was
-#'   not successful?
-#' @param info Additional information. Included for backward compatibility
-#'   only and new expectations should not use it.
-#' @param srcref Only needed in very rare circumstances where you need to
-#'   forward a srcref captured elsewhere.
+#' @param ok `TRUE` or `FALSE` indicating if the expectation was successful.
+#' @param failure_message Message to show if the expectation failed.
+#' @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.
+#' @return An expectation object. Signals the expectation condition
+#'   with a `continue_test` restart.
 #' @export
 expect <- function(ok, failure_message, info = NULL, srcref = NULL) {
   type <- if (ok) "success" else "failure"
   message <- paste(c(failure_message, info), collapse = "\n")
   exp <- expectation(type, message, srcref = srcref)
 
   withRestarts(
-    if (expectation_broken(exp)) {
-      stop(exp)
-    } else {
-      signalCondition(exp)
-    },
+    if (ok) signalCondition(exp) else stop(exp),
     continue_test = function(e) NULL
   )
 
@@ -31,7 +28,7 @@ expect <- function(ok, failure_message, info = NULL, srcref = NULL) {
 #' Construct an expectation object
 #'
 #' For advanced use only. If you are creating your own expectation, you should
-#' call `expect()` instead. See `vignette("custom-expectation")` for more
+#' call [expect()] instead. See `vignette("custom-expectation")` for more
 #' details.
 #'
 #' @param type Expectation type. Must be one of "success", "failure", "error",
@@ -63,39 +60,27 @@ expectation <- function(type, message, srcref = NULL) {
 #' @param x object to test for class membership
 is.expectation <- function(x) inherits(x, "expectation")
 
-expectation_type <- function(exp) {
-  stopifnot(is.expectation(exp))
-  gsub("^expectation_", "", class(exp)[[1]])
-}
-
-expectation_success <- function(exp) {
-  expectation_type(exp) == "success"
-}
-
-expectation_failure <- function(exp) {
-  expectation_type(exp) == "failure"
-}
-
-expectation_error <- function(exp) {
-  expectation_type(exp) == "error"
+#' @export
+print.expectation <- function(x, ...) {
+  cat(format(x), "\n")
 }
 
-expectation_skip <- function(exp) {
-  expectation_type(exp) == "skip"
+#' @export
+format.expectation_success <- function(x, ...) {
+  "As expected"
 }
 
-expectation_warning <- function(exp) {
-  expectation_type(exp) == "warning"
+#' @export
+format.expectation_error <- function(x, ...) {
+  paste(c(x$message, create_traceback(x$call)), collapse = "\n")
 }
 
-expectation_broken <- function(exp) {
-  expectation_failure(exp) || expectation_error(exp)
-}
-expectation_ok <- function(exp) {
-  expectation_type(exp) %in% c("success", "warning")
+#' @export
+format.expectation <- function(x, ...) {
+  x$message
 }
 
-
+# as.expectation ----------------------------------------------------------
 
 as.expectation <- function(x, ...) UseMethod("as.expectation", x)
 
@@ -109,9 +94,7 @@ as.expectation.default <- function(x, ..., srcref = NULL) {
 
 #' @export
 as.expectation.expectation <- function(x, ..., srcref = NULL) {
-  if (is.null(x$srcref)) {
-    x$srcref <- srcref
-  }
+  x$srcref <- x$srcref %||% srcref
   x
 }
 
@@ -120,51 +103,36 @@ as.expectation.error <- function(x, ..., srcref = NULL) {
   error <- x$message
 
   msg <- gsub("Error.*?: ", "", as.character(error))
-
-  # Need to remove trailing newline from error message to be consistent
-  # with other messages
+  # Remove trailing newline to be consistent with other conditons
   msg <- gsub("\n$", "", msg)
 
   expectation("error", msg, srcref)
 }
 
 #' @export
 as.expectation.warning <- function(x, ..., srcref = NULL) {
-  msg <- x$message
-
-  # msg <- gsub("Error.*?: ", "", as.character(error))
-  # msg <- gsub("\n$", "", msg)
-
-  expectation("warning", msg, srcref)
+  expectation("warning", x$message, srcref)
 }
 
 #' @export
 as.expectation.skip <- function(x, ..., srcref = NULL) {
-  error <- x$message
-  msg <- gsub("Error.*?: ", "", as.character(error))
-
-  expectation("skip", msg, srcref)
-}
-
-#' @export
-print.expectation <- function(x, ...) {
-  cat(format(x), "\n")
+  expectation("skip", x$message, srcref)
 }
 
-#' @export
-format.expectation_success <- function(x, ...) {
-  "As expected"
-}
+# expectation_type --------------------------------------------------------
 
-#' @export
-format.expectation_error <- function(x, ...) {
-  paste(c(x$message, create_traceback(x$call)), collapse = "\n")
+expectation_type <- function(exp) {
+  stopifnot(is.expectation(exp))
+  gsub("^expectation_", "", class(exp)[[1]])
 }
 
-#' @export
-format.expectation <- function(x, ...) {
-  x$message
-}
+expectation_success <- function(exp) expectation_type(exp) == "success"
+expectation_failure <- function(exp) expectation_type(exp) == "failure"
+expectation_error   <- function(exp) expectation_type(exp) == "error"
+expectation_skip    <- function(exp) expectation_type(exp) == "skip"
+expectation_warning <- function(exp) expectation_type(exp) == "warning"
+expectation_broken  <- function(exp) expectation_failure(exp) || expectation_error(exp)
+expectation_ok      <- function(exp) expectation_type(exp) %in% c("success", "warning")
 
 single_letter_summary <- function(x) {
   switch(expectation_type(x),

vignettes/custom-expectation.Rmd

@@ -21,7 +21,7 @@ There are three main parts to writing an expectation, as illustrated by `expect_
 ```{r}
 expect_length <- function(object, n) {
   # 1. Capture object and label
-  act <- quasi_label(rlang::enquo(object))
+  act <- quasi_label(rlang::enquo(object), arg = "object")
 
   # 2. Call expect()
   act$n <- length(act$val)
@@ -37,7 +37,7 @@ expect_length <- function(object, n) {
 
 ## Quasi-labelling
 
-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 supporting 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.
+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.
 
 By convention, the first argument to every `expect_` function is called `object`, and you capture it's value (`val`) and label (`lab`) with `act <- quasi_label(enquo(object))`, where `act` is short for actual.
 
@@ -68,6 +68,25 @@ mtcars %>%
   expect_length(11)
 ```
 
+## `suceed()` and `fail()`
+
+For expectations with more complex logic governing when success or failure occurs, you can use `succeed()` and `fail()`. These are simple wrappers around `expect()` that allow you to write code that looks like this:
+
+```{r}
+expect_length <- function(object, n) {
+  act <- quasi_label(rlang::enquo(object), arg = "object")
+
+  act$n <- length(act$val)
+  if (act$n == n) {
+    succeed()
+    invisible(act$val)
+  }
+  
+  message <- sprintf("%s has length %i, not length %i.", act$lab, act$n, n)
+  fail(message)
+}
+```
+
 ## Testing your expectations
 
 Use the expectations `expect_success()` and `expect_failure()` to test your expectation.