More comparison tweaking

Author: hadley

R/expect-comparison.R

@@ -41,28 +41,31 @@ expect_compare_ <- function(
     diff <- act$val - exp$val
     msg_exp <- sprintf("Expected %s %s %s.", act$lab, operator, exp$lab)
 
+    digits <- max(
+      digits(act$val),
+      digits(exp$val),
+      min_digits(act$val, exp$val)
+    )
+
+    msg_act <- sprintf(
+      "Actual comparison: %s %s %s",
+      num_exact(act$val, digits),
+      actual_op,
+      num_exact(exp$val, digits)
+    )
+
     if (is.nan(diff)) {
-      msg_act <- "Actual values are incomparable."
+      msg_diff <- "Difference: incomparable."
     } else if (is.na(diff)) {
-      msg_act <- "Actual comparison is NA."
+      msg_diff <- "Difference: NA."
     } else {
-      digits <- max(
-        digits(act$val),
-        digits(exp$val),
-        min_digits(act$val, exp$val)
-      )
-
-      msg_act <- c(
-        sprintf(
-          "Actual %s %s %s",
-          num_exact(act$val, digits),
-          actual_op,
-          num_exact(exp$val, digits)
-        ),
-        sprintf("Difference %s %s 0", num_exact(diff, digits), actual_op)
+      msg_diff <- sprintf(
+        "Difference: %s %s 0",
+        num_exact(diff, digits),
+        actual_op
       )
     }
-    return(fail(c(msg_exp, msg_act), trace_env = trace_env))
+    return(fail(c(msg_exp, msg_act, msg_diff), trace_env = trace_env))
   }
   pass(act$val)
 }

tests/testthat/_snaps/expect-comparison.md

@@ -5,8 +5,8 @@
     Condition
       Error:
       ! Expected `x` < 10.
-      Actual 10.0 >= 10.0
-      Difference 0.0 >= 0
+      Actual comparison: 10.0 >= 10.0
+      Difference: 0.0 >= 0
 
 ---
 
@@ -15,8 +15,8 @@
     Condition
       Error:
       ! Expected `x` > 10.
-      Actual 10.0 <= 10.0
-      Difference 0.0 <= 0
+      Actual comparison: 10.0 <= 10.0
+      Difference: 0.0 <= 0
 
 # useful output when numbers are very small
 
@@ -25,8 +25,8 @@
     Condition
       Error:
       ! Expected `1.1 * x` <= `x`.
-      Actual 0.0000110 > 0.0000100
-      Difference 0.0000010 > 0
+      Actual comparison: 0.0000110 > 0.0000100
+      Difference: 0.0000010 > 0
 
 ---
 
@@ -35,8 +35,8 @@
     Condition
       Error:
       ! Expected `x` > `1.1 * x`.
-      Actual 0.0000100 <= 0.0000110
-      Difference -0.0000010 <= 0
+      Actual comparison: 0.0000100 <= 0.0000110
+      Difference: -0.0000010 <= 0
 
 # useful output when difference is zero
 
@@ -45,8 +45,8 @@
     Condition
       Error:
       ! Expected `x` < 100.
-      Actual 100.0 >= 100.0
-      Difference 0.0 >= 0
+      Actual comparison: 100.0 >= 100.0
+      Difference: 0.0 >= 0
 
 # useful output when differnce is large
 
@@ -55,98 +55,28 @@
     Condition
       Error:
       ! Expected `x` < 0.001.
-      Actual 100.000 >= 0.001
-      Difference 99.999 >= 0
+      Actual comparison: 100.000 >= 0.001
+      Difference: 99.999 >= 0
 
 # comparisons with Inf work
 
     Code
-      expect_lt(Inf, Inf)
+      expect_lt(x, Inf)
     Condition
       Error:
