implement ==.Object that calls $Equals instead of implementing for ea…

…ch class.

Many tests were false positives

r/NAMESPACE

@@ -3,13 +3,7 @@
 S3method("!=",Object)
 S3method("$",RecordBatch)
 S3method("$",Table)
-S3method("==",Array)
-S3method("==",DataType)
-S3method("==",Field)
-S3method("==",Message)
-S3method("==",RecordBatch)
-S3method("==",Schema)
-S3method("==",Table)
+S3method("==",Object)
 S3method("[",RecordBatch)
 S3method("[",Table)
 S3method("[[",RecordBatch)

r/R/array.R

@@ -156,6 +156,3 @@ length.Array <- function(x) x$length()
 
 #' @export
 as.vector.Array <- function(x, mode) x$as_vector()
-
-#' @export
-`==.Array` <- function(x, y) x$Equals(y)

r/R/arrow-package.R

@@ -66,6 +66,11 @@ Object <- R6Class("Object",
 #' @export
 `!=.Object` <- function(lhs, rhs) !(lhs == rhs)
 
+#' @export
+`==.Object` <- function(x, y) {
+  x$Equals(y)
+}
+
 #' @export
 all.equal.Object <- function(target, current, ...) {
   target == current

r/R/buffer.R

@@ -38,7 +38,8 @@
 Buffer <- R6Class("Buffer", inherit = Object,
   public = list(
     ZeroPadding = function() Buffer__ZeroPadding(self),
-    data = function() Buffer__data(self)
+    data = function() Buffer__data(self),
+    Equals = function(other) Buffer__Equals(self, other)
   ),
 
   active = list(

r/R/chunked-array.R

@@ -83,6 +83,9 @@ ChunkedArray <- R6Class("ChunkedArray", inherit = Object,
         }
       }
       out
+    },
+    Equals = function(other) {
+      ChunkedArray__Equals(self, other)
     }
   ),
   active = list(

r/R/field.R

@@ -67,11 +67,6 @@ Field$create <- function(name, type, metadata) {
   shared_ptr(Field, Field__initialize(name, type, TRUE))
 }
 
-#' @export
-`==.Field` <- function(lhs, rhs){
-  lhs$Equals(rhs)
-}
-
 #' @param name field name
 #' @param type logical type, instance of [DataType]
 #' @param metadata currently ignored

r/R/message.R

@@ -45,9 +45,6 @@ Message <- R6Class("Message", inherit = Object,
   )
 )
 
-#' @export
-`==.Message` <- function(x, y) x$Equals(y)
-
 #' @title class arrow::MessageReader
 #'
 #' @usage NULL

r/R/record-batch.R

@@ -163,11 +163,6 @@ names.RecordBatch <- function(x) {
   x$names()
 }
 
-#' @export
-`==.RecordBatch` <- function(x, y) {
-  x$Equals(y)
-}
-
 #' @importFrom methods as
 #' @export
 `[.RecordBatch` <- function(x, i, j, ..., drop = FALSE) {

r/R/schema.R

@@ -62,9 +62,6 @@ Schema <- R6Class("Schema",
 
 Schema$create <- function(...) shared_ptr(Schema, schema_(.fields(list2(...))))
 
-#' @export
-`==.Schema` <- function(lhs, rhs) lhs$Equals(rhs)
-
 #' @param ... named list of [data types][data-type]
 #' @export
 #' @rdname Schema

r/R/table.R

@@ -146,11 +146,6 @@ Table <- R6Class("Table", inherit = Object,
   )
 )
 
-#' @export
-`==.Table` <- function(x, y) {
-  x$Equals(y)
-}
-
 Table$create <- function(..., schema = NULL){
   dots <- list2(...)
   # making sure there are always names

r/R/type.R

@@ -128,9 +128,6 @@ FixedWidthType <- R6Class("FixedWidthType",
   )
 )
 
-#' @export
-`==.DataType` <- function(lhs, rhs) lhs$Equals(rhs)
-
 Int8 <- R6Class("Int8", inherit = FixedWidthType)
 Int16 <- R6Class("Int16", inherit = FixedWidthType)
 Int32 <- R6Class("Int32", inherit = FixedWidthType)

r/R/write-arrow.R

@@ -30,7 +30,7 @@ to_arrow.data.frame <- function(x) Table$create(!!!x)
 #'
 #' @param x an [arrow::Table][Table], an [arrow::RecordBatch][RecordBatch] or a data.frame
 #'
-#' @param stream where to serialize to
+#' @param sink where to serialize to
 #'
 #' - A [arrow::RecordBatchWriter][RecordBatchWriter]: the `$write()`
 #'      of `x` is used. The stream is left open. This uses the streaming format
@@ -50,20 +50,20 @@ to_arrow.data.frame <- function(x) Table$create(!!!x)
 #' and [arrow::RecordBatchStreamWriter][RecordBatchStreamWriter] can be used for more flexibility.
 #'
 #' @export
-write_arrow <- function(x, stream, ...) {
-  UseMethod("write_arrow", stream)
+write_arrow <- function(x, sink, ...) {
+  UseMethod("write_arrow", sink)
 }
 
 #' @export
-write_arrow.RecordBatchWriter <- function(x, stream, ...){
-  stream$write(x)
+write_arrow.RecordBatchWriter <- function(x, sink, ...){
+  sink$write(x)
 }
 
 #' @export
-write_arrow.character <- function(x, stream, ...) {
-  assert_that(length(stream) == 1L)
+write_arrow.character <- function(x, sink, ...) {
+  assert_that(length(sink) == 1L)
   x <- to_arrow(x)
-  file_stream <- FileOutputStream$create(stream)
+  file_stream <- FileOutputStream$create(sink)
   on.exit(file_stream$close())
   file_writer <- RecordBatchFileWriter$create(file_stream, x$schema)
   on.exit({
@@ -77,7 +77,7 @@ write_arrow.character <- function(x, stream, ...) {
 }
 
 #' @export
-write_arrow.raw <- function(x, stream, ...) {
+write_arrow.raw <- function(x, sink, ...) {
   x <- to_arrow(x)
   schema <- x$schema
 

r/src/buffer.cpp

@@ -62,4 +62,10 @@ Rcpp::RawVector Buffer__data(const std::shared_ptr<arrow::Buffer>& buffer) {
   return Rcpp::RawVector(buffer->data(), buffer->data() + buffer->size());
 }
 
+// [[arrow::export]]
+bool Buffer__Equals(const std::shared_ptr<arrow::Buffer>& x,
+                    const std::shared_ptr<arrow::Buffer>& y) {
+  return x->Equals(*y.get());
+}
+
 #endif

r/src/chunkedarray.cpp

@@ -80,4 +80,10 @@ void ChunkedArray__Validate(const std::shared_ptr<arrow::ChunkedArray>& chunked_
   STOP_IF_NOT_OK(chunked_array->Validate());
 }
 
+// [[arrow::export]]
+bool ChunkedArray__Equals(const std::shared_ptr<arrow::ChunkedArray>& x,
+                          const std::shared_ptr<arrow::ChunkedArray>& y) {
+  return x->Equals(y);
+}
+
 #endif

r/tests/testthat/test-RecordBatch.R

@@ -28,13 +28,13 @@ test_that("RecordBatch", {
   )
   batch <- record_batch(tbl)
 
-  expect_true(batch == batch)
+  expect_equal(batch, batch)
   expect_equal(
     batch$schema,
     schema(
       int = int32(), dbl = float64(),
       lgl = boolean(), chr = utf8(),
-      fct = dictionary()
+      fct = dictionary(int8(), utf8())
     )
   )
   expect_equal(batch$num_columns, 5L)
@@ -69,12 +69,12 @@ test_that("RecordBatch", {
   col_fct <- batch$column(4)
   expect_true(inherits(col_fct, 'Array'))
   expect_equal(col_fct$as_vector(), tbl$fct)
-  expect_equal(col_fct$type, dictionary())
+  expect_equal(col_fct$type, dictionary(int8(), utf8()))
 
   batch2 <- batch$RemoveColumn(0)
   expect_equal(
     batch2$schema,
-    schema(dbl = float64(), lgl = boolean(), chr = utf8(), fct = dictionary())
+    schema(dbl = float64(), lgl = boolean(), chr = utf8(), fct = dictionary(int8(), utf8()))
   )
   expect_equal(batch2$column(0), batch$column(1))
   expect_identical(as.data.frame(batch2), tbl[,-1])
@@ -156,7 +156,7 @@ test_that("RecordBatch with 0 rows are supported", {
       dbl = float64(),
       lgl = boolean(),
       chr = utf8(),
-      fct = dictionary()
+      fct = dictionary(int8(), utf8())
     )
   )
 })
@@ -208,18 +208,20 @@ test_that("record_batch() handles data frame columns", {
   tib <- tibble::tibble(x = 1:10, y = 1:10)
   # because tib is named here, this becomes a struct array
   batch <- record_batch(a = 1:10, b = tib)
-  expect_equal(batch$schema,
+  expect_equal(
+    batch$schema,
     schema(
       a = int32(),
-      struct(x = int32(), y = int32())
+      b = struct(x = int32(), y = int32())
     )
   )
   out <- as.data.frame(batch)
   expect_equivalent(out, tibble::tibble(a = 1:10, b = tib))
 
   # if not named, columns from tib are auto spliced
   batch2 <- record_batch(a = 1:10, tib)
-  expect_equal(batch$schema,
+  expect_equal(
+    batch2$schema,
     schema(a = int32(), x = int32(), y = int32())
   )
   out <- as.data.frame(batch2)
@@ -273,3 +275,4 @@ test_that("record_batch() only auto splice data frames", {
     regexp = "only data frames are allowed as unnamed arguments to be auto spliced"
   )
 })
+

r/tests/testthat/test-Table.R

@@ -111,6 +111,15 @@ test_that("[, [[, $ for Table", {
 })
 
 test_that("head and tail on Table", {
+  tbl <- tibble::tibble(
+    int = 1:10,
+    dbl = as.numeric(1:10),
+    lgl = sample(c(TRUE, FALSE, NA), 10, replace = TRUE),
+    chr = letters[1:10],
+    fct = factor(letters[1:10])
+  )
+  tab <- Table$create(tbl)
+
   expect_identical(as.data.frame(head(tab)), head(tbl))
   expect_identical(as.data.frame(head(tab, 4)), head(tbl, 4))
   expect_identical(as.data.frame(head(tab, -4)), head(tbl, -4))
@@ -137,6 +146,15 @@ test_that("Table print method", {
 })
 
 test_that("table active bindings", {
+  tbl <- tibble::tibble(
+    int = 1:10,
+    dbl = as.numeric(1:10),
+    lgl = sample(c(TRUE, FALSE, NA), 10, replace = TRUE),
+    chr = letters[1:10],
+    fct = factor(letters[1:10])
+  )
+  tab <- Table$create(tbl)
+
   expect_identical(dim(tbl), dim(tab))
   expect_is(tab$columns, "list")
   expect_equal(tab$columns[[1]], tab[[1]])

r/tests/testthat/test-compressed.R

@@ -36,7 +36,6 @@ test_that("can write Buffer to CompressedOutputStream and read back in Compresse
   stream2$close()
   sink2$close()
 
-
   input1 <- CompressedInputStream$create(tf1)
   buf1 <- input1$Read(1024L)