More improvements to match output (#2195)

Particularly focussing on multiline outputs

Author: hadley

R/expect-match.R

@@ -117,29 +117,73 @@ expect_match_ <- function(
     return(pass(act$val))
   }
 
-  text <- encodeString(act$val)
   if (length(act$val) == 1) {
-    values <- paste0(title, ': "', text, '"')
     which <- ""
   } else {
-    bullet <- ifelse(
-      condition,
-      cli::col_green(cli::symbol$tick),
-      cli::col_red(cli::symbol$cross)
-    )
-    values <- paste0(title, ":\n", paste0(bullet, " ", text, collapse = "\n"))
     which <- if (all) "Every element of " else "Some element of "
   }
   match <- if (negate) "matches" else "does not match"
 
   msg <- sprintf(
-    "%s%s %s %s %s.\n%s",
+    "%s%s %s %s %s.\n%s:\n%s",
     which,
     act$lab,
     match,
     if (fixed) "string" else "regexp",
     encodeString(regexp, quote = '"'),
-    values
+    title,
+    paste0(show_text(act$val, condition), collapse = "\n")
   )
   return(fail(msg, info = info, trace_env = trace_env))
 }
+
+
+# Adapted from print.ellmer_prompt
+show_text <- function(
+  x,
+  condition,
+  ...,
+  max_items = 20,
+  max_lines = max_items * 25
+) {
+  n <- length(x)
+  n_extra <- length(x) - max_items
+  if (n_extra > 0) {
+    x <- x[seq_len(max_items)]
+    condition <- condition[seq_len(max_items)]
+  }
+
+  if (length(x) == 0) {
+    return(character())
+  }
+
+  bar <- if (cli::is_utf8_output()) "\u2502" else "|"
+
+  id <- ifelse(
+    condition,
+    cli::col_green(cli::symbol$tick),
+    cli::col_red(cli::symbol$cross)
+  )
+
+  indent <- paste0(id, " ", bar, " ")
+  exdent <- paste0("  ", cli::col_grey(bar), " ")
+
+  x[is.na(x)] <- cli::col_red("<NA>")
+  x <- paste0(indent, x)
+  x <- gsub("\n", paste0("\n", exdent), x)
+
+  lines <- strsplit(x, "\n")
+  ids <- rep(seq_along(x), length(lines))
+  lines <- unlist(lines)
+
+  if (length(lines) > max_lines) {
+    lines <- lines[seq_len(max_lines)]
+    lines <- c(lines, paste0(exdent, "..."))
+    n_extra <- n - ids[max_lines - 1]
+  }
+
+  if (n_extra > 0) {
+    lines <- c(lines, paste0("... and ", n_extra, " more.\n"))
+  }
+  lines
+}

tests/testthat/_snaps/expect-match.md

@@ -5,23 +5,39 @@
 ---
 
     `one` does not match regexp "asdf".
-    Text: "bcde"
+    Text:
+    ✖ │ bcde
 
 ---
 
     Every element of `many` does not match regexp "a".
     Text:
-    ✔ a
-    ✔ a
-    ✖ b
+    ✔ │ a
+    ✔ │ a
+    ✖ │ b
 
 ---
 
     Some element of `many` does not match regexp "c".
     Text:
-    ✖ a
-    ✖ a
-    ✖ b
+    ✖ │ a
+    ✖ │ a
+    ✖ │ b
+
+---
+
+    Every element of `paragraph` does not match regexp "paragraph".
+    Text:
+    ✔ │ This is a multiline
+      │ paragraph.
+    ✖ │ Second element.
+
+---
+
+    Every element of `na` does not match regexp "NA".
+    Text:
+    ✔ │ NA
+    ✖ │ <NA>
 
 # expect_match validates its inputs
 
@@ -82,10 +98,12 @@
 # expect_no_match works
 
     `x` matches string "e*".
-    Text: "te*st"
+    Text:
+    x | te*st
 
 ---
 
     `x` matches regexp "TEST".
-    Text: "test"
+    Text:
+    x | test
 

tests/testthat/_snaps/expect-output.md

@@ -1,7 +1,8 @@
 # expect = string checks for match
 
     `g()` does not match regexp "x".
-    Output: "!"
+    Output:
+    x | !
 
 ---
 

tests/testthat/_snaps/expect-self-test.md

@@ -1,7 +1,8 @@
 # expect_failure() can optionally match message
 
     Failure message does not match regexp "banana".
-    Text: "apple"
+    Text:
+    x | apple
 
 # errors in expect_success bubble up
 

tests/testthat/test-expect-match.R

@@ -10,6 +10,12 @@ test_that("generates useful failure messages", {
   many <- c("a", "a", "b")
   expect_snapshot_failure(expect_match(many, "a"))
   expect_snapshot_failure(expect_match(many, "c", all = FALSE))
+
+  paragraph <- c("This is a multiline\nparagraph.", "Second element.")
+  expect_snapshot_failure(expect_match(paragraph, "paragraph"))
+
+  na <- c("NA", NA)
+  expect_snapshot_failure(expect_match(na, "NA"))
 })
 
 test_that("expect_match validates its inputs", {