Improvements for compare.character

NEWS.md

@@ -7,6 +7,12 @@
 * Added `skip_on_os()`, to skip tests on specified operating systems
   (@kevinushey).
 
+* `compare()` shows detailed output of differences for character vectors of
+  different length (#274, @krlmlr).
+
+* Detailed output from `expect_equal()` doesn't confuse expected and actual
+  values anymore (#274, @krlmlr).
+
 # testthat 0.10.0
 
 * Failure locations are now formated as R error locations.

R/compare.r

@@ -70,37 +70,42 @@ compare.character <- function(x, y, ..., max_diffs = 5, max_lines = 5,
 
   # If they're not the same type or length, fallback to default method
   if (!same_type(x, y)) return(NextMethod())
-  if (length(x) != length(y)) return(NextMethod())
+
+  lx <- length(x)
+  ly <- length(y)
+  if (lx != ly) {
+    length(x) <- length(y) <- max(lx, ly)
+    length_diff <- sprintf("Lengths (%s, %s) differ\n", lx, ly)
+  } else {
+    length_diff <- NULL
+  }
 
   # If vectorwise-equal, fallback to default method
   diff <- xor(is.na(x), is.na(y)) | x != y
   diff[is.na(diff)] <- FALSE
+  which_diff <- which(diff)
 
-  if (!any(diff)) {
+  if (length(which_diff) == 0L) {
     return(NextMethod())
   }
 
   width <- width - 6 # allocate space for labels
-  n_show <- seq_len(min(length(diff), max_diffs))
-  show <- which(diff)[n_show]
+  n_show <- seq_len(min(length(which_diff), max_diffs))
+  show <- which_diff[n_show]
 
   encode <- function(x) encodeString(x, quote = '"')
   show_x <- str_trunc(encode(x[show]), width * max_lines)
   show_y <- str_trunc(encode(y[show]), width * max_lines)
 
   sidebyside <- Map(function(x, y, pos) {
-    x <- paste0("x[", pos, "]: ", str_chunk(x, width))
-    y <- paste0("y[", pos, "]: ", str_chunk(y, width))
-
-    n <- max(length(x), length(y))
-    length(x) <- n
-    length(y) <- n
-
-    paste0(x, "\n", y, collapse = "\n\n")
+    x <- if (pos <= lx) paste0("x[", pos, "]: ", str_chunk(x, width))
+    y <- if (pos <= ly) paste0("y[", pos, "]: ", str_chunk(y, width))
+    paste(c(x, y), collapse = "\n")
   }, show_x, show_y, show)
 
-  msg <- paste0(sum(diff), " string mismatches:\n",
-    paste0(sidebyside, collapse = "\n\n"))
+  msg <- paste0(length_diff,
+                sum(diff), " string mismatches:\n",
+                paste0(sidebyside, collapse = "\n\n"))
   comparison(FALSE, msg)
 }
 

R/expectations-equality.R

@@ -58,7 +58,7 @@ equals <- function(expected, label = NULL, ...) {
   }
 
   function(actual) {
-    same <- compare(expected, actual, ...)
+    same <- compare(actual, expected, ...)
 
     expectation(
       same$equal,

tests/testthat/test-compare.r

@@ -32,3 +32,25 @@ test_that("computes correct number of mismatches", {
 test_that("comparing character and non-character fails back to all.equal", {
   expect_match(compare("abc", 1)$message, "target is character")
 })
+
+test_that("comparing long character vectors with few differences", {
+  cmp <- compare(letters, c(letters[-26], "a"))
+  expect_match(
+    cmp$message,
+    paste("^", " string mismatch", "\\nx", "\\ny", "$",
+          sep = "[^\\n]*"))
+})
+
+test_that("comparing character vectors of different length", {
+  cmp <- compare(letters, letters[-26])
+  expect_match(
+    cmp$message,
+    paste("^", "Lengths ", " differ\\n", " string mismatch", "\\nx", "$",
+          sep = "[^\\n]*"))
+
+  cmp <- compare(letters[-25:-26], letters)
+  expect_match(
+    cmp$message,
+    paste("^", "Lengths ", " differ\\n", " string mismatch", "\\ny", "\\n", "\\ny", "$",
+          sep = "[^\\n]*"))
+})