Improved composition (#2250)

Rework expectations to call `pass()` and `fail()` purely for their side-effects, and then ensure that every expectation returns the first argument invisibly.

Fixes #2246

Author: hadley

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* Expectations now consistently return the value of the first argument, regardless of whether the expectation succeeds or fails. The primary exception are `expect_message()` and friends which will return the condition. This shouldn't affect existing tests, but will make failures clearer when you chain together multiple expectations (#2246).
 * `set_state_inspector()` gains `tolerance` argument and ignores minor FP differences by default (@mcol, #2237).
 * `expect_vector()` fails, instead of erroring, if `object` is not a vector (@plietar, #2224).
 * New `vignette("mocking")` explains mocking in detail (#1265).

R/expect-comparison.R

@@ -28,52 +28,60 @@ expect_compare_ <- function(
   operator <- match.arg(operator)
   op <- match.fun(operator)
 
-  actual_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
-
   cmp <- op(act$val, exp$val)
   if (length(cmp) != 1 || !is.logical(cmp)) {
     cli::cli_abort(
-      "Result of comparison must be a single logical value.",
+      "Result of comparison must be `TRUE`, `FALSE`, or `NA`",
       call = trace_env
     )
+  } else if (!isTRUE(cmp)) {
+    msg <- failure_compare(act, exp, operator)
+    fail(msg, trace_env = trace_env)
+  } else {
+    pass()
   }
-  if (!isTRUE(cmp)) {
-    diff <- act$val - exp$val
-    msg_exp <- sprintf("Expected %s %s %s.", act$lab, operator, exp$lab)
-
-    digits <- max(
-      digits(act$val),
-      digits(exp$val),
-      min_digits(act$val, exp$val)
-    )
+}
 
-    msg_act <- sprintf(
-      "Actual comparison: %s %s %s",
-      num_exact(act$val, digits),
-      actual_op,
-      num_exact(exp$val, digits)
-    )
+failure_compare <- function(act, exp, operator) {
+  actual_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
 
-    if (is.na(diff)) {
-      msg_diff <- NULL
-    } else {
-      msg_diff <- sprintf(
-        "Difference: %s %s 0",
-        num_exact(diff, digits),
-        actual_op
-      )
-    }
-    return(fail(c(msg_exp, msg_act, msg_diff), trace_env = trace_env))
+  diff <- act$val - exp$val
+  msg_exp <- sprintf("Expected %s %s %s.", act$lab, operator, exp$lab)
+
+  digits <- max(
+    digits(act$val),
+    digits(exp$val),
+    min_digits(act$val, exp$val)
+  )
+
+  msg_act <- sprintf(
+    "Actual comparison: %s %s %s",
+    num_exact(act$val, digits),
+    actual_op,
+    num_exact(exp$val, digits)
+  )
+
+  if (is.na(diff)) {
+    msg_diff <- NULL
+  } else {
+    msg_diff <- sprintf(
+      "Difference: %s %s 0",
+      num_exact(diff, digits),
+      actual_op
+    )
   }
-  pass(act$val)
+
+  c(msg_exp, msg_act, msg_diff)
 }
+
 #' @export
 #' @rdname comparison-expectations
 expect_lt <- function(object, expected, label = NULL, expected.label = NULL) {
   act <- quasi_label(enquo(object), label)
   exp <- quasi_label(enquo(expected), expected.label)
 
   expect_compare_("<", act, exp)
+  invisible(act$val)
 }
 
 #' @export
@@ -83,6 +91,7 @@ expect_lte <- function(object, expected, label = NULL, expected.label = NULL) {
   exp <- quasi_label(enquo(expected), expected.label)
 
   expect_compare_("<=", act, exp)
+  invisible(act$val)
 }
 
 #' @export
@@ -92,6 +101,7 @@ expect_gt <- function(object, expected, label = NULL, expected.label = NULL) {
   exp <- quasi_label(enquo(expected), expected.label)
 
   expect_compare_(">", act, exp)
+  invisible(act$val)
 }
 
 #' @export
@@ -101,6 +111,7 @@ expect_gte <- function(object, expected, label = NULL, expected.label = NULL) {
   exp <- quasi_label(enquo(expected), expected.label)
 
   expect_compare_(">=", act, exp)
+  invisible(act$val)
 }
 
 

R/expect-condition.R

@@ -143,9 +143,11 @@ expect_error <- function(
     # Access error fields with `[[` rather than `$` because the
     # `$.Throwable` from the rJava package throws with unknown fields
     if (!is.null(msg)) {
-      return(fail(msg, info = info, trace = act$cap[["trace"]]))
+      fail(msg, info = info, trace = act$cap[["trace"]])
+    } else {
+      pass()
     }
-    pass(act$val %||% act$cap)
+    invisible(act$val %||% act$cap)
   }
 }
 
@@ -198,9 +200,11 @@ expect_warning <- function(
       cond_type = "warnings"
     )
     if (!is.null(msg)) {
-      return(fail(msg, info = info))
+      fail(msg, info = info)
+    } else {
+      pass()
     }
-    pass(act$val)
+    invisible(act$val)
   }
 }
 
@@ -236,9 +240,11 @@ expect_message <- function(
     act <- quasi_capture(enquo(object), label, capture_messages)
     msg <- compare_messages(act$cap, act$lab, regexp = regexp, all = all, ...)
     if (!is.null(msg)) {
-      return(fail(msg, info = info))
+      fail(msg, info = info)
+    } else {
+      pass()
     }
-    pass(act$val)
+    invisible(act$val)
   }
 }
 
@@ -285,9 +291,11 @@ expect_condition <- function(
       cond_type = "condition"
     )
     if (!is.null(msg)) {
-      return(fail(msg, info = info, trace = act$cap[["trace"]]))
+      fail(msg, info = info, trace = act$cap[["trace"]])
+    } else {
+      pass()
     }
-    pass(act$val %||% act$cap)
+    invisible(act$val %||% act$cap)
   }
 }
 
