Merged origin/main into stibu81-main

Author: hadley

DESCRIPTION

@@ -57,4 +57,4 @@ Config/testthat/parallel: true
 Config/testthat/start-first: watcher, parallel*
 Encoding: UTF-8
 Roxygen: list(markdown = TRUE, r6 = FALSE)
-RoxygenNote: 7.3.2
+RoxygenNote: 7.3.3

NAMESPACE

@@ -79,6 +79,9 @@ export(equals_reference)
 export(evaluate_promise)
 export(exp_signal)
 export(expect)
+export(expect_all_equal)
+export(expect_all_false)
+export(expect_all_true)
 export(expect_condition)
 export(expect_contains)
 export(expect_cpp_tests_pass)

NEWS.md

@@ -1,11 +1,15 @@
 # testthat (development version)
 
 * New `expect_disjoint()` to check for the absence of values (#1851).
+* `expect_all_equal()`, `expect_all_true()`, and `expect_all_false()` are a new family of expectations that checks that every element of a vector has the same value. Compared to using `expect_true(all(...))` they give better failure messages (#1836, #2235).
+* 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).
 * New `vignette("challenging-functions")` provides an index to other documentation organised by testing challenges (#1265).
-* When running a test interactively, testthat now reports the number of succeses. The results should also be more useful if you are using nested tests.
-* The hints generated by `expect_snapshot()` and `expect_snapshot_file()` now include the path to the package, if its not in the current working directory (#1577).
-* `expect_snapshot_file()` now clearly errors if the `path` doesnt exist (#2191).
+* When running a test interactively, testthat now reports the number of successes. The results should also be more useful if you are using nested tests.
+* The hints generated by `expect_snapshot()` and `expect_snapshot_file()` now include the path to the package, if it's not in the current working directory (#1577).
+* `expect_snapshot_file()` now clearly errors if the `path` doesn't exist (#2191).
 * `expect_snapshot_file()` now considers `.json` to be a text file (#1593).
 * `expect_snapshot_file()` now shows differences for text files (#1593).
 * The failure messages for all `expect_` functions have been rewritten to first state what was expected and then what was actually received (#2142).
@@ -15,21 +19,20 @@
 * New `snapshot_download_gh()` makes it easy to get snapshots off GitHub and into your local package (#1779).
 * New `local_mocked_s3_method()`, `local_mocked_s4_method()`, and `local_mocked_r6_class()` allow you to mock S3 and S4 methods and R6 classes (#1892, #1916)
 * `expect_snapshot_file(name=)` must have a unique file path. If a snapshot file attempts to be saved with a duplicate `name`, an error will be thrown. (#1592)
-* `test_dir()`, `test_file()`, `test_package()`, `test_check()`, `test_local()`, `source_file()` gain a `shuffle` argument uses `sample()` to randomly reorder the top-level expressions in each test file (#1942). This random reordering surfaces dependencies between tests and code outside of any test, as well as dependencies between tests. This helps you find and eliminate unintentional dependencies.
+* `test_dir()`, `test_file()`, `test_package()`, `test_check()`, `test_local()`, `source_file()` gain a `shuffle` argument that uses `sample()` to randomly reorder the top-level expressions in each test file (#1942). This random reordering surfaces dependencies between tests and code outside of any test, as well as dependencies between tests. This helps you find and eliminate unintentional dependencies.
 * `snapshot_accept(test)` now works when the test file name contains `.` (#1669).
 * `local_mock()` and `with_mock()` have been deprecated because they are no longer permitted in R 4.5.
 * `snapshot_review()` now passes `...` on to `shiny::runApp()` (#1928).
 * `expect_named()` now gives more informative errors (#2091).
-* `expect_*()` functions consistently and rigorously check their inputs (#1754). 
+* `expect_*()` functions consistently and rigorously check their inputs (#1754).
 * `test_that()` no longer warns about the absence of `{}` since it no longer seems to be necessary.
 * `test_that()`, `describe()`, and `it()` can now be arbitrarily nested. Each component will skip only if it and its subtests don't contain any expectations. The interactive stop reporter has been fixed so it doesn't duplicate failures. (#2063, #2188).
 * Test filtering now works with `it()`, and the `desc` argument can take a character vector in order to recursively filter subtests (i.e. `it()` nested inside of `describe()`) (#2118).
 * New `snapshot_reject()` rejects all modified snapshots by deleting the `.new` variants (#1923).
 * New `SlowReporter` makes it easier to find the slowest tests in your package. The easiest way to run it is with `devtools::test(reporter = "slow")` (#1466).
-* Power `expect_mapequal()` with `waldo::compare(list_as_map = TRUE)` (#1521).
 * On CRAN, `test_that()` now automatically skips if a package is not installed (#1585). Practically, this means that you no longer need to check that suggested packages are installed. (We don't do this in the tidyverse because we think it has limited payoff, but other styles advise differently.)
 * `expect_snapshot()` no longer skips on CRAN, as that skips the rest of the test. Instead it just returns, neither succeeding nor failing (#1585).
-* Interrupting a test now prints the test name. This makes it easier to tell where a very slow test might be hanging (#1464)
+* Interrupting a test now prints the test name. This makes it easier to tell where a very slow test might be hanging (#1464).
 * Parallel testthat now does not ignore test files with syntax errors (#1360).
 * `expect_lt()`, `expect_gt()`, and friends have a refined display that is more likely to display the correct number of digits and shows you the actual values compared.
 * `describe()`, `it()`, and `test_that()` now have a shared stack of descriptions so that if you nest any inside of each other, any resulting failures will show you the full path.
@@ -39,9 +42,9 @@
 * New `expect_r6_class()` (#2030).
 * `expect_*()` functions consistently and rigorously check their inputs (#1754).
 * `JunitReporter()` no longer fails with `"no applicable method for xml_add_child"` for warnings outside of tests (#1913). Additionally, warnings now save their backtraces.
-* `JunitReporter()` strips ANSI escapes in more placese (#1852, #2032).
+* `JunitReporter()` strips ANSI escapes in more places (#1852, #2032).
 * `try_again()` is now publicised. The first argument is now the number of retries, not tries (#2050).
-* `vignette("custom-expectations)` has been overhauled to make it much clearer how to create high-quality expectations (#2113, #2132, #2072).
+* `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, #2181).
@@ -988,7 +991,7 @@ This release mostly focusses on an overhaul of how testthat works with condition
 * In `expect_equal_to_reference()`, the default value for `update` is
   now `FALSE` (@BrodieG, #683).
 
-* `expect_error()` now returns the error object as documentated (#724).
+* `expect_error()` now returns the error object as documented (#724).
   It also now warns if you're using a classed expectation and you're
   not using the `class` argument. This is good practice as it decouples the
   error object (which tends to be stable) from its rendering to the user
@@ -1680,7 +1683,7 @@ The reporters system class has been considerably refactored to make existing rep
 * `safe_digest()` uses a better strategy, and returns NA for directories
   (#138, #146).
 
-* Random praise is renabled by default (again!) (#164).
+* Random praise is re-enabled by default (again!) (#164).
 
 * Teamcity reporter now correctly escapes output messages (#150, @windelinckx).
   It also uses nested suites to include test names.

R/expect-all.R

@@ -0,0 +1,69 @@
+#' Do you expect every value in a vector to have this value?
+#'
+#' These expectations are similar to `expect_true(all(x == "x"))`,
+#' `expect_true(all(x))` and `expect_true(all(!x))` but give more informative
+#' failure messages if the expectations are not met.
+#'
+#' @inheritParams expect_equal
+#' @export
+#' @examples
+#' x1 <- c(1, 1, 1, 1, 1, 1)
+#' expect_all_equal(x1, 1)
+#'
+#' x2 <- c(1, 1, 1, 2, 1, 1, 1, 1, 1, 1, 1, 2)
+#' show_failure(expect_all_equal(x2, 1))
+#'
+#' # expect_all_true() and expect_all_false() are helpers for common cases
+#' set.seed(1016)
+#' show_failure(expect_all_true(rpois(100, 10) < 20))
+#' show_failure(expect_all_false(rpois(100, 10) > 20))
+expect_all_equal <- function(object, expected) {
+  act <- quasi_label(enquo(object))
+  exp <- quasi_label(enquo(expected))
+
+  expect_all_equal_(act, exp)
+  invisible(act$val)
+}
+
+#' @export
+#' @rdname expect_all_equal
+expect_all_true <- function(object) {
+  act <- quasi_label(enquo(object))
+  exp <- labelled_value(TRUE, "TRUE")
+
+  expect_all_equal_(act, exp)
+  invisible(act$val)
+}
+
+#' @export
+#' @rdname expect_all_equal
+expect_all_false <- function(object) {
+  act <- quasi_label(enquo(object))
+  exp <- labelled_value(FALSE, "FALSE")
+
+  expect_all_equal_(act, exp)
+  invisible(act$val)
+}
+
+
+expect_all_equal_ <- function(act, exp, trace_env = caller_env()) {
+  check_vector(act$val, error_call = trace_env, error_arg = "object")
+  if (length(act$val) == 0) {
+    cli::cli_abort("{.arg object} must not be empty.", call = trace_env)
+  }
+
+  check_vector(exp$val, error_call = trace_env, error_arg = "expected")
+  if (length(exp$val) != 1) {
+    cli::cli_abort("{.arg expected} must be length 1.", call = trace_env)
+  }
+
+  exp$val <- rep(exp$val, length(act$val))
+  names(exp$val) <- names(act$val)
+  expect_waldo_equal_(
+    "Expected every element of %s to equal %s.",
+    act,
+    exp,
+    tolerance = testthat_tolerance(),
+    trace_env = trace_env
+  )
+}

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)
 }
 
 # -------------------------------------------------------------------------