Add some explicit integer64 support

DESCRIPTION

@@ -21,6 +21,7 @@ Imports:
     methods,
     rlang (>= 1.1.0)
 Suggests:
+    bit64,
     R6,
     S7,
     testthat (>= 3.0.0),

NEWS.md

@@ -1,5 +1,6 @@
 # waldo (development version)
 
+* `compare()` can numeric differences between int64 objects and integers/doubles when `tolerance` is set (#159).
 * `compare()` now gives informative errors if you misspecify the argument types (#181)
 * waldo gains basic support for S7 objects (#200).
 * `as_map()` now preserves attributes (#185).

R/compare-value.R

@@ -1,7 +1,7 @@
 compare_vector <- function(x, y, paths = c("x", "y"), opts = compare_opts()) {
 
   # Early exit for numerics (except for) with format methods
-  if (typeof(x) %in% c("integer", "double") && num_equal(x, y, opts$tolerance)) {
+  if (is_numeric(x) && num_equal(x, y, opts$tolerance)) {
     return()
   }
 

R/compare.R

@@ -245,6 +245,10 @@ compare_structure <- function(x, y, paths = c("x", "y"), opts = compare_opts())
       y <- zap_srcref(y)
     }
 
+    if (compare_as_numeric(x, y, opts$tolerance)) {
+      opts$ignore_attr <- union(opts$ignore_attr, "class")
+    }
+
     out <- c(out, compare_by_attr(attrs(x, opts$ignore_attr), attrs(y, opts$ignore_attr), paths, opts))
   }
 
@@ -405,7 +409,7 @@ compare_terminate <- function(x, y, paths,
     return(character())
   }
 
-  if (!is.null(tolerance) && is_numeric(x) && is_numeric(y)) {
+  if (compare_as_numeric(x, y, tolerance)) {
     return(character())
   }
 

R/num_equal.R

@@ -10,8 +10,21 @@
     return(FALSE)
   }
 
-  attributes(x) <- NULL
-  attributes(y) <- NULL
+  if (is_int64(x) || is_int64(y)) {
+    in_range <-
+      (!is.double(x) || all((x >= 2^63 & x <= 2^63 - 1) | is.na(x))) &&
+      (!is.double(y) || all((y >= 2^63 & y <= 2^63 - 1) | is.na(x)))
+    if (isTRUE(in_range)) {
+      x <- bit64::as.integer64(x)
+      y <- bit64::as.integer64(y)
+    } else {
+      x <- as.double(x)
+      y <- as.double(y)
+    }
+  } else {
+    attributes(x) <- NULL
+    attributes(y) <- NULL
+  }
 
   same <- is.na(x) | x == y
   if (is.null(tolerance)) {

R/utils.R

@@ -108,7 +108,15 @@ attrs <- function(x, ignore) {
   out[c(first, rest)]
 }
 
-is_numeric <- function(x) is_integer(x) || is_double(x)
+compare_as_numeric <- function(x, y, tol) {
+  !is.null(tol) && is_numeric(x) && is_numeric(y)
+}
+is_numeric <- function(x) {
+  is_integer(x) || is_double(x) || is_int64(x)
+}
+is_int64 <- function(x) {
+  inherits(x, "integer64")
+}
 
 in_ci <- function() {
   isTRUE(as.logical(Sys.getenv("CI", "FALSE")))

tests/testthat/_snaps/compare.md

@@ -184,6 +184,34 @@
       `old` is an S3 object of class <a>, a double vector
       `new` is an integer vector (1)
 
+# can compare int64s
+
+    Code
+      compare(int64_1, int64_1)
+    Output
+      v No differences
+    Code
+      compare(int64_0, int64_1)
+    Output
+      `old`: "0"
+      `new`: "1"
+
+# can ignore numeric differences between int64 and other numbers
+
+    Code
+      compare(1, int64_1)
+    Output
+      `old` is a double vector (1)
+      `new` is an S3 object of class <integer64>, a double vector
+    Code
+      compare(1, int64_1, tolerance = 0)
+    Output
+      v No differences
+    Code
+      compare(1L, int64_1, tolerance = 0)
+    Output
+      v No differences
+
 # ignores S3 [[ methods
 
     Code
@@ -404,17 +432,17 @@
       # Different body
       compare(f3, f1, ignore_srcref = FALSE)
     Output
-      `attr(old, 'srcref')`: 207  9 209 3  9 3 207 209
-      `attr(new, 'srcref')`: 203 15 205 3 15 3 203 205
+      `attr(old, 'srcref')`: 225  9 227 3  9 3 225 227
+      `attr(new, 'srcref')`: 221 15 223 3 15 3 221 223
 
-      `attr(body(old), 'srcref')[[1]]`: 207 20 207 20 20 20 207 207
-      `attr(body(new), 'srcref')[[1]]`: 203 26 203 26 26 26 203 203
+      `attr(body(old), 'srcref')[[1]]`: 225 20 225 20 20 20 225 225
+      `attr(body(new), 'srcref')[[1]]`: 221 26 221 26 26 26 221 221
 
-      `attr(body(old), 'srcref')[[2]]`: 208 5 208 9 5 9 208 208
-      `attr(body(new), 'srcref')[[2]]`: 204 5 204 9 5 9 204 204
+      `attr(body(old), 'srcref')[[2]]`: 226 5 226 9 5 9 226 226
+      `attr(body(new), 'srcref')[[2]]`: 222 5 222 9 5 9 222 222
 
-      `attr(body(old), 'wholeSrcref')`: 1 0 209 3 0 3 1 209
-      `attr(body(new), 'wholeSrcref')`: 1 0 205 3 0 3 1 205
+      `attr(body(old), 'wholeSrcref')`: 1 0 227 3 0 3 1 227
+      `attr(body(new), 'wholeSrcref')`: 1 0 223 3 0 3 1 223
 
       `body(old)`: `{` `    1 + 3` `}`
       `body(new)`: `{` `    1 + 2` `}`

tests/testthat/test-compare.R

@@ -96,6 +96,24 @@ test_that("can ignore minor numeric differences", {
   expect_equal(compare_structure(x, x + 1e-9, opts = compare_opts(tolerance = 1e-6)), character())
 })
 
+test_that("can compare int64s", {
+  int64_0 <- bit64::as.integer64(0)
+  int64_1 <- bit64::as.integer64(1)
+  expect_snapshot({
+    compare(int64_1, int64_1)
+    compare(int64_0, int64_1)
+  })
+})
+
+test_that("can ignore numeric differences between int64 and other numbers", {
+  int64_1 <- bit64::as.integer64(1)
+  expect_snapshot({
+    compare(1, int64_1)
+    compare(1, int64_1, tolerance = 0)
+    compare(1L, int64_1, tolerance = 0)
+  })
+})
+
 test_that("ignores S3 [[ methods", {
   expect_snapshot({
     x <- as.POSIXlt("2020-01-01")

tests/testthat/test-num_equal.R

@@ -36,3 +36,11 @@ test_that("NaN is equal to NA_real_ unless tolerance is NULL", {
   expect_true(num_equal(NaN, NaN))
   expect_true(num_equal(NA_real_, NA_real_))
 })
+
+test_that("coerce large integers to doubles not int64", {
+  expect_no_warning(num_equal(36893488147419103232, bit64::as.integer64(1)))
+  expect_no_warning(num_equal(bit64::as.integer64(1), 36893488147419103232))
+
+  expect_no_error(num_equal(NA, bit64::as.integer64(1)))
+  expect_no_error(num_equal(bit64::as.integer64(1), NA))
+})