Make succeed()/failure() primary (#2125)

Instead of `expect()`. I think this makes the reasoning a little easier to follow, and will support the transition away from `expect()`. Now used in the vignette, but not yet in testthat itself; that's the next job.

Author: hadley

NAMESPACE

@@ -164,6 +164,7 @@ export(make_expectation)
 export(mock_output_sequence)
 export(new_expectation)
 export(not)
+export(pass)
 export(prints_text)
 export(quasi_label)
 export(run_cpp_tests)

NEWS.md

@@ -1,5 +1,7 @@
 # testthat (development version)
 
+* New `pass()` function to use in place of `succeed()` (#2113).
+* `expectation()` is now a combination of `new_expectation()` and `exp_signal()` (#2125).
 * `is_null()`/`matches()` deprecated in 2.0.0 (2017-12-19) and `is_true()`/`is_false()` deprecated in 2.1.0 (2019-04-23) have been removed (#2109).
 * `local_edition()` now gives a useful error for bad values (#1547).
 * testthat now requires R 4.1.

R/expect-that.R

@@ -36,14 +36,24 @@ expect_that <- function(object, condition, info = NULL, label = NULL) {
   condition(object)
 }
 
-#' Default expectations that always succeed or fail.
+#' `pass()` or `fail()` a test
 #'
-#' These allow you to manually trigger success or failure. Failure is
-#' particularly useful to a pre-condition or mark a test as not yet
-#' implemented.
+#' @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")`.
 #'
 #' @param message a string to display.
-#' @inheritParams expect
+#' @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 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.
 #' @export
 #' @examples
 #' \dontrun{
@@ -53,13 +63,41 @@ expect_that <- function(object, condition, info = NULL, label = NULL) {
 fail <- function(
   message = "Failure has been forced",
   info = NULL,
-  trace_env = caller_env()
+  srcref = NULL,
+  trace_env = caller_env(),
+  trace = NULL
 ) {
-  expect(FALSE, message, info = info, trace_env = trace_env)
+  if (is.null(trace)) {
+    trace <- trace_back(top = getOption("testthat_topenv"), bottom = trace_env)
+  }
+  # Only show if there's at least one function apart from the expectation
+  if (trace_length(trace) <= 1) {
+    trace <- NULL
+  }
+
+  message <- paste(c(message, info), collapse = "\n")
+  expectation("failure", message, srcref = srcref, trace = trace)
 }
 
 #' @rdname fail
+#' @param value Value to return, typically the result of evaluating the
+#'   `object` argument to the expectation.
 #' @export
+pass <- function(value) {
+  expectation("success", "success")
+  invisible(value)
+}
+
+#' Mark a test as successful
+#'
+#' This is an older version of [pass()] that exists for backwards compatibility.
+#' You should now use `pass()` instead`
+#'
+#' @export
+#' @inheritParams fail
+#' @keywords internal
 succeed <- function(message = "Success has been forced", info = NULL) {
-  expect(TRUE, message, info = info)
+  message <- paste(c(message, info), collapse = "\n")
+
+  expectation("success", message)
 }

R/expectation.R

@@ -5,34 +5,9 @@
 #'
 #' @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.
-#' @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.
-#' @return An expectation object. Signals the expectation condition
+#' @inheritParams fail
+#' @return An expectation object from either `succeed()` or `fail()`.
 #'   with a `continue_test` restart.
-#'
-#' @details
-#'
-#' While `expect()` creates and signals an expectation in one go,
-#' `exp_signal()` separately signals an expectation that you
-#' have manually created with [new_expectation()]. Expectations are
-#' signalled with the following protocol:
-#'
-#' * If the expectation is a failure or an error, it is signalled with
-#'   [base::stop()]. Otherwise, it is signalled with
-#'   [base::signalCondition()].
-#'
-#' * The `continue_test` restart is registered. When invoked, failing
-#'   expectations are ignored and normal control flow is resumed to
-#'   run the other tests.
-#'
 #' @seealso [exp_signal()]
 #' @export
 expect <- function(
@@ -43,58 +18,39 @@ expect <- function(
   trace = NULL,
   trace_env = caller_env()
 ) {
-  type <- if (ok) "success" else "failure"
-
-  # Preserve existing API which appear to be used in package test code
-  # Can remove in next major release
-  if (missing(failure_message)) {
-    warn("`failure_message` is missing, with no default.")
-    message <- "unknown failure"
+  if (ok) {
+    succeed(failure_message)
   } else {
-    # A few packages include code in info that errors on evaluation
-    if (ok) {
-      message <- paste(failure_message, collapse = "\n")
-    } else {
-      message <- paste(c(failure_message, info), collapse = "\n")
-    }
-  }
-
-  if (!ok) {
-    if (is.null(trace)) {
-      trace <- trace_back(
-        top = getOption("testthat_topenv"),
-        bottom = trace_env
-      )
-    }
-
-    # Only show if there's at least one function apart from the expectation
-    if (trace_length(trace) <= 1) {
-      trace <- NULL
-    }
+    fail(
+      failure_message,
+      info,
+      srcref = srcref,
+      trace = trace,
+      trace_env = trace_env
+    )
   }
-
-  exp <- expectation(type, message, srcref = srcref, trace = trace)
-  exp_signal(exp)
 }
 
-
 #' Construct an expectation object
 #'
+#' @description
 #' For advanced use only. If you are creating your own expectation, you should
-#' call [expect()] instead. See `vignette("custom-expectation")` for more
+#' call [pass()] or [fail()]. See `vignette("custom-expectation")` for more
 #' details.
 #'
-#' Create an expectation with `expectation()` or `new_expectation()`
-#' and signal it with `exp_signal()`.
+#' `new_expectation()` creates an expectation object and `exp_signal()` signals
+#' it. `expectation()` does both.
 #'
 #' @param type Expectation type. Must be one of "success", "failure", "error",
 #'   "skip", "warning".
 #' @param message Message describing test failure
 #' @param srcref Optional `srcref` giving location of test.
+#' @keywords internal
 #' @inheritParams expect
 #' @export
 expectation <- function(type, message, srcref = NULL, trace = NULL) {
-  new_expectation(type, message, srcref = srcref, trace = trace)
+  exp <- new_expectation(type, message, srcref = srcref, trace = trace)
+  exp_signal(exp)
 }
 #' @rdname expectation
 #' @param ... Additional attributes for the expectation object.
@@ -207,7 +163,7 @@ as.expectation.error <- function(x, srcref = NULL) {
     cnd_message(x)
   )
 
-  expectation("error", msg, srcref, trace = x[["trace"]])
+  new_expectation("error", msg, srcref = srcref, trace = x[["trace"]])
 }
 
 
@@ -217,12 +173,17 @@ is_simple_error <- function(x) {
 
 #' @export
 as.expectation.warning <- function(x, srcref = NULL) {
-  expectation("warning", cnd_message(x), srcref, trace = x[["trace"]])
+  new_expectation(
+    "warning",
+    cnd_message(x),
+    srcref = srcref,
+    trace = x[["trace"]]
+  )
 }
 
 #' @export
 as.expectation.skip <- function(x, ..., srcref = NULL) {
-  expectation("skip", cnd_message(x), srcref, trace = x[["trace"]])
+  new_expectation("skip", cnd_message(x), srcref = srcref, trace = x[["trace"]])
 }
 
 #' @export

R/test-compiled-code.R

@@ -60,7 +60,7 @@ run_cpp_tests <- function(package) {
       reporter$add_result(
         context = "Catch",
         test = "Catch",
-        result = expectation("failure", e$message)
+        result = new_expectation("failure", e$message)
       )
       reporter$end_test(context = "Catch", test = "Catch")
     }
@@ -89,7 +89,7 @@ run_cpp_tests <- function(package) {
       get_reporter()$start_test(context = context_name, test = test_name)
 
       for (i in seq_len(successes)) {
-        exp <- expectation("success", "")
+        exp <- new_expectation("success", "")
         exp$test <- test_name
         get_reporter()$add_result(
           context = context_name,
@@ -122,7 +122,7 @@ run_cpp_tests <- function(package) {
           c(line, line, 1, 1)
         )
 
-        exp <- expectation("failure", org_text, srcref = failure_srcref)
+        exp <- new_expectation("failure", org_text, srcref = failure_srcref)
         exp$test <- test_name
 
         get_reporter()$add_result(
@@ -143,7 +143,7 @@ run_cpp_tests <- function(package) {
           c(line, line, 1, 1)
         )
 
-        exp <- expectation("error", exception_text, srcref = exception_srcref)
+        exp <- new_expectation("error", exception_text, srcref = exception_srcref)
         exp$test <- test_name
 
         get_reporter()$add_result(

R/test-that.R

@@ -141,7 +141,7 @@ test_code <- function(test, code, env, reporter, skip_on_empty = TRUE) {
   }
   handle_expectation <- function(e) {
     handled <<- TRUE
-    register_expectation(e, 6)
+    register_expectation(e, 7)
     invokeRestart("continue_test")
   }
   handle_warning <- function(e) {

_pkgdown.yml

@@ -78,7 +78,6 @@ reference:
 - title: Expectation internals
   contents:
   - expect
-  - expectation
   - fail
   - expect_success