Always return() on failure

Author: hadley

R/expect-comparison.R

@@ -42,7 +42,7 @@ expect_compare <- function(operator = c("<", "<=", ">", ">="), act, exp) {
       exp$lab,
       act$val - exp$val
     )
-    fail(msg, trace_env = caller_env())
+    return(fail(msg, trace_env = caller_env()))
   }
   pass(act$val)
 }

R/expect-condition.R

@@ -139,7 +139,7 @@ expect_error <- function(
     # Access error fields with `[[` rather than `$` because the
     # `$.Throwable` from the rJava package throws with unknown fields
     if (!is.null(msg)) {
-      fail(msg, info = info, trace = act$cap[["trace"]])
+      return(fail(msg, info = info, trace = act$cap[["trace"]]))
     }
     pass(act$val %||% act$cap)
   }
@@ -189,7 +189,7 @@ expect_warning <- function(
       cond_type = "warnings"
     )
     if (!is.null(msg)) {
-      fail(msg, info = info)
+      return(fail(msg, info = info))
     }
     pass(act$val)
   }
@@ -222,7 +222,7 @@ 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)) {
-      fail(msg, info = info)
+      return(fail(msg, info = info))
     }
     pass(act$val)
   }
@@ -267,7 +267,7 @@ expect_condition <- function(
       cond_type = "condition"
     )
     if (!is.null(msg)) {
-      fail(msg, info = info, trace = act$cap[["trace"]])
+      return(fail(msg, info = info, trace = act$cap[["trace"]]))
     }
     pass(act$val %||% act$cap)
   }
@@ -308,7 +308,7 @@ 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)) {
-    fail(msg, info = info, trace = act$cap[["trace"]], trace_env = trace_env)
+    return(fail(msg, info = info, trace = act$cap[["trace"]], trace_env = trace_env))
   }
   # If a condition was expected, return it. Otherwise return the value
   # of the expression.

R/expect-constant.R

@@ -77,7 +77,7 @@ expect_waldo_constant <- function(act, constant, info, ...) {
       deparse(constant),
       paste0(comp, collapse = "\n\n")
     )
-    fail(msg, info = info, trace_env = caller_env())
+    return(fail(msg, info = info, trace_env = caller_env()))
   }
 
   pass(act$val)

R/expect-equality.R

@@ -77,7 +77,7 @@ expect_equal <- function(
 
     if (!comp$equal) {
       msg <- sprintf("%s not equal to %s.\n%s", act$lab, exp$lab, comp$message)
-      fail(msg, info = info)
+      return(fail(msg, info = info))
     }
     pass(act$val)
   }
@@ -113,7 +113,7 @@ expect_identical <- function(
 
     if (!ident) {
       msg <- sprintf("%s not identical to %s.\n%s", act$lab, exp$lab, msg)
-      fail(msg, info = info)
+      return(fail(msg, info = info))
     }
     pass(act$val)
   }
@@ -137,7 +137,7 @@ expect_waldo_equal <- function(type, act, exp, info, ...) {
       "`expected`",
       paste0(comp, collapse = "\n\n")
     )
-    fail(msg, info = info, trace_env = caller_env())
+    return(fail(msg, info = info, trace_env = caller_env()))
   }
   pass(act$val)
 }
@@ -190,7 +190,7 @@ expect_equivalent <- function(
       exp$lab,
       comp$message
     )
-    fail(msg, info = info)
+    return(fail(msg, info = info))
   }
   pass(act$val)
 }
@@ -226,7 +226,7 @@ expect_reference <- function(
 
   if (!is_reference(act$val, exp$val)) {
     msg <- sprintf("%s not a reference to %s.", act$lab, exp$lab)
-    fail(msg, info = info)
+    return(fail(msg, info = info))
   }
   pass(act$val)
 }

R/expect-inheritance.R

@@ -58,7 +58,7 @@ expect_type <- function(object, type) {
       format_class(act_type),
       format_class(type)
     )
-    fail(msg)
+    return(fail(msg))
   }
   pass(act$val)
 }
