From 8f23914f3bfdf5653d473f351db2ed39d1f8f189 Mon Sep 17 00:00:00 2001
From: DavisVaughan <davis@rstudio.com>
Date: Fri, 21 Jan 2022 16:05:08 -0500
Subject: [PATCH] Add `vec_proxy_equal()` and `vec_proxy_compare()` methods

Because of https://github.com/r-lib/vctrs/issues/1503
---
 NAMESPACE                |   2 +
 R/iv.R                   |  14 +++++
 tests/testthat/test-iv.R | 112 +++++++++++++++++++++++++++++++++++++++
 3 files changed, 128 insertions(+)

diff --git a/NAMESPACE b/NAMESPACE
index a6cba6d..16d4120 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -11,6 +11,8 @@ S3method(iv_restore,nested_integer_iv)
 S3method(vec_cast,iv.iv)
 S3method(vec_cast,nested_integer_iv.nested_integer_iv)
 S3method(vec_proxy,iv)
+S3method(vec_proxy_compare,iv)
+S3method(vec_proxy_equal,iv)
 S3method(vec_ptype2,iv.iv)
 S3method(vec_ptype2,nested_integer_iv.nested_integer_iv)
 S3method(vec_ptype_abbr,iv)
diff --git a/R/iv.R b/R/iv.R
index dee33e9..ae6e84f 100644
--- a/R/iv.R
+++ b/R/iv.R
@@ -275,6 +275,20 @@ vec_restore.iv <- function(x, to, ...) {
   new_bare_iv_from_fields(x)
 }
 
+#' @export
+vec_proxy_equal.iv <- function(x, ...) {
+  # Need this because `vec_proxy_equal.vctrs_rcrd` isn't recursive
+  # https://github.com/r-lib/vctrs/issues/1503
+  vec_proxy_equal(new_data_frame(x))
+}
+
+#' @export
+vec_proxy_compare.iv <- function(x, ...) {
+  # Need this because `vec_proxy_compare.vctrs_rcrd` intercepts us
+  # https://github.com/r-lib/vctrs/issues/1503
+  vec_proxy_compare(new_data_frame(x))
+}
+
 # ------------------------------------------------------------------------------
 
 #' Developer tools for extending iv
diff --git a/tests/testthat/test-iv.R b/tests/testthat/test-iv.R
index dac31cd..1583506 100644
--- a/tests/testthat/test-iv.R
+++ b/tests/testthat/test-iv.R
@@ -118,6 +118,118 @@ test_that("cast errors as needed", {
   expect_snapshot(error = TRUE, vec_cast(iv("x", "y"), iv(1L, 2L)))
 })
 
+# ------------------------------------------------------------------------------
+# vec_proxy_equal()
+
+test_that("`vec_proxy_equal()` works", {
+  x <- iv(1, 2)
+
+  expect_identical(
+    vec_proxy_equal(x),
+    data_frame(start = 1, end = 2)
+  )
+})
+
+test_that("`vec_proxy_equal()` is recursive", {
+  x <- iv(new_rcrd(list(a = 1, b = 1)), new_rcrd(list(a = 2, b = 3)))
+
+  expect_identical(
+    vec_proxy_equal(x),
+    data_frame(a = 1, b = 1, a = 2, b = 3, .name_repair = "minimal")
+  )
+})
+
+test_that("can `vec_equal()`", {
+  x <- iv(1, 2)
+  y <- iv(1, 3)
+
+  expect_true(vec_equal(x, x))
+  expect_false(vec_equal(x, y))
+
+  na <- iv(NA, NA)
+
+  expect_identical(vec_equal(x, na), NA)
+  expect_identical(vec_equal(x, na, na_equal = TRUE), FALSE)
+
+  expect_identical(vec_equal(na, na), NA)
+  expect_identical(vec_equal(na, na, na_equal = TRUE), TRUE)
+})
+
+test_that("can `vec_equal_na()`", {
+  x <- iv_pairs(c(1, 2), c(NA, NA))
+  expect_identical(vec_equal_na(x), c(FALSE, TRUE))
+})
+
+# ------------------------------------------------------------------------------
+# vec_proxy_compare()
+
+test_that("`vec_proxy_compare()` works", {
+  x <- iv(1, 2)
+
+  expect_identical(
+    vec_proxy_compare(x),
+    data_frame(start = 1, end = 2)
+  )
+})
+
+test_that("`vec_proxy_compare()` is recursive", {
+  x <- iv(new_rcrd(list(a = 1, b = 1)), new_rcrd(list(a = 2, b = 3)))
+
+  expect_identical(
+    vec_proxy_compare(x),
+    data_frame(a = 1, b = 1, a = 2, b = 3, .name_repair = "minimal")
+  )
+})
+
+test_that("can `vec_compare()`", {
+  x <- iv(1, 2)
+  y <- iv(1, 3)
+  z <- iv(2, 3)
+
+  expect_identical(vec_compare(x, x), 0L)
+  expect_identical(vec_compare(x, y), -1L)
+  expect_identical(vec_compare(x, z), -1L)
+
+  na <- iv(NA, NA)
+
+  expect_identical(vec_compare(x, na), NA_integer_)
+  expect_identical(vec_compare(x, na, na_equal = TRUE), 1L)
+
+  expect_identical(vec_compare(na, na), NA_integer_)
+  expect_identical(vec_compare(na, na, na_equal = TRUE), 0L)
+})
+
+# ------------------------------------------------------------------------------
+# vec_proxy_order()
+
+test_that("`vec_proxy_order()` works", {
+  x <- iv(1, 2)
+
+  expect_identical(
+    vec_proxy_order(x),
+    data_frame(start = 1, end = 2)
+  )
+})
+
+test_that("`vec_proxy_order()` is recursive", {
+  x <- iv(new_rcrd(list(a = 1, b = 1)), new_rcrd(list(a = 2, b = 3)))
+
+  expect_identical(
+    vec_proxy_order(x),
+    data_frame(a = 1, b = 1, a = 2, b = 3, .name_repair = "minimal")
+  )
+})
+
+test_that("can `vec_order()`", {
+  x <- iv_pairs(c(1, 3), c(2, 3), c(1, 2))
+
+  expect_identical(vec_order(x), c(3L, 1L, 2L))
+
+  x <- iv_pairs(c(NA, NA), c(1, 2), c(NA, NA))
+
+  expect_identical(vec_order(x), c(2L, 1L, 3L))
+})
+
 # ------------------------------------------------------------------------------
 # vec_ptype_abbr()