add error_prefix to expect_setequal_() and expect_waldo_equal_()

Author: EmilHvitfeldt

R/expect-equality.R

@@ -126,7 +126,8 @@ expect_waldo_equal_ <- function(
   exp,
   info = NULL,
   ...,
-  trace_env = caller_env()
+  trace_env = caller_env(),
+  error_prefix = NULL
 ) {
   comp <- waldo_compare(
     act$val,
@@ -145,6 +146,9 @@ expect_waldo_equal_ <- function(
       "`expected`",
       paste0(comp, collapse = "\n\n")
     )
+    if (!is.null(error_prefix)) {
+      msg <- paste0(error_prefix, msg)
+    }
     return(fail(msg, info = info, trace_env = trace_env))
   }
   pass(act$val)

R/expect-named.R

@@ -49,10 +49,10 @@ expect_named <- function(
 
   if (ignore.order) {
     act <- labelled_value(act_names, act$lab)
-    return(expect_setequal_(act, exp, prefix = "Names of "))
+    return(expect_setequal_(act, exp, error_prefix = "Names of "))
   } else {
     act <- labelled_value(act_names, act$lab)
-    return(expect_waldo_equal_("equal", act, exp))
+    return(expect_waldo_equal_("equal", act, exp, error_prefix = "Names of "))
   }
 
   pass(act$val)

R/expect-setequal.R

@@ -36,12 +36,20 @@ expect_setequal <- function(object, expected) {
   expect_setequal_(act, exp)
 }
 
-expect_setequal_ <- function(act, exp, trace_env = caller_env()) {
+expect_setequal_ <- function(
+  act,
+  exp,
+  trace_env = caller_env(),
+  error_prefix = NULL
+) {
   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,
       " (`actual`) and ",
       exp$lab,

tests/testthat/_snaps/expect-named.md

@@ -1,22 +1,43 @@
 # provide useful feedback on failure
 
-    c(a = 1) (`actual`) and c("a", "b") (`expected`) don't have the same values.
+    Names of c(a = 1) (`actual`) and c("a", "b") (`expected`) don't have the same values.
     * Only in `expected`: "b"
 
 
 ---
 
-    c(a = 1, b = 1) (`actual`) and c("a") (`expected`) don't have the same values.
+    Names of c(a = 1, b = 1) (`actual`) and c("a") (`expected`) don't have the same values.
     * Only in `actual`: "b"
 
 
 ---
 
-    c(a = 1) (`actual`) and c("b") (`expected`) don't have the same values.
+    Names of c(a = 1) (`actual`) and c("b") (`expected`) don't have the same values.
     * Only in `actual`: "a"
     * Only in `expected`: "b"
 
 
+---
+
+    Names of c(a = 1) (`actual`) is not equal to c("a", "b") (`expected`).
+    
+    `actual`:   "a"    
+    `expected`: "a" "b"
+
+---
+
+    Names of c(a = 1, b = 1) (`actual`) is not equal to c("a") (`expected`).
+    
+    `actual`:   "a" "b"
+    `expected`: "a"    
+
+---
+
+    Names of c(a = 1) (`actual`) is not equal to c("b") (`expected`).
+    
+    `actual`:   "a"
+    `expected`: "b"
+
 # expect_named validates its inputs
 
     Code

tests/testthat/test-expect-named.R

@@ -30,6 +30,16 @@ test_that("provide useful feedback on failure", {
   expect_snapshot_error(
     expect_named(c(a = 1), c("b"), ignore.order = TRUE)
   )
+
+  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)
+  )
 })
 
 test_that("expect_named validates its inputs", {