Improve failure message for comparison expectations

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* `expect_lt()`, `expect_gt()`, and friends have a refined display that is more likely to display the correct number of digits and shows you the actual values compared.
 * `describe()`, `it()`, and `test_that()` now have a shared stack of descriptions so that if you nest any inside of each other, any resulting failures will show you the full path.
 * `describe()` now correctly scopes `skip()` (#2007).
 * `ParallelProgressReporter` now respect `max_failures` (#1162).

R/expect-comparison.R

@@ -31,21 +31,31 @@ expect_compare_ <- function(
   msg <- c(
     "<" = "not strictly less than",
     "<=" = "not less than",
-    ">" = "not strictly more than",
-    ">=" = "not more than"
+    ">" = "not strictly greater than",
+    ">=" = "not greater than"
   )[[operator]]
 
+  negated_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
+
   cmp <- op(act$val, exp$val)
   if (length(cmp) != 1 || !is.logical(cmp)) {
     abort("Result of comparison must be a single logical value")
   }
   if (!isTRUE(cmp)) {
+    digits <- max(
+      digits(act$val),
+      digits(exp$val),
+      min_digits(act$val, exp$val)
+    )
     msg <- sprintf(
-      "%s is %s %s. Difference: %.3g",
+      "%s is %s %s.\n%s - %s = %s %s 0",
       act$lab,
       msg,
       exp$lab,
-      act$val - exp$val
+      num_exact(act$val, digits),
+      num_exact(exp$val, digits),
+      num_exact(act$val - exp$val, digits),
+      negated_op
     )
     return(fail(msg, trace_env = trace_env))
   }
@@ -109,3 +119,39 @@ expect_more_than <- function(...) {
   warning("Deprecated: please use `expect_gt()` instead", call. = FALSE)
   expect_gt(...)
 }
+
+
+# Helpers -----------------------------------------------------------------
+
+num_exact <- function(x, digits = 6) {
+  sprintf(paste0("%0.", digits, "f"), x)
+}
+
+min_digits <- function(x, y, tolerance = testthat_tolerance()) {
+  if (is.integer(x) && is.integer(y)) {
+    return(0L)
+  }
+
+  attributes(x) <- NULL
+  attributes(y) <- NULL
+
+  n <- digits(abs(x - y))
+  if (!is.null(tolerance)) {
+    n <- min(n, digits(tolerance))
+  }
+
+  as.integer(n) + 1L
+}
+
+digits <- function(x) {
+  x <- x[!is.na(x) & x != 0]
+  if (length(x) == 0) {
+    return(0)
+  }
+  scale <- -log10(min(x))
+  if (scale <= 0) {
+    0L
+  } else {
+    ceiling(round(scale, digits = 2))
+  }
+}

tests/testthat/_snaps/expect-comparison.md

@@ -0,0 +1,20 @@
+# useful output when numbers are very small
+
+    1.1 * x is not less than `x`.
+    0.0000110 - 0.0000100 = 0.0000010 > 0
+
+---
+
+    `x` is not strictly greater than 1.1 * x.
+    0.0000100 - 0.0000110 = -0.0000010 <= 0
+
+# useful output when difference is zero
+
+    `x` is not strictly less than 100.
+    100.0 - 100.0 = 0.0 >= 0
+
+# useful output when differnce is large
+
+    `x` is not strictly less than 0.001.
+    100.000 - 0.001 = 99.999 >= 0
+

tests/testthat/test-expect-comparison.R

@@ -8,6 +8,22 @@ test_that("basic comparisons work", {
   expect_success(expect_gte(10, 10))
 })
 
+test_that("useful output when numbers are very small", {
+  x <- 1e-5
+  expect_snapshot_failure(expect_lte(1.1 * x, x))
+  expect_snapshot_failure(expect_gt(x, 1.1 * x))
+})
+
+test_that("useful output when difference is zero", {
+  x <- 100
+  expect_snapshot_failure(expect_lt(x, 100))
+})
+
+test_that("useful output when differnce is large", {
+  x <- 100
+  expect_snapshot_failure(expect_lt(x, 0.001))
+})
+
 test_that("comparison result object invisibly", {
   out <- expect_invisible(expect_lt(1, 10))
   expect_equal(out, 1)