-      ! Expected Inf < Inf.
-      Actual values are incomparable.
-
----
-
-    Code
-      expect_gt(Inf, Inf)
-    Condition
-      Error:
-      ! Expected Inf > Inf.
-      Actual values are incomparable.
+      ! Expected `x` < Inf.
+      Actual comparison: Inf >= Inf
+      Difference: incomparable.
 
 # comparisons with NA work
 
     Code
-      expect_lt(10, NA_real_)
-    Condition
-      Error:
-      ! Expected 10 < NA_real_.
-      Actual comparison is NA.
-
----
-
-    Code
-      expect_lt(NA_real_, 10)
-    Condition
-      Error:
-      ! Expected NA_real_ < 10.
-      Actual comparison is NA.
-
----
-
-    Code
-      expect_lt(NA_real_, NA_real_)
-    Condition
-      Error:
-      ! Expected NA_real_ < NA_real_.
-      Actual comparison is NA.
-
----
-
-    Code
-      expect_lte(NA_real_, NA_real_)
-    Condition
-      Error:
-      ! Expected NA_real_ <= NA_real_.
-      Actual comparison is NA.
-
----
-
-    Code
-      expect_gt(10, NA_real_)
-    Condition
-      Error:
-      ! Expected 10 > NA_real_.
-      Actual comparison is NA.
-
----
-
-    Code
-      expect_gt(NA_real_, 10)
-    Condition
-      Error:
-      ! Expected NA_real_ > 10.
-      Actual comparison is NA.
-
----
-
-    Code
-      expect_gt(NA_real_, NA_real_)
-    Condition
-      Error:
-      ! Expected NA_real_ > NA_real_.
-      Actual comparison is NA.
-
----
-
-    Code
-      expect_gte(NA_real_, NA_real_)
+      expect_lt(x, 10)
     Condition
       Error:
-      ! Expected NA_real_ >= NA_real_.
-      Actual comparison is NA.
+      ! Expected `x` < 10.
+      Actual comparison: NA >= 10.0
+      Difference: NA.
 
 # comparison must yield a single logical
 

tests/testthat/test-expect-comparison.R

@@ -32,24 +32,30 @@ test_that("comparison result object invisibly", {
 
 test_that("comparisons with Inf work", {
   expect_success(expect_lt(10, Inf))
-  expect_snapshot_failure(expect_lt(Inf, Inf))
+  expect_failure(expect_lt(Inf, Inf))
   expect_success(expect_lte(Inf, Inf))
 
   expect_success(expect_gt(Inf, 10))
-  expect_snapshot_failure(expect_gt(Inf, Inf))
+  expect_failure(expect_gt(Inf, Inf))
   expect_success(expect_gte(Inf, Inf))
+
+  x <- Inf
+  expect_snapshot_failure(expect_lt(x, Inf))
 })
 
 test_that("comparisons with NA work", {
-  expect_snapshot_failure(expect_lt(10, NA_real_))
-  expect_snapshot_failure(expect_lt(NA_real_, 10))
-  expect_snapshot_failure(expect_lt(NA_real_, NA_real_))
-  expect_snapshot_failure(expect_lte(NA_real_, NA_real_))
+  expect_failure(expect_lt(10, NA_real_))
+  expect_failure(expect_lt(NA_real_, 10))
+  expect_failure(expect_lt(NA_real_, NA_real_))
+  expect_failure(expect_lte(NA_real_, NA_real_))
+
+  expect_failure(expect_gt(10, NA_real_))
+  expect_failure(expect_gt(NA_real_, 10))
+  expect_failure(expect_gt(NA_real_, NA_real_))
+  expect_failure(expect_gte(NA_real_, NA_real_))
 
-  expect_snapshot_failure(expect_gt(10, NA_real_))
-  expect_snapshot_failure(expect_gt(NA_real_, 10))
-  expect_snapshot_failure(expect_gt(NA_real_, NA_real_))
-  expect_snapshot_failure(expect_gte(NA_real_, NA_real_))
+  x <- NA_real_
+  expect_snapshot_failure(expect_lt(x, 10))
 })
 
 test_that("comparisons with more complicated objects work", {