diff --git a/NEWS.md b/NEWS.md index 2a0c38d40..17f40d301 100644 --- a/NEWS.md +++ b/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. diff --git a/R/compare.r b/R/compare.r index 75fc6e822..bf688d91c 100644 --- a/R/compare.r +++ b/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) } diff --git a/R/expectations-equality.R b/R/expectations-equality.R index c9efd2c07..0b4b71205 100644 --- a/R/expectations-equality.R +++ b/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, diff --git a/tests/testthat/test-compare.r b/tests/testthat/test-compare.r index 2d4b9d20a..4a27b25ed 100644 --- a/tests/testthat/test-compare.r +++ b/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]*")) +})