From c7f92abe65021d7158d2da6d440f2e6fabc1599b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Thu, 25 Jun 2015 12:33:34 +0200 Subject: [PATCH 1/6] compare vectors of different length in detail --- R/compare.r | 15 ++++++++++++--- 1 file changed, 12 insertions(+), 3 deletions(-) diff --git a/R/compare.r b/R/compare.r index 75fc6e822..1f129a624 100644 --- a/R/compare.r +++ b/R/compare.r @@ -70,7 +70,15 @@ 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 @@ -99,8 +107,9 @@ compare.character <- function(x, y, ..., max_diffs = 5, max_lines = 5, paste0(x, "\n", y, collapse = "\n\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) } From e7d5769eff9ccd18bb89a28884111b041d365e7d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Thu, 25 Jun 2015 12:34:38 +0200 Subject: [PATCH 2/6] bugfix: don't show more items than necessary when comparing long vectors with few differences --- R/compare.r | 7 ++++--- tests/testthat/test-compare.r | 8 ++++++++ 2 files changed, 12 insertions(+), 3 deletions(-) diff --git a/R/compare.r b/R/compare.r index 1f129a624..4cf3e0b35 100644 --- a/R/compare.r +++ b/R/compare.r @@ -83,14 +83,15 @@ compare.character <- function(x, y, ..., max_diffs = 5, max_lines = 5, # 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) diff --git a/tests/testthat/test-compare.r b/tests/testthat/test-compare.r index 2d4b9d20a..1a7fa5cfb 100644 --- a/tests/testthat/test-compare.r +++ b/tests/testthat/test-compare.r @@ -32,3 +32,11 @@ 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]*")) +}) From dbd769d961f2290ec4422aaadde856ebb16cec63 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Thu, 25 Jun 2015 12:35:55 +0200 Subject: [PATCH 3/6] if one vector is shorter, hide (non-existing) value in detailed diff --- R/compare.r | 11 +++-------- tests/testthat/test-compare.r | 14 ++++++++++++++ 2 files changed, 17 insertions(+), 8 deletions(-) diff --git a/R/compare.r b/R/compare.r index 4cf3e0b35..d1c94f09d 100644 --- a/R/compare.r +++ b/R/compare.r @@ -98,14 +98,9 @@ compare.character <- function(x, y, ..., max_diffs = 5, max_lines = 5, 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(length_diff, diff --git a/tests/testthat/test-compare.r b/tests/testthat/test-compare.r index 1a7fa5cfb..4a27b25ed 100644 --- a/tests/testthat/test-compare.r +++ b/tests/testthat/test-compare.r @@ -40,3 +40,17 @@ test_that("comparing long character vectors with few differences", { 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]*")) +}) From 343c4daf29f010e739526f36994646749137144e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Thu, 25 Jun 2015 12:36:38 +0200 Subject: [PATCH 4/6] reverse order in expectation so that output of detailed comparison matches expectation output --- R/expectations-equality.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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, From fc7c6486358858814c8ca80768392483219c8cc6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Fri, 25 Sep 2015 22:54:15 +0200 Subject: [PATCH 5/6] change assignment operator --- R/compare.r | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/compare.r b/R/compare.r index d1c94f09d..bf688d91c 100644 --- a/R/compare.r +++ b/R/compare.r @@ -75,9 +75,9 @@ compare.character <- function(x, y, ..., max_diffs = 5, max_lines = 5, ly <- length(y) if (lx != ly) { length(x) <- length(y) <- max(lx, ly) - length_diff = sprintf("Lengths (%s, %s) differ\n", lx, ly) + length_diff <- sprintf("Lengths (%s, %s) differ\n", lx, ly) } else { - length_diff = NULL + length_diff <- NULL } # If vectorwise-equal, fallback to default method From 30e3ff8be541752336c375c6ef92939016b43877 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Thu, 25 Jun 2015 12:45:02 +0200 Subject: [PATCH 6/6] NEWS --- NEWS.md | 6 ++++++ 1 file changed, 6 insertions(+) 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.