make expect_lt() etc. work properly for non-numeric data (#2269)

* make `expect_lt()` etc. work properly for non-numeric data
And ensure it works with negative values.

Fixes #2268

Author: stibu81

NEWS.md

@@ -1,5 +1,6 @@
 # testthat (development version)
 
+* Make `expect_lt()`, `expect_lte()`, `expect_gt()`, and `expect_gte()` work properly for non-numeric data (#2268)
 * New `expect_disjoint()` to check for the absence of values (@stibu81, #1851).
 * `expect_all_equal()`, `expect_all_true()`, and `expect_all_false()` are a new family of expectations that checks that every element of a vector has the same value. Compared to using `expect_true(all(...))` they give better failure messages (#1836, #2235).
 * Expectations now consistently return the value of the first argument, regardless of whether the expectation succeeds or fails. The primary exception are `expect_message()` and friends which will return the condition. This shouldn't affect existing tests, but will make failures clearer when you chain together multiple expectations (#2246).

R/expect-comparison.R

@@ -1,4 +1,7 @@
-#' Do you expect a number bigger or smaller than this?
+#' Do you expect a value bigger or smaller than this?
+#'
+#' These functions compare values of comparable data types, such as numbers,
+#' dates, and times.
 #'
 #' @inheritParams expect_equal
 #' @param object,expected A value to compare and its expected bound.
@@ -45,30 +48,56 @@ expect_compare_ <- function(
 failure_compare <- function(act, exp, operator) {
   actual_op <- switch(operator, "<" = ">=", "<=" = ">", ">" = "<=", ">=" = "<")
 
-  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.na(diff)) {
-    msg_diff <- NULL
+  if (is.numeric(act$val)) {
+    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)
+    )
+
+    diff <- act$val - exp$val
+    if (is.na(diff)) {
+      msg_diff <- NULL
+    } else {
+      msg_diff <- sprintf(
+        "Difference: %s %s 0",
+        num_exact(diff, digits),
+        actual_op
+      )
+    }
+
   } else {
-    msg_diff <- sprintf(
-      "Difference: %s %s 0",
-      num_exact(diff, digits),
-      actual_op
+    msg_act <- sprintf(
+      "Actual comparison: \"%s\" %s \"%s\"",
+      act$val,
+      actual_op,
+      exp$val
     )
+
+    if (inherits(act$val, c("Date", "POSIXt"))) {
+      diff <- act$val - exp$val
+      if (is.na(diff)) {
+        msg_diff <- NULL
+      } else {
+        msg_diff <- sprintf(
+          "Difference: %s %s 0 %s",
+          dt_diff(diff),
+          actual_op,
+          attr(diff, "unit")
+        )
+      }
+    } else {
+      msg_diff <- NULL
+    }
   }
 
   c(msg_exp, msg_act, msg_diff)
@@ -165,10 +194,16 @@ digits <- function(x) {
   if (length(x) == 0) {
     return(0)
   }
-  scale <- -log10(min(x))
+  scale <- -log10(min(abs(x)))
   if (scale <= 0) {
     0L
   } else {
     ceiling(round(scale, digits = 2))
   }
 }
+
+dt_diff <- function(x) {
+  val <- unclass(x)
+  digits <- digits(abs(val)) + 1
+  paste(num_exact(val, digits), attr(x, "unit"))
+}

man/comparison-expectations.Rd

@@ -76,6 +76,45 @@
       ! Expected `x` < 10.
       Actual comparison: NA >= 10.0
 
+# comparisons with negative numbers work
+
+    Code
+      expect_gt(-5, -2)
+    Condition
+      Error:
+      ! Expected `-5` > `-2`.
+      Actual comparison: -5.0 <= -2.0
+      Difference: -3.0 <= 0
+
+# comparisons with POSIXct objects work
+
+    Code
+      expect_lt(time2, time)
+    Condition
+      Error:
+      ! Expected `time2` < `time`.
+      Actual comparison: "2020-01-01 01:00:01.5" >= "2020-01-01 01:00:00"
+      Difference: 1.5 secs >= 0 secs
+
+# comparisons with Date objects work
+
+    Code
+      expect_gt(date, date2)
+    Condition
+      Error:
+      ! Expected `date` > `date2`.
+      Actual comparison: "2020-01-01" <= "2020-01-02"
+      Difference: -1.0 days <= 0 days
+
+# comparisons with character objects work
+
+    Code
+      expect_lte("b", "a")
+    Condition
+      Error:
+      ! Expected "b" <= "a".
+      Actual comparison: "b" > "a"
+
 # comparison must yield a single logical
 
     Code

tests/testthat/_snaps/expect-comparison.md

@@ -58,13 +58,44 @@ test_that("comparisons with NA work", {
   expect_snapshot_failure(expect_lt(x, 10))
 })
 
-test_that("comparisons with more complicated objects work", {
-  time <- Sys.time()
-  time2 <- time + 1
+
+test_that("comparisons with negative numbers work", {
+  expect_success(expect_lt(-5, -2))
+  expect_snapshot_failure(expect_gt(-5, -2))
+})
+
+test_that("comparisons with POSIXct objects work", {
+  time <- as.POSIXct("2020-01-01 01:00:00")
+  time2 <- time + 1.5
   expect_success(expect_lt(time, time2))
-  expect_success(expect_lte(time, time2))
-  expect_success(expect_gt(time2, time))
-  expect_success(expect_gte(time2, time))
+
+  # set digits.secs = 1 to ensure consistent output with older R versions
+  withr::with_options(c(digits.secs = 1), {
+    expect_snapshot_failure(expect_lt(time2, time))
+  })
+})
+
+test_that("comparisons with Date objects work", {
+  date <- as.Date("2020-01-01")
+  date2 <- date + 1
+  expect_success(expect_gt(date2, date))
+  expect_success(expect_gte(date2, date))
+
+  expect_snapshot_failure(expect_gt(date, date2))
+})
+
+test_that("comparisons of date/time with NA work", {
+  time <- as.POSIXct("2020-01-01 01:00:00")
+  date <- as.Date("2020-01-01")
+
+  expect_failure(expect_lt(time, NA))
+  expect_failure(expect_gt(date, NA))
+})
+
+test_that("comparisons with character objects work", {
+  expect_success(expect_lte("a", "b"))
+
+  expect_snapshot_failure(expect_lte("b", "a"))
 })
 
 test_that("comparison must yield a single logical", {