Merged origin/main into custom-expectations

Author: hadley

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* `expect_matches()` failures should be a little easier to read (#2135).
 * New `local_on_cran(TRUE)` allows you to simulate how your tests will run on CRAN (#2112).
 * `expect_no_*()` now executes the entire code block, rather than stopping at the first message or warning (#1991).
 * `expect_no_failures()` and `expect_no_successes()` are now deprecated as `expect_success()` now test for no failures and `expect_failure()` tests for no successes (#)

R/expect-constant.R

@@ -30,14 +30,16 @@ NULL
 #' @rdname logical-expectations
 expect_true <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label, arg = "object")
-  expect_waldo_constant_(act, TRUE, info = info, ignore_attr = TRUE)
+  exp <- labelled_value(TRUE, "TRUE")
+  expect_waldo_equal_("equal", act, exp, info = info, ignore_attr = TRUE)
 }
 
 #' @export
 #' @rdname logical-expectations
 expect_false <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label, arg = "object")
-  expect_waldo_constant_(act, FALSE, info = info, ignore_attr = TRUE)
+  exp <- labelled_value(FALSE, "FALSE")
+  expect_waldo_equal_("equal", act, exp, info = info, ignore_attr = TRUE)
 }
 
 #' Does code return `NULL`?
@@ -56,35 +58,6 @@ expect_false <- function(object, info = NULL, label = NULL) {
 #' show_failure(expect_null(y))
 expect_null <- function(object, info = NULL, label = NULL) {
   act <- quasi_label(enquo(object), label, arg = "object")
-  expect_waldo_constant_(act, NULL, info = info)
-}
-
-# helpers -----------------------------------------------------------------
-
-expect_waldo_constant_ <- function(
-  act,
-  constant,
-  info,
-  ...,
-  trace_env = caller_env()
-) {
-  comp <- waldo_compare(
-    act$val,
-    constant,
-    x_arg = "actual",
-    y_arg = "expected",
-    ...
-  )
-
-  if (length(comp) != 0) {
-    msg <- sprintf(
-      "%s is not %s\n\n%s",
-      act$lab,
-      deparse(constant),
-      paste0(comp, collapse = "\n\n")
-    )
-    return(fail(msg, info = info, trace_env = trace_env))
-  }
-
-  pass(act$val)
+  exp <- labelled_value(NULL, "FALSE")
+  expect_waldo_equal_("equal", act, exp, info = info)
 }

R/expect-equality.R

@@ -136,7 +136,7 @@ expect_waldo_equal_ <- function(
   )
   if (length(comp) != 0) {
     msg <- sprintf(
-      "%s (%s) not %s to %s (%s).\n\n%s",
+      "%s (%s) is not %s to %s (%s).\n\n%s",
       act$lab,
       "`actual`",
       type,

R/expect-match.R

@@ -1,10 +1,11 @@
 #' Does a string match a regular expression?
 #'
 #' @details
-#' `expect_match()` is a wrapper around [grepl()]. See its documentation for
-#' more detail about the individual arguments. `expect_no_match()` provides
-#' the complementary case, checking that a string *does not* match a regular
-#' expression.
+#' `expect_match()` checks if a character vector matches a regular expression,
+#' powered by [grepl()].
+#'
+#' `expect_no_match()` provides the complementary case, checking that a
+#' character vector *does not* match a regular expression.
 #'
 #' @inheritParams expect_that
 #' @inheritParams base::grepl
@@ -21,12 +22,11 @@
 #' expect_match("Testing is fun", "f.n")
 #' expect_no_match("Testing is fun", "horrible")
 #'
-#' \dontrun{
-#' expect_match("Testing is fun", "horrible")
+#' show_failure(expect_match("Testing is fun", "horrible"))
+#' show_failure(expect_match("Testing is fun", "horrible", fixed = TRUE))
 #'
 #' # Zero-length inputs always fail
-#' expect_match(character(), ".")
-#' }
+#' show_failure(expect_match(character(), "."))
 expect_match <- function(
   object,
   regexp,
@@ -37,11 +37,14 @@ expect_match <- function(
   info = NULL,
   label = NULL
 ) {
-  # Capture here to avoid environment-related messiness
   act <- quasi_label(enquo(object), label, arg = "object")
-  stopifnot(is.character(regexp), length(regexp) == 1)
 
-  stopifnot(is.character(act$val))
+  check_character(object)
+  check_string(regexp)
+  check_bool(perl)
+  check_bool(fixed)
+  check_bool(all)
+
   if (length(object) == 0) {
     return(fail(sprintf("%s is empty.", act$lab), info = info))
   }
@@ -75,11 +78,7 @@ expect_no_match <- function(
   # Capture here to avoid environment-related messiness
   act <- quasi_label(enquo(object), label, arg = "object")
   stopifnot(is.character(regexp), length(regexp) == 1)
-
   stopifnot(is.character(act$val))
-  if (length(object) == 0) {
-    return(fail(sprintf("%s is empty.", act$lab), info = info))
-  }
 
   expect_match_(
     act = act,
@@ -114,20 +113,17 @@ expect_match_ <- function(
     return(pass(act$val))
   }
 
-  escape <- if (fixed) identity else escape_regex
-
+  text <- encodeString(act$val)
   if (length(act$val) == 1) {
-    values <- paste0("Actual value: \"", escape(encodeString(act$val)), "\"")
+    values <- paste0('Text: "', text, '"')
   } else {
-    values <- paste0(
-      "Actual values:\n",
-      paste0("* ", escape(encodeString(act$val)), collapse = "\n")
-    )
+    values <- paste0("Text:\n", paste0("* ", text, collapse = "\n"))
   }
 
   msg <- sprintf(
-    if (negate) "%s does match %s.\n%s" else "%s does not match %s.\n%s",
-    escape(act$lab),
+    if (negate) "%s matches %s %s.\n%s" else "%s does not match %s %s.\n%s",
+    act$lab,
+    if (fixed) "string" else "regexp",
     encodeString(regexp, quote = '"'),
     values
   )

R/expect-output.R

@@ -45,7 +45,7 @@ expect_output <- function(
     }
     pass(act$val)
   } else {
-    act <- new_actual(act$cap, act$lab)
+    act <- labelled_value(act$cap, act$lab)
     expect_match_(act, enc2native(regexp), ...)
   }
 }

R/expect-self-test.R

@@ -85,7 +85,7 @@ expect_failure <- function(expr, message = NULL, ...) {
   }
 
   if (!is.null(message)) {
-    act <- new_actual(status$last_failure$message, "Failure message")
+    act <- labelled_value(status$last_failure$message, "Failure message")
     return(expect_match_(act, message, ...))
   }
   pass(NULL)

R/local.R

@@ -153,8 +153,9 @@ waldo_compare <- function(x, y, ..., x_arg = "x", y_arg = "y") {
   # Need to very carefully isolate this change to this function - can not set
   # in expectation functions because part of expectation handling bubbles
   # up through calling handlers, which are run before on.exit()
-  local_reporter_output()
-
+  if (!is_snapshot()) {
+    local_reporter_output()
+  }
   waldo::compare(x, y, ..., x_arg = x_arg, y_arg = y_arg)
 }
 

R/quasi-label.R

@@ -42,13 +42,13 @@ quasi_label <- function(quo, label = NULL, arg = "quo") {
 
   expr <- quo_get_expr(quo)
 
-  new_actual(
+  labelled_value(
     eval_bare(expr, quo_get_env(quo)),
     label %||% expr_label(expr)
   )
 }
 
-new_actual <- function(value, label) {
+labelled_value <- function(value, label) {
   list(
     val = value,
     lab = label

R/snapshot.R

@@ -268,21 +268,16 @@ expect_snapshot_condition_ <- function(
   )
   if (is.null(val)) {
     if (base_class == class) {
-      return(fail(
-        sprintf("%s did not generate %s", lab, base_class),
-        trace_env = trace_env
-      ))
+      msg <- sprintf("%s did not generate %s", lab, base_class)
     } else {
-      return(fail(
-        sprintf(
-          "%s did not generate %s with class '%s'",
-          lab,
-          base_class,
-          class
-        ),
-        trace_env = trace_env
-      ))
+      msg <- sprintf(
+        "%s did not generate %s with class '%s'",
+        lab,
+        base_class,
+        class
+      )
     }
+    return(fail(msg, trace_env = trace_env))
   }
 
   expect_snapshot_helper(

R/utils.R

@@ -2,31 +2,6 @@
 #' @export
 magrittr::`%>%`
 
-escape_regex <- function(x) {
-  chars <- c(
-    "*",
-    ".",
-    "?",
-    "^",
-    "+",
-    "$",
-    "|",
-    "(",
-    ")",
-    "[",
-    "]",
-    "{",
-    "}",
-    "\\"
-  )
-  gsub(
-    paste0("([\\", paste0(collapse = "\\", chars), "])"),
-    "\\\\\\1",
-    x,
-    perl = TRUE
-  )
-}
-
 can_entrace <- function(cnd) {
   !inherits(cnd, "Throwable")
 }