@@ -327,16 +335,18 @@ expect_condition_matching_ <- function(
   # Access error fields with `[[` rather than `$` because the
   # `$.Throwable` from the rJava package throws with unknown fields
   if (!is.null(msg)) {
-    return(fail(
+    fail(
       msg,
       info = info,
       trace = act$cap[["trace"]],
       trace_env = trace_env
-    ))
+    )
+  } else {
+    pass()
   }
   # If a condition was expected, return it. Otherwise return the value
   # of the expression.
-  pass(if (expected) act$cap else act$val)
+  invisible(if (expected) act$cap else act$val)
 }
 
 # -------------------------------------------------------------------------

R/expect-constant.R

@@ -31,15 +31,19 @@ NULL
 expect_true <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label)
   exp <- labelled_value(TRUE, "TRUE")
+
   expect_waldo_constant_(act, exp, info = info, ignore_attr = TRUE)
+  invisible(act$val)
 }
 
 #' @export
 #' @rdname logical-expectations
 expect_false <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label)
   exp <- labelled_value(FALSE, "FALSE")
+
   expect_waldo_constant_(act, exp, info = info, ignore_attr = TRUE)
+  invisible(act$val)
 }
 
 #' Do you expect `NULL`?
@@ -59,7 +63,9 @@ expect_false <- function(object, info = NULL, label = NULL) {
 expect_null <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label)
   exp <- labelled_value(NULL, "NULL")
+
   expect_waldo_constant_(act, exp, info = info)
+  invisible(act$val)
 }
 
 expect_waldo_constant_ <- function(
@@ -82,7 +88,8 @@ expect_waldo_constant_ <- function(
       "Differences:",
       paste0(comp, collpase = "\n")
     )
-    return(fail(msg, info = info, trace_env = trace_env))
+    fail(msg, info = info, trace_env = trace_env)
+  } else {
+    pass()
   }
-  pass(act$val)
 }

R/expect-equality.R

@@ -76,16 +76,18 @@ expect_equal <- function(
       comp <- compare(act$val, exp$val, ...)
     }
 
-    if (!comp$equal) {
+    if (comp$equal) {
+      pass()
+    } else {
       msg <- c(
         sprintf("Expected %s to equal %s.", act$lab, exp$lab),
         "Differences:",
         comp$message
       )
-      return(fail(msg, info = info))
+      fail(msg, info = info)
     }
-    pass(act$val)
   }
+  invisible(act$val)
 }
 
 
@@ -105,28 +107,25 @@ expect_identical <- function(
   if (edition_get() >= 3) {
     expect_waldo_equal_("identical", act, exp, info, ...)
   } else {
-    ident <- identical(act$val, exp$val, ...)
-    if (ident) {
-      msg_act <- NULL
+    if (identical(act$val, exp$val, ...)) {
+      pass()
     } else {
       compare <- compare(act$val, exp$val)
       if (compare$equal) {
         msg_act <- "Objects equal but not identical"
       } else {
         msg_act <- compare$message
       }
-    }
 
-    if (!ident) {
       msg <- c(
         sprintf("Expected %s to be identical to %s.", act$lab, exp$lab),
         "Differences:",
         msg_act
       )
-      return(fail(msg, info = info))
+      fail(msg, info = info)
     }
-    pass(act$val)
   }
+  invisible(act$val)
 }
 
 expect_waldo_equal_ <- function(
@@ -144,15 +143,16 @@ expect_waldo_equal_ <- function(
     x_arg = "actual",
     y_arg = "expected"
   )
-  if (length(comp) != 0) {
+  if (length(comp) == 0) {
+    pass()
+  } else {
     msg <- c(
       sprintf("Expected %s to be %s to %s.", act$lab, type, exp$lab),
       "Differences:",
       paste0(comp, collpase = "\n")
     )
-    return(fail(msg, info = info, trace_env = trace_env))
+    fail(msg, info = info, trace_env = trace_env)
   }
-  pass(act$val)
 }
 
 #' Is an object equal to the expected value, ignoring attributes?
@@ -203,7 +203,9 @@ expect_equivalent <- function(
       exp$lab,
       comp$message
     )
-    return(fail(msg, info = info))
+    fail(msg, info = info)
+  } else {
+    pass()
   }
-  pass(act$val)
+  invisible(act$val)
 }