ARROW-12871: [R] upgrade to testthat 3e

r/DESCRIPTION

@@ -39,6 +39,7 @@ Imports:
     vctrs
 Roxygen: list(markdown = TRUE, r6 = FALSE, load = "source")
 RoxygenNote: 7.1.2
+Config/testthat/edition: 3
 VignetteBuilder: knitr
 Suggests:
     DBI,

r/NAMESPACE

@@ -185,6 +185,7 @@ export(TimeUnit)
 export(TimestampParser)
 export(Type)
 export(UnionDataset)
+export(all_of)
 export(arrow_available)
 export(arrow_info)
 export(arrow_with_dataset)
@@ -345,6 +346,7 @@ importFrom(stats,na.fail)
 importFrom(stats,na.omit)
 importFrom(stats,na.pass)
 importFrom(stats,quantile)
+importFrom(tidyselect,all_of)
 importFrom(tidyselect,contains)
 importFrom(tidyselect,ends_with)
 importFrom(tidyselect,eval_select)

r/R/dataset.R

@@ -354,7 +354,7 @@ tail.Dataset <- function(x, n = 6L, ...) {
     return(x[, i])
   }
   if (!missing(j)) {
-    x <- select.Dataset(x, j)
+    x <- select.Dataset(x, all_of(j))
   }
 
   if (!missing(i)) {

r/R/dplyr-mutate.R

@@ -89,7 +89,7 @@ mutate.arrow_dplyr_query <- function(.data,
   # Respect .before and .after
   if (!quo_is_null(.before) || !quo_is_null(.after)) {
     new <- setdiff(new_vars, old_vars)
-    .data <- dplyr::relocate(.data, !!new, .before = !!.before, .after = !!.after)
+    .data <- dplyr::relocate(.data, all_of(new), .before = !!.before, .after = !!.after)
   }
 
   # Respect .keep

r/R/reexports-tidyselect.R

@@ -41,3 +41,6 @@ tidyselect::starts_with
 #' @importFrom tidyselect last_col
 #' @export
 tidyselect::last_col
+#' @importFrom tidyselect all_of
+#' @export
+tidyselect::all_of

r/tests/testthat/helper-expectation.R

@@ -15,13 +15,8 @@
 # specific language governing permissions and limitations
 # under the License.
 
-expect_as_vector <- function(x, y, ignore_attr = FALSE, ...) {
-  expect_fun <- if (ignore_attr) {
-    expect_equivalent
-  } else {
-    expect_equal
-  }
-  expect_fun(as.vector(x), y, ...)
+expect_as_vector <- function(x, y, ...) {
+  expect_equal(as.vector(x), y, ...)
 }
 
 expect_data_frame <- function(x, y, ...) {
@@ -33,28 +28,27 @@ expect_r6_class <- function(object, class) {
   expect_s3_class(object, "R6")
 }
 
-expect_equivalent <- function(object, expected, ...) {
-  # HACK: dplyr includes an all.equal.tbl_df method that is causing failures.
-  # They look spurious, like:
-  # `Can't join on 'b' x 'b' because of incompatible types (tbl_df/tbl/data.frame / tbl_df/tbl/data.frame)` # nolint
-  if (tibble::is_tibble(object)) {
-    class(object) <- "data.frame"
-  }
-  if (tibble::is_tibble(expected)) {
-    class(expected) <- "data.frame"
+expect_equal <- function(object, expected, ignore_attr = FALSE, ..., info = NULL, label = NULL) {
+  if (inherits(object, "ArrowObject") && inherits(expected, "ArrowObject")) {
+    mc <- match.call()
+    expect_true(
+      all.equal(object, expected, check.attributes = !ignore_attr),
+      info = info,
+      label = paste(rlang::as_label(mc[["object"]]), "==", rlang::as_label(mc[["expected"]]))
+    )
+  } else {
+    testthat::expect_equal(object, expected, ignore_attr = ignore_attr, ..., info = info, label = label)
   }
-  testthat::expect_equivalent(object, expected, ...)
 }
 
-# expect_equal but for DataTypes, so the error prints better
 expect_type_equal <- function(object, expected, ...) {
   if (is.Array(object)) {
     object <- object$type
   }
   if (is.Array(expected)) {
     expected <- expected$type
   }
-  expect_equal(object, expected, ..., label = object$ToString(), expected.label = expected$ToString())
+  expect_equal(object, expected, ...)
 }
 
 expect_match_arg_error <- function(object, values = c()) {
@@ -79,7 +73,7 @@ verify_output <- function(...) {
 #'     * `NA` (the default) for ensuring no warning message
 #'     * `TRUE` is a special case to mean to check for the
 #'      "not supported in Arrow; pulling data into R" message.
-#' @param ... additional arguments, passed to `expect_equivalent()`
+#' @param ... additional arguments, passed to `expect_equal()`
 expect_dplyr_equal <- function(expr,
                                tbl,
                                skip_record_batch = NULL,

r/tests/testthat/helper-parquet.R

@@ -16,7 +16,7 @@
 # under the License.
 
 expect_parquet_roundtrip <- function(tab, ...) {
-  expect_equivalent(parquet_roundtrip(tab, ...), tab)
+  expect_equal(parquet_roundtrip(tab, ...), tab)
 }
 
 parquet_roundtrip <- function(x, ...) {

r/tests/testthat/helper-roundtrip.R

@@ -17,27 +17,28 @@
 
 expect_array_roundtrip <- function(x, type, as = NULL) {
   a <- Array$create(x, type = as)
-  expect_type_equal(a$type, type)
+  expect_equal(a$type, type)
   expect_identical(length(a), length(x))
   if (!inherits(type, c("ListType", "LargeListType", "FixedSizeListType"))) {
     # TODO: revisit how missingness works with ListArrays
     # R list objects don't handle missingness the same way as other vectors.
     # Is there some vctrs thing we should do on the roundtrip back to R?
-    expect_equal(as.vector(is.na(a)), is.na(x))
+    expect_as_vector(is.na(a), is.na(x))
   }
-  expect_equivalent(as.vector(a), x)
+  roundtrip <- as.vector(a)
+  expect_equal(roundtrip, x, ignore_attr = TRUE)
   # Make sure the storage mode is the same on roundtrip (esp. integer vs. numeric)
-  expect_identical(typeof(as.vector(a)), typeof(x))
+  expect_identical(typeof(roundtrip), typeof(x))
 
   if (length(x)) {
     a_sliced <- a$Slice(1)
     x_sliced <- x[-1]
-    expect_type_equal(a_sliced$type, type)
+    expect_equal(a_sliced$type, type)
     expect_identical(length(a_sliced), length(x_sliced))
     if (!inherits(type, c("ListType", "LargeListType", "FixedSizeListType"))) {
-      expect_equal(as.vector(is.na(a_sliced)), is.na(x_sliced))
+      expect_as_vector(is.na(a_sliced), is.na(x_sliced))
     }
-    expect_equivalent(as.vector(a_sliced), x_sliced)
+    expect_as_vector(a_sliced, x_sliced, ignore_attr = TRUE)
   }
   invisible(a)
 }

r/tests/testthat/test-Array.R

@@ -15,8 +15,6 @@
 # specific language governing permissions and limitations
 # under the License.
 
-context("Array")
-
 test_that("Integer Array", {
   ints <- c(1:10, 1:10, 1:5)
   x <- expect_array_roundtrip(ints, int32())
@@ -157,8 +155,8 @@ test_that("Array supports NA", {
   expect_true(x_int$IsNull(10L))
   expect_true(x_dbl$IsNull(10))
 
-  expect_equal(as.vector(is.na(x_int)), c(rep(FALSE, 10), TRUE))
-  expect_equal(as.vector(is.na(x_dbl)), c(rep(FALSE, 10), TRUE))
+  expect_as_vector(is.na(x_int), c(rep(FALSE, 10), TRUE))
+  expect_as_vector(is.na(x_dbl), c(rep(FALSE, 10), TRUE))
 
   # Input validation
   expect_error(x_int$IsValid("ten"))
@@ -438,12 +436,12 @@ test_that("Array<int8>$as_vector() converts to integer (ARROW-3794)", {
   i8 <- (-128):127
   a <- Array$create(i8)$cast(int8())
   expect_type_equal(a, int8())
-  expect_equal(as.vector(a), i8)
+  expect_as_vector(a, i8)
 
   u8 <- 0:255
   a <- Array$create(u8)$cast(uint8())
   expect_type_equal(a, uint8())
-  expect_equal(as.vector(a), u8)
+  expect_as_vector(a, u8)
 })
 
 test_that("Arrays of {,u}int{32,64} convert to integer if they can fit", {
@@ -474,15 +472,15 @@ test_that("Array$create() handles data frame -> struct arrays (ARROW-3811)", {
   df <- tibble::tibble(x = 1:10, y = x / 2, z = letters[1:10])
   a <- Array$create(df)
   expect_type_equal(a$type, struct(x = int32(), y = float64(), z = utf8()))
-  expect_equivalent(as.vector(a), df)
+  expect_as_vector(a, df)
 
   df <- structure(
     list(col = structure(list(structure(list(list(structure(1))), class = "inner")), class = "outer")),
     class = "data.frame", row.names = c(NA, -1L)
   )
   a <- Array$create(df)
   expect_type_equal(a$type, struct(col = list_of(list_of(list_of(float64())))))
-  expect_equivalent(as.vector(a), df)
+  expect_as_vector(a, df, ignore_attr = TRUE)
 })
 
 test_that("StructArray methods", {
@@ -791,7 +789,7 @@ test_that("is.Array", {
 
 test_that("Array$Take()", {
   a <- Array$create(10:20)
-  expect_equal(as.vector(a$Take(c(4, 2))), c(14, 12))
+  expect_as_vector(a$Take(c(4, 2)), c(14, 12))
 })
 
 test_that("[ method on Array", {

r/tests/testthat/test-RecordBatch.R

@@ -339,15 +339,15 @@ 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_equivalent(
+  expect_equal(
     batch$schema,
     schema(
       a = int32(),
       b = struct(x = int32(), y = int32())
     )
   )
   out <- as.data.frame(batch)
-  expect_equivalent(out, tibble::tibble(a = 1:10, b = tib))
+  expect_equal(out, tibble::tibble(a = 1:10, b = tib))
 
   # if not named, columns from tib are auto spliced
   batch2 <- record_batch(a = 1:10, tib)
@@ -356,7 +356,7 @@ test_that("record_batch() handles data frame columns", {
     schema(a = int32(), x = int32(), y = int32())
   )
   out <- as.data.frame(batch2)
-  expect_equivalent(out, tibble::tibble(a = 1:10, !!!tib))
+  expect_equal(out, tibble::tibble(a = 1:10, !!!tib))
 })
 
 test_that("record_batch() handles data frame columns with schema spec", {
@@ -365,9 +365,9 @@ test_that("record_batch() handles data frame columns with schema spec", {
   tib_float$y <- as.numeric(tib_float$y)
   schema <- schema(a = int32(), b = struct(x = int16(), y = float64()))
   batch <- record_batch(a = 1:10, b = tib, schema = schema)
-  expect_equivalent(batch$schema, schema)
+  expect_equal(batch$schema, schema)
   out <- as.data.frame(batch)
-  expect_equivalent(out, tibble::tibble(a = 1:10, b = tib_float))
+  expect_equal(out, tibble::tibble(a = 1:10, b = tib_float))
 
   schema <- schema(a = int32(), b = struct(x = int16(), y = utf8()))
   expect_error(record_batch(a = 1:10, b = tib, schema = schema))
@@ -385,21 +385,27 @@ test_that("record_batch() auto splices (ARROW-5718)", {
   batch4 <- record_batch(!!!df, z = 1:10)
   expect_equal(batch3, batch4)
   expect_equal(batch3$schema, schema(x = int32(), y = utf8(), z = int32()))
-  expect_equivalent(as.data.frame(batch3), cbind(df, data.frame(z = 1:10)))
+  expect_equal(
+    as.data.frame(batch3),
+    tibble::as_tibble(cbind(df, data.frame(z = 1:10)))
+  )
 
   s <- schema(x = float64(), y = utf8())
   batch5 <- record_batch(df, schema = s)
   batch6 <- record_batch(!!!df, schema = s)
   expect_equal(batch5, batch6)
   expect_equal(batch5$schema, s)
-  expect_equivalent(as.data.frame(batch5), df)
+  expect_equal(as.data.frame(batch5), df)
 
   s2 <- schema(x = float64(), y = utf8(), z = int16())
   batch7 <- record_batch(df, z = 1:10, schema = s2)
   batch8 <- record_batch(!!!df, z = 1:10, schema = s2)
   expect_equal(batch7, batch8)
   expect_equal(batch7$schema, s2)
-  expect_equivalent(as.data.frame(batch7), cbind(df, data.frame(z = 1:10)))
+  expect_equal(
+    as.data.frame(batch7),
+    tibble::as_tibble(cbind(df, data.frame(z = 1:10)))
+  )
 })
 
 test_that("record_batch() only auto splice data frames", {
@@ -411,7 +417,11 @@ test_that("record_batch() only auto splice data frames", {
 
 test_that("record_batch() handles null type (ARROW-7064)", {
   batch <- record_batch(a = 1:10, n = vctrs::unspecified(10))
-  expect_equivalent(batch$schema, schema(a = int32(), n = null()))
+  expect_equal(
+    batch$schema,
+    schema(a = int32(), n = null()),
+    ignore_attr = TRUE
+  )
 })
 
 test_that("record_batch() scalar recycling with vectors", {
@@ -481,7 +491,7 @@ test_that("RecordBatch$Equals(check_metadata)", {
   expect_false(rb1$Equals(rb2, check_metadata = TRUE))
 
   expect_failure(expect_equal(rb1, rb2)) # expect_equal has check_metadata=TRUE
-  expect_equivalent(rb1, rb2) # expect_equivalent has check_metadata=FALSE
+  expect_equal(rb1, rb2, ignore_attr = TRUE) # this passes check_metadata=FALSE
 
   expect_false(rb1$Equals(24)) # Not a RecordBatch
 })
@@ -526,9 +536,10 @@ test_that("Handling string data with embedded nuls", {
 
   withr::with_options(list(arrow.skip_nul = TRUE), {
     expect_warning(
-      expect_equivalent(
+      expect_equal(
         as.data.frame(batch_with_nul)$b,
-        c("person", "woman", "man", "camera", "tv")
+        c("person", "woman", "man", "camera", "tv"),
+        ignore_attr = TRUE
       ),
       "Stripping '\\0' (nul) from character vector",
       fixed = TRUE

r/tests/testthat/test-Table.R

@@ -306,7 +306,7 @@ test_that("table() handles record batches with splicing", {
   tab <- Table$create(batch, batch, batch)
   expect_equal(tab$schema, batch$schema)
   expect_equal(tab$num_rows, 6L)
-  expect_equivalent(
+  expect_equal(
     as.data.frame(tab),
     vctrs::vec_rbind(as.data.frame(batch), as.data.frame(batch), as.data.frame(batch))
   )
@@ -315,7 +315,7 @@ test_that("table() handles record batches with splicing", {
   tab <- Table$create(!!!batches)
   expect_equal(tab$schema, batch$schema)
   expect_equal(tab$num_rows, 6L)
-  expect_equivalent(
+  expect_equal(
     as.data.frame(tab),
     vctrs::vec_rbind(!!!purrr::map(batches, as.data.frame))
   )
@@ -347,14 +347,14 @@ test_that("table() auto splices (ARROW-5718)", {
   tab2 <- Table$create(!!!df)
   expect_equal(tab1, tab2)
   expect_equal(tab1$schema, schema(x = int32(), y = utf8()))
-  expect_equivalent(as.data.frame(tab1), df)
+  expect_equal(as.data.frame(tab1), df)
 
   s <- schema(x = float64(), y = utf8())
   tab3 <- Table$create(df, schema = s)
   tab4 <- Table$create(!!!df, schema = s)
   expect_equal(tab3, tab4)
   expect_equal(tab3$schema, s)
-  expect_equivalent(as.data.frame(tab3), df)
+  expect_equal(as.data.frame(tab3), df)
 })
 
 test_that("Validation when creating table with schema (ARROW-10953)", {
@@ -412,14 +412,14 @@ test_that("Table$Equals(check_metadata)", {
   expect_false(tab1$Equals(tab2, check_metadata = TRUE))
 
   expect_failure(expect_equal(tab1, tab2)) # expect_equal has check_metadata=TRUE
-  expect_equivalent(tab1, tab2) # expect_equivalent has check_metadata=FALSE
+  expect_equal(tab1, tab2, ignore_attr = TRUE) # this sets check_metadata=FALSE
 
   expect_false(tab1$Equals(24)) # Not a Table
 })
 
 test_that("Table handles null type (ARROW-7064)", {
   tab <- Table$create(a = 1:10, n = vctrs::unspecified(10))
-  expect_equivalent(tab$schema, schema(a = int32(), n = null()))
+  expect_equal(tab$schema, schema(a = int32(), n = null()), ignore_attr = TRUE)
 })
 
 test_that("Can create table with specific dictionary types", {