1 files changed, 133 insertions, 0 deletions
diff --git a/src/arrow/r/tests/testthat/test-compute-vector.R b/src/arrow/r/tests/testthat/test-compute-vector.R
new file mode 100644
index 000000000..345da5656
--- /dev/null
+++ b/src/arrow/r/tests/testthat/test-compute-vector.R
@@ -0,0 +1,133 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements.  See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership.  The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License.  You may obtain a copy of the License at
+#
+#   http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied.  See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+expect_bool_function_equal <- function(array_exp, r_exp) {
+  # Assert that the Array operation returns a boolean array
+  # and that its contents are equal to expected
+  expect_r6_class(array_exp, "ArrowDatum")
+  expect_type_equal(array_exp, bool())
+  expect_identical(as.vector(array_exp), r_exp)
+}
+
+expect_array_compares <- function(x, compared_to) {
+  r_values <- as.vector(x)
+  r_compared_to <- as.vector(compared_to)
+  # Iterate over all comparison functions
+  expect_bool_function_equal(x == compared_to, r_values == r_compared_to)
+  expect_bool_function_equal(x != compared_to, r_values != r_compared_to)
+  expect_bool_function_equal(x > compared_to, r_values > r_compared_to)
+  expect_bool_function_equal(x >= compared_to, r_values >= r_compared_to)
+  expect_bool_function_equal(x < compared_to, r_values < r_compared_to)
+  expect_bool_function_equal(x <= compared_to, r_values <= r_compared_to)
+}
+
+test_that("compare ops with Array", {
+  a <- Array$create(1:5)
+  expect_array_compares(a, 4L)
+  expect_array_compares(a, 4) # implicit casting
+  expect_array_compares(a, Scalar$create(4))
+  expect_array_compares(Array$create(c(NA, 1:5)), 4)
+  expect_array_compares(Array$create(as.numeric(c(NA, 1:5))), 4)
+  expect_array_compares(Array$create(c(NA, 1:5)), Array$create(rev(c(NA, 1:5))))
+  expect_array_compares(Array$create(c(NA, 1:5)), Array$create(rev(c(NA, 1:5)), type = double()))
+})
+
+test_that("compare ops with ChunkedArray", {
+  expect_array_compares(ChunkedArray$create(1:3, 4:5), 4L)
+  expect_array_compares(ChunkedArray$create(1:3, 4:5), 4) # implicit casting
+  expect_array_compares(ChunkedArray$create(1:3, 4:5), Scalar$create(4))
+  expect_array_compares(ChunkedArray$create(c(NA, 1:3), 4:5), 4)
+  expect_array_compares(
+    ChunkedArray$create(c(NA, 1:3), 4:5),
+    ChunkedArray$create(4:5, c(NA, 1:3))
+  )
+  expect_array_compares(
+    ChunkedArray$create(c(NA, 1:3), 4:5),
+    Array$create(c(NA, 1:5))
+  )
+  expect_array_compares(
+    Array$create(c(NA, 1:5)),
+    ChunkedArray$create(c(NA, 1:3), 4:5)
+  )
+})
+
+test_that("logic ops with Array", {
+  truth <- expand.grid(left = c(TRUE, FALSE, NA), right = c(TRUE, FALSE, NA))
+  a_left <- Array$create(truth$left)
+  a_right <- Array$create(truth$right)
+  expect_bool_function_equal(a_left & a_right, truth$left & truth$right)
+  expect_bool_function_equal(a_left | a_right, truth$left | truth$right)
+  expect_bool_function_equal(a_left == a_right, truth$left == truth$right)
+  expect_bool_function_equal(a_left != a_right, truth$left != truth$right)
+  expect_bool_function_equal(!a_left, !truth$left)
+
+  # More complexity
+  isEqualTo <- function(x, y) x == y & !is.na(x)
+  expect_bool_function_equal(
+    isEqualTo(a_left, a_right),
+    isEqualTo(truth$left, truth$right)
+  )
+})
+
+test_that("logic ops with ChunkedArray", {
+  truth <- expand.grid(left = c(TRUE, FALSE, NA), right = c(TRUE, FALSE, NA))
+  a_left <- ChunkedArray$create(truth$left)
+  a_right <- ChunkedArray$create(truth$right)
+  expect_bool_function_equal(a_left & a_right, truth$left & truth$right)
+  expect_bool_function_equal(a_left | a_right, truth$left | truth$right)
+  expect_bool_function_equal(a_left == a_right, truth$left == truth$right)
+  expect_bool_function_equal(a_left != a_right, truth$left != truth$right)
+  expect_bool_function_equal(!a_left, !truth$left)
+
+  # More complexity
+  isEqualTo <- function(x, y) x == y & !is.na(x)
+  expect_bool_function_equal(
+    isEqualTo(a_left, a_right),
+    isEqualTo(truth$left, truth$right)
+  )
+})
+
+test_that("call_function validation", {
+  expect_error(
+    call_function("filter", 4),
+    'Argument 1 is of class numeric but it must be one of "Array", "ChunkedArray", "RecordBatch", "Table", or "Scalar"'
+  )
+  expect_error(
+    call_function("filter", Array$create(1:4), 3),
+    "Argument 2 is of class numeric"
+  )
+  expect_error(
+    call_function("filter",
+      Array$create(1:4),
+      Array$create(c(TRUE, FALSE, TRUE)),
+      options = list(keep_na = TRUE)
+    ),
+    "Array arguments must all be the same length"
+  )
+  expect_error(
+    call_function("filter",
+      record_batch(a = 1:3),
+      Array$create(c(TRUE, FALSE, TRUE)),
+      options = list(keep_na = TRUE)
+    ),
+    NA
+  )
+  expect_error(
+    call_function("filter", options = list(keep_na = TRUE)),
+    "accepts 2 arguments"
+  )
+})