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

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,41 @@ 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)
-  )
+  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)
+    )
 
-  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
+      )
+    }
 
-  if (is.na(diff)) {
-    msg_diff <- NULL
   } 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
     )
+    msg_diff <- NULL
   }
 
   c(msg_exp, msg_act, msg_diff)

man/comparison-expectations.Rd

@@ -76,6 +76,114 @@
       ! Expected `x` < 10.
       Actual comparison: NA >= 10.0
 
+# comparisons with POSIXct objects work
+
+    Code
+      expect_lt(time2, time)
+    Condition
+      Error:
+      ! Expected `time2` < `time`.
+      Actual comparison: "2020-01-01 01:00:01" >= "2020-01-01 01:00:00"
+
+---
+
+    Code
+      expect_lte(time2, time)
+    Condition
+      Error:
+      ! Expected `time2` <= `time`.
+      Actual comparison: "2020-01-01 01:00:01" > "2020-01-01 01:00:00"
+
+---
+
+    Code
+      expect_gt(time, time2)
+    Condition
+      Error:
+      ! Expected `time` > `time2`.
+      Actual comparison: "2020-01-01 01:00:00" <= "2020-01-01 01:00:01"
+
+---
+
+    Code
+      expect_gte(time, time2)
+    Condition
+      Error:
+      ! Expected `time` >= `time2`.
+      Actual comparison: "2020-01-01 01:00:00" < "2020-01-01 01:00:01"
+
+# comparisons with Date objects work
+
+    Code
+      expect_lt(date2, date)
+    Condition
+      Error:
+      ! Expected `date2` < `date`.
+      Actual comparison: "2020-01-02" >= "2020-01-01"
+
+---
+
+    Code
+      expect_lte(date2, date)
+    Condition
+      Error:
+      ! Expected `date2` <= `date`.
+      Actual comparison: "2020-01-02" > "2020-01-01"
+
+---
+
+    Code
+      expect_gt(date, date2)
+    Condition
+      Error:
+      ! Expected `date` > `date2`.
+      Actual comparison: "2020-01-01" <= "2020-01-02"
+
+---
+
+    Code
+      expect_gte(date, date2)
+    Condition
+      Error:
+      ! Expected `date` >= `date2`.
+      Actual comparison: "2020-01-01" < "2020-01-02"
+
+# comparisons with character objects work
+
+    Code
+      expect_lt("b", "a")
+    Condition
+      Error:
+      ! Expected "b" < "a".
+      Actual comparison: "b" >= "a"
+
+---
+
+    Code
+      expect_lte("b", "a")
+    Condition
+      Error:
+      ! Expected "b" <= "a".
+      Actual comparison: "b" > "a"
+
+---
+
+    Code
+      expect_gt("a", "b")
+    Condition
+      Error:
+      ! Expected "a" > "b".
+      Actual comparison: "a" <= "b"
+
+---
+
+    Code
+      expect_gte("a", "b")
+    Condition
+      Error:
+      ! Expected "a" >= "b".
+      Actual comparison: "a" < "b"
+
 # 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()
+test_that("comparisons with POSIXct objects work", {
+  time <- as.POSIXct("2020-01-01 01:00:00")
   time2 <- time + 1
   expect_success(expect_lt(time, time2))
   expect_success(expect_lte(time, time2))
   expect_success(expect_gt(time2, time))
   expect_success(expect_gte(time2, time))
+
+  expect_snapshot_failure(expect_lt(time2, time))
+  expect_snapshot_failure(expect_lte(time2, time))
+  expect_snapshot_failure(expect_gt(time, time2))
+  expect_snapshot_failure(expect_gte(time, time2))
+})
+
+test_that("comparisons with Date objects work", {
+  date <- as.Date("2020-01-01")
+  date2 <- date + 1
+  expect_success(expect_lt(date, date2))
+  expect_success(expect_lte(date, date2))
+  expect_success(expect_gt(date2, date))
+  expect_success(expect_gte(date2, date))
+
+  expect_snapshot_failure(expect_lt(date2, date))
+  expect_snapshot_failure(expect_lte(date2, date))
+  expect_snapshot_failure(expect_gt(date, date2))
+  expect_snapshot_failure(expect_gte(date, date2))
+})
+
+test_that("comparisons with character objects work", {
+  expect_success(expect_lt("a", "b"))
+  expect_success(expect_lte("a", "b"))
+  expect_success(expect_gt("b", "a"))
+  expect_success(expect_gte("b", "a"))
+
+  expect_snapshot_failure(expect_lt("b", "a"))
+  expect_snapshot_failure(expect_lte("b", "a"))
+  expect_snapshot_failure(expect_gt("a", "b"))
+  expect_snapshot_failure(expect_gte("a", "b"))
 })
 
 test_that("comparison must yield a single logical", {