@@ -76,15 +76,15 @@ expect_s3_class <- function(object, class, exact = FALSE) {
   if (identical(class, NA)) {
     if (isS3(object)) {
       msg <- sprintf("%s is an S3 object", act$lab)
-      fail(msg)
+      return(fail(msg))
     }
   } else if (is.character(class)) {
     if (!isS3(act$val)) {
-      fail(sprintf("%s is not an S3 object", act$lab))
+      return(fail(sprintf("%s is not an S3 object", act$lab)))
     } else if (exact) {
       if (!identical(class(act$val), class)) {
         msg <- sprintf("%s has class %s, not %s.", act$lab, act$class, exp_lab)
-        fail(msg)
+        return(fail(msg))
       }
     } else {
       if (!inherits(act$val, class)) {
@@ -94,7 +94,7 @@ expect_s3_class <- function(object, class, exact = FALSE) {
           act$class,
           exp_lab
         )
-        fail(msg)
+        return(fail(msg))
       }
     }
   } else {
@@ -115,7 +115,7 @@ expect_s7_class <- function(object, class) {
   act <- quasi_label(enquo(object), arg = "object")
 
   if (!S7::S7_inherits(object)) {
-    fail(sprintf("%s is not an S7 object", act$lab))
+    return(fail(sprintf("%s is not an S7 object", act$lab)))
   }
 
   if (!S7::S7_inherits(object, class)) {
@@ -127,7 +127,7 @@ expect_s7_class <- function(object, class) {
       class_desc,
       attr(class, "name", TRUE)
     )
-    fail(msg)
+    return(fail(msg))
   }
 
   pass(act$val)
@@ -143,11 +143,11 @@ expect_s4_class <- function(object, class) {
   if (identical(class, NA)) {
     if (!(isS4(object) == !is.na(class))) {
       msg <- sprintf("%s is an S4 object", act$lab)
-      fail(msg)
+      return(fail(msg))
     }
   } else if (is.character(class)) {
     if (!isS4(act$val)) {
-      fail(sprintf("%s is not an S4 object", act$lab))
+      return(fail(sprintf("%s is not an S4 object", act$lab)))
     } else {
       if (!methods::is(act$val, class)) {
         msg <- sprintf(
@@ -156,7 +156,7 @@ expect_s4_class <- function(object, class) {
           act$class,
           exp_lab
         )
-        fail(msg)
+        return(fail(msg))
       }
     }
   } else {
@@ -205,7 +205,7 @@ expect_is <- function(object, class, info = NULL, label = NULL) {
       act$class,
       exp_lab
     )
-    fail(msg, info = info)
+    return(fail(msg, info = info))
   }
   pass(act$val)
 }

R/expect-invisible.R

@@ -26,7 +26,7 @@ expect_invisible <- function(call, label = NULL) {
 
   if (!identical(vis$visible, FALSE)) {
     msg <- sprintf("%s returns visibly, not invisibly.", lab)
-    fail(msg)
+    return(fail(msg))
   }
   pass(vis$value)
 }
@@ -39,7 +39,7 @@ expect_visible <- function(call, label = NULL) {
 
   if (!identical(vis$visible, TRUE)) {
     msg <- sprintf("%s returns invisibly, not visibly.", lab)
-    fail(msg)
+    return(fail(msg))
   }
   pass(vis$value)
 }

R/expect-known.R

@@ -104,7 +104,7 @@ compare_file <- function(path, lines, ..., update = TRUE, info = NULL) {
       encodeString(path, quote = "'"),
       paste0(comp, collapse = "\n\n")
     )
-    fail(msg, info = info, trace_env = caller_env())
+    return(fail(msg, info = info, trace_env = caller_env()))
   }
   pass(NULL)
 }
@@ -183,7 +183,7 @@ expect_known_value <- function(
         encodeString(file, quote = "'"),
         comp$message
       )
-      fail(msg, info = info)
+      return(fail(msg, info = info))
     }
   }
 
@@ -225,7 +225,7 @@ expect_known_hash <- function(object, hash = NULL) {
   } else {
     if (hash != act_hash) {
       msg <- sprintf("Value hashes to %s, not %s", act_hash, hash)
-      fail(msg)
+      return(fail(msg))
     }
   }
 

R/expect-length.R

@@ -25,7 +25,7 @@ expect_length_impl_ <- function(act, n) {
 
   if (act$n != n) {
     msg <- sprintf("%s has length %i, not length %i.", act$lab, act$n, n)
-    fail(msg, trace_env = parent.frame())
+    return(fail(msg, trace_env = parent.frame()))
   }
   pass(act$val)
 }

R/expect-named.R

@@ -38,7 +38,7 @@ expect_named <- function(
   if (missing(expected)) {
     if (identical(act$names, NULL)) {
       msg <- sprintf("%s does not have names.", act$lab)
-      fail(msg)
+      return(fail(msg))
     }
   } else {
     exp_names <- normalise_names(expected, ignore.order, ignore.case)
@@ -51,7 +51,7 @@ expect_named <- function(
         paste0("'", act$names, "'", collapse = ", "),
         paste0("'", exp_names, "'", collapse = ", ")
       )
-      fail(msg, info = info)
+      return(fail(msg, info = info))
     }
   }
   pass(act$val)

R/expect-no-condition.R

@@ -112,7 +112,7 @@ expect_no_ <- function(
           indent_lines(rlang::cnd_message(cnd))
         )
         message <- format_error_bullets(c(expected, i = actual))
-        fail(message, trace_env = trace_env)
+        return(fail(message, trace_env = trace_env))
       }
     )
   }