Iterating on expect_named()

Author: hadley

R/expect-equality.R

@@ -136,8 +136,7 @@ expect_waldo_equal_ <- function(
   exp,
   info = NULL,
   ...,
-  trace_env = caller_env(),
-  error_prefix = NULL
+  trace_env = caller_env()
 ) {
   comp <- waldo_compare(
     act$val,
@@ -154,7 +153,6 @@ expect_waldo_equal_ <- function(
       exp$lab,
       paste0(comp, collapse = "\n\n")
     )
-    msg <- paste0(error_prefix, msg)
     return(fail(msg, info = info, trace_env = trace_env))
   }
   pass(act$val)

R/expect-named.R

@@ -35,6 +35,7 @@ expect_named <- function(
   check_bool(ignore.order)
   check_bool(ignore.case)
 
+  
   act <- quasi_label(enquo(object), label)
 
   if (missing(expected)) {
@@ -47,11 +48,11 @@ expect_named <- function(
   act_names <- normalise_names(names(act$val), ignore.order, ignore.case)
 
   if (ignore.order) {
-    act <- labelled_value(act_names, act$lab)
-    return(expect_setequal_(act, exp, error_prefix = "Names of "))
+    act <- labelled_value(act_names, paste0("names(", act$lab, ")"))
+    return(expect_setequal_(act, exp))
   } else {
-    act <- labelled_value(act_names, act$lab)
-    return(expect_waldo_equal_("equal", act, exp, error_prefix = "Names of "))
+    act <- labelled_value(act_names, paste0("names(", act$lab, ")"))
+    return(expect_waldo_equal_("equal", act, exp))
   }
 
   pass(act$val)

R/expect-setequal.R

@@ -40,17 +40,13 @@ expect_setequal <- function(object, expected) {
 expect_setequal_ <- function(
   act,
   exp,
-  trace_env = caller_env(),
-  error_prefix = NULL
+  trace_env = caller_env()
 ) {
   act_miss <- unique(act$val[!act$val %in% exp$val])
   exp_miss <- unique(exp$val[!exp$val %in% act$val])
 
   if (length(exp_miss) || length(act_miss)) {
     msg <- paste0(
-      if (!is.null(error_prefix)) {
-        error_prefix
-      },
       act$lab,
       " doesn't have the same values as ",
       exp$lab,

tests/testthat/_snaps/expect-named.md

@@ -4,47 +4,47 @@
 
 # expected_named verifies actual of names
 
-    Names of Expected `c(a = 1)` to be equal to "b".
+    Expected names(`c(a = 1)`) to be equal to "b".
 
     `actual`:   "a"
     `expected`: "b"
 
 # provide useful feedback on failure
 
-    Names of `c(a = 1)` doesn't have the same values as `c("a", "b")`.
+    names(`x1`) doesn't have the same values as `c("a", "b")`.
     * Only in `expected`: "b"
 
 
 ---
 
-    Names of `c(a = 1, b = 1)` doesn't have the same values as `c("a")`.
+    names(`x2`) doesn't have the same values as "a".
     * Only in `actual`: "b"
 
 
 ---
 
-    Names of `c(a = 1)` doesn't have the same values as `c("b")`.
+    names(`x1`) doesn't have the same values as "b".
     * Only in `actual`: "a"
     * Only in `expected`: "b"
 
 
 ---
 
-    Names of Expected `c(a = 1)` to be equal to `c("a", "b")`.
+    Expected names(`x1`) to be equal to `c("a", "b")`.
 
     `actual`:   "a"    
     `expected`: "a" "b"
 
 ---
 
-    Names of Expected `c(a = 1, b = 1)` to be equal to `c("a")`.
+    Expected names(`x2`) to be equal to "a".
 
     `actual`:   "a" "b"
     `expected`: "a"    
 
 ---
 
-    Names of Expected `c(a = 1)` to be equal to `c("b")`.
+    Expected names(`x1`) to be equal to `c("b")`.
 
     `actual`:   "a"
     `expected`: "b"

tests/testthat/test-expect-named.R

@@ -8,38 +8,23 @@ test_that("expected_named verifies actual of names", {
   expect_snapshot_failure(expect_named(c(a = 1), "b"))
 })
 
-test_that("expected_named optionally ignores case", {
-  expect_success(expect_named(c(a = 1), "A", ignore.case = TRUE))
-})
-
-test_that("expected_named optionally ignores order", {
-  expect_success(expect_named(
-    c(a = 1, b = 2),
-    c("b", "a"),
-    ignore.order = TRUE
-  ))
+test_that("expected_named optionally ignores order and case", {
+  x <- c(a = 1, b = 2)
+  expect_success(expect_named(x, c("A", "B"), ignore.case = TRUE))
+  expect_success(expect_named(x, c("b", "a"), ignore.order = TRUE))
 })
 
 test_that("provide useful feedback on failure", {
-  expect_snapshot_error(
-    expect_named(c(a = 1), c("a", "b"), ignore.order = TRUE)
-  )
-  expect_snapshot_error(
-    expect_named(c(a = 1, b = 1), c("a"), ignore.order = TRUE)
-  )
-  expect_snapshot_error(
-    expect_named(c(a = 1), c("b"), ignore.order = TRUE)
-  )
+  x1 <- c(a = 1)
+  x2 <- c(a = 1, b = 2)
 
-  expect_snapshot_error(
-    expect_named(c(a = 1), c("a", "b"), ignore.order = FALSE)
-  )
-  expect_snapshot_error(
-    expect_named(c(a = 1, b = 1), c("a"), ignore.order = FALSE)
-  )
-  expect_snapshot_error(
-    expect_named(c(a = 1), c("b"), ignore.order = FALSE)
-  )
+  expect_snapshot_failure(expect_named(x1, c("a", "b"), ignore.order = TRUE))
+  expect_snapshot_failure(expect_named(x2, "a", ignore.order = TRUE))
+  expect_snapshot_failure(expect_named(x1, "b", ignore.order = TRUE))
+
+  expect_snapshot_failure(expect_named(x1, c("a", "b"), ignore.order = FALSE))
+  expect_snapshot_failure(expect_named(x2, "a", ignore.order = FALSE))
+  expect_snapshot_failure(expect_named(x1, c("b"), ignore.order = FALSE))
 })
 
 test_that("expect_named validates its inputs", {