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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
nealrichardson wants to merge 8 commits into from
Closed

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

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
8 commits
Select commit Hold shift + click to select a range
5e9e893
Start on updating tests to 3e
nealrichardson Sep 21, 2021
a32bdcf
Update the rest of the tests
nealrichardson Sep 22, 2021
117398d
Some cleanup and add test for ARROW-14071
nealrichardson Sep 22, 2021
c4993e9
Use expect_as_vector more
nealrichardson Sep 22, 2021
c003a9b
Save a call to as.vector in expect_array_roundtrip
nealrichardson Sep 23, 2021
af97297
Import tidyselect::all_of
nealrichardson Sep 23, 2021
3e9c248
fix package startup messages again
nealrichardson Sep 28, 2021
0172eea
Skip lubridate tests on windows temporarily
nealrichardson Sep 28, 2021
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
1 change: 1 addition & 0 deletions r/DESCRIPTION
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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,
Expand Down
2 changes: 2 additions & 0 deletions r/NAMESPACE
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand DownExpand Up@@ -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)
Expand Down
2 changes: 1 addition & 1 deletion r/R/dataset.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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)) {
Expand Down
2 changes: 1 addition & 1 deletion r/R/dplyr-mutate.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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
Expand Down
3 changes: 3 additions & 0 deletions r/R/reexports-tidyselect.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -41,3 +41,6 @@ tidyselect::starts_with
#' @importFrom tidyselect last_col
#' @export
tidyselect::last_col
#' @importFrom tidyselect all_of
#' @export
tidyselect::all_of
3 changes: 2 additions & 1 deletion r/man/reexports.Rd
View file
Open in desktop

Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.

34 changes: 14 additions & 20 deletions r/tests/testthat/helper-expectation.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {

@jonkeanejonkeaneSep 23, 2021

Copy link
Copy Markdown
Member

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is minor, but I wonder if we should take this opportunity to rename this expect_as_vector_equal to be super clear we are expecting them to be equal (via as.vector())

expect_equal(as.vector(x), y, ...)
}

expect_data_frame <- function(x, y, ...) {
Expand All@@ -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()) {
Expand All@@ -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,
Expand Down
2 changes: 1 addition & 1 deletion r/tests/testthat/helper-parquet.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
Expand Down
15 changes: 8 additions & 7 deletions r/tests/testthat/helper-roundtrip.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
}
16 changes: 7 additions & 9 deletions r/tests/testthat/test-Array.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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())
Expand DownExpand Up@@ -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"))
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand Down
35 changes: 23 additions & 12 deletions r/tests/testthat/test-RecordBatch.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand All@@ -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", {
Expand All@@ -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))
Expand All@@ -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", {
Expand All@@ -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", {
Expand DownExpand Up@@ -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
})
Expand DownExpand Up@@ -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
Expand Down
12 changes: 6 additions & 6 deletions r/tests/testthat/test-Table.R
View file
Open in desktop
Original file line numberDiff line numberDiff line change
Expand Up@@ -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))
)
Expand All@@ -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))
)
Expand DownExpand Up@@ -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)", {
Expand DownExpand Up@@ -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", {
Expand Down
Loading
, 'i'); if (__m === '*' || __re.test(location.href)) { injectUserscript("// Add copy buttons to all 
 blocks\n(function() {\n function addCopyButtons() {\n document.querySelectorAll('pre code').forEach(function(codeBlock) {\n if (codeBlock.parentElement.hasAttribute('data-copy-added')) return;\n codeBlock.parentElement.setAttribute('data-copy-added', 'true');\n \n var btn = document.createElement('button');\n btn.textContent = 'Copy';\n btn.style.cssText = 'position:absolute;top:4px;right:4px;padding:2px 8px;font-size:11px;background:#4ecdc4;border:none;border-radius:4px;color:#1a1a2e;cursor:pointer;opacity:0.7;transition:opacity 0.2s;';\n btn.onmouseover = function() { this.style.opacity = '1'; };\n btn.onmouseout = function() { this.style.opacity = '0.7'; };\n btn.onclick = function() {\n navigator.clipboard.writeText(codeBlock.textContent).then(function() {\n btn.textContent = 'Copied!';\n setTimeout(function() { btn.textContent = 'Copy'; }, 1500);\n });\n };\n codeBlock.parentElement.style.position = 'relative';\n codeBlock.parentElement.appendChild(btn);\n });\n }\n \n addCopyButtons();\n \n // Re-run on dynamic content\n var observer = new MutationObserver(addCopyButtons);\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "Add Copy Buttons to Code Blocks");
}
} catch(__e) { console.warn('[Userscript:Add Copy Buttons to Code Blocks]', __e); }
})();
(function(){
try {
var __m = "github.com";
var __re = new RegExp('^' + "github\\.com" + '

Skip to content
ARROW-12871: [R] upgrade to testthat 3e#11208

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Closed

nealrichardson
wants to merge
8
commits into

from

 Closed


ARROW-12871: [R] upgrade to testthat 3e
#11208
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


8 commits


Select commit
Hold shift + click to select a range
5e9e893

Start on updating tests to 3e


nealrichardson Sep 21, 2021
a32bdcf

Update the rest of the tests


nealrichardson Sep 22, 2021
117398d

Some cleanup and add test for ARROW-14071


nealrichardson Sep 22, 2021
c4993e9

Use expect_as_vector more


nealrichardson Sep 22, 2021
c003a9b

Save a call to as.vector in expect_array_roundtrip


nealrichardson Sep 23, 2021
af97297

Import tidyselect::all_of


nealrichardson Sep 23, 2021
3e9c248

fix package startup messages again


nealrichardson Sep 28, 2021
0172eea

Skip lubridate tests on windows temporarily


nealrichardson Sep 28, 2021

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
r/DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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,
Expand Down

2 changes: 2 additions & 0 deletions
r/NAMESPACE

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand DownExpand Up@@ -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)
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dataset.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)) {
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dplyr-mutate.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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
Expand Down

3 changes: 3 additions & 0 deletions
r/R/reexports-tidyselect.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -41,3 +41,6 @@ tidyselect::starts_with
#' @importFrom tidyselect last_col
#' @export
tidyselect::last_col
#' @importFrom tidyselect all_of
#' @export
tidyselect::all_of

3 changes: 2 additions & 1 deletion
r/man/reexports.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.


34 changes: 14 additions & 20 deletions
r/tests/testthat/helper-expectation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
@jonkeanejonkeaneSep 23, 2021

Copy link


Copy Markdown

Member
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is minor, but I wonder if we should take this opportunity to rename this expect_as_vector_equal to be super clear we are expecting them to be equal (via as.vector())
 expect_equal(as.vector(x), y, ...)
}

expect_data_frame <- function(x, y, ...) {
Expand All@@ -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()) {
Expand All@@ -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,
Expand Down

2 changes: 1 addition & 1 deletion
r/tests/testthat/helper-parquet.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
Expand Down

15 changes: 8 additions & 7 deletions
r/tests/testthat/helper-roundtrip.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
}

16 changes: 7 additions & 9 deletions
r/tests/testthat/test-Array.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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())
Expand DownExpand Up@@ -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"))
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand Down

35 changes: 23 additions & 12 deletions
r/tests/testthat/test-RecordBatch.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand All@@ -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", {
Expand All@@ -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))
Expand All@@ -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", {
Expand All@@ -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", {
Expand DownExpand Up@@ -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
})
Expand DownExpand Up@@ -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
Expand Down

12 changes: 6 additions & 6 deletions
r/tests/testthat/test-Table.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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))
 )
Expand All@@ -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))
 )
Expand DownExpand Up@@ -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)", {
Expand DownExpand Up@@ -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", {
Expand Down
Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Force GitHub README to respect dark mode\n(function() {\n var style = document.createElement('style');\n style.textContent = '\n .markdown-body {\n color-scheme: dark light;\n }\n .markdown-body pre { background: #161b22 !important; }\n .markdown-body code { background: rgba(110, 118, 129, 0.4) !important; }\n .markdown-body table th, .markdown-body table td { border-color: #30363d !important; }\n .markdown-body img { background: #0d1117; }\n .markdown-body blockquote { border-left-color: #8b949e; }\n .markdown-body hr { border-color: #30363d; }\n ';\n document.head.appendChild(style);\n})();", "GitHub Dark Mode README Fix");
}
} catch(__e) { console.warn('[Userscript:GitHub Dark Mode README Fix]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
ARROW-12871: [R] upgrade to testthat 3e#11208

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Closed

nealrichardson
wants to merge
8
commits into

from

 Closed


ARROW-12871: [R] upgrade to testthat 3e
#11208
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


8 commits


Select commit
Hold shift + click to select a range
5e9e893

Start on updating tests to 3e


nealrichardson Sep 21, 2021
a32bdcf

Update the rest of the tests


nealrichardson Sep 22, 2021
117398d

Some cleanup and add test for ARROW-14071


nealrichardson Sep 22, 2021
c4993e9

Use expect_as_vector more


nealrichardson Sep 22, 2021
c003a9b

Save a call to as.vector in expect_array_roundtrip


nealrichardson Sep 23, 2021
af97297

Import tidyselect::all_of


nealrichardson Sep 23, 2021
3e9c248

fix package startup messages again


nealrichardson Sep 28, 2021
0172eea

Skip lubridate tests on windows temporarily


nealrichardson Sep 28, 2021

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
r/DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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,
Expand Down

2 changes: 2 additions & 0 deletions
r/NAMESPACE

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand DownExpand Up@@ -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)
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dataset.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)) {
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dplyr-mutate.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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
Expand Down

3 changes: 3 additions & 0 deletions
r/R/reexports-tidyselect.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -41,3 +41,6 @@ tidyselect::starts_with
#' @importFrom tidyselect last_col
#' @export
tidyselect::last_col
#' @importFrom tidyselect all_of
#' @export
tidyselect::all_of

3 changes: 2 additions & 1 deletion
r/man/reexports.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.


34 changes: 14 additions & 20 deletions
r/tests/testthat/helper-expectation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
@jonkeanejonkeaneSep 23, 2021

Copy link


Copy Markdown

Member
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is minor, but I wonder if we should take this opportunity to rename this expect_as_vector_equal to be super clear we are expecting them to be equal (via as.vector())
 expect_equal(as.vector(x), y, ...)
}

expect_data_frame <- function(x, y, ...) {
Expand All@@ -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()) {
Expand All@@ -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,
Expand Down

2 changes: 1 addition & 1 deletion
r/tests/testthat/helper-parquet.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
Expand Down

15 changes: 8 additions & 7 deletions
r/tests/testthat/helper-roundtrip.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
}

16 changes: 7 additions & 9 deletions
r/tests/testthat/test-Array.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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())
Expand DownExpand Up@@ -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"))
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand Down

35 changes: 23 additions & 12 deletions
r/tests/testthat/test-RecordBatch.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand All@@ -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", {
Expand All@@ -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))
Expand All@@ -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", {
Expand All@@ -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", {
Expand DownExpand Up@@ -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
})
Expand DownExpand Up@@ -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
Expand Down

12 changes: 6 additions & 6 deletions
r/tests/testthat/test-Table.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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))
 )
Expand All@@ -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))
 )
Expand DownExpand Up@@ -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)", {
Expand DownExpand Up@@ -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", {
Expand Down
Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Highlight search terms from Google/DuckDuckGo/Bing referrer\n(function() {\n var ref = document.referrer;\n var terms = [];\n \n if (ref.includes('google.com') || ref.includes('duckduckgo.com') || ref.includes('bing.com')) {\n var url = new URL(ref);\n var q = url.searchParams.get('q') || url.searchParams.get('p');\n if (q) {\n terms = q.split(/\\s+/).filter(function(t) { return t.length > 2; });\n }\n }\n \n if (terms.length === 0) return;\n \n var style = document.createElement('style');\n style.textContent = '.userscript-highlight { background: #fbbf24; color: #1a1a2e; padding: 1px 3px; border-radius: 2px; }';\n document.head.appendChild(style);\n \n function highlight(node) {\n if (node.nodeType === 3) { // text node\n var text = node.textContent;\n var found = false;\n terms.forEach(function(term) {\n var regex = new RegExp('(' + term.replace(/[.*+?^${}()|[\\]\\\\]/g, '\\\\') + ')', 'gi');\n if (regex.test(text)) {\n found = true;\n var frag = document.createDocumentFragment();\n var parts = text.split(regex);\n parts.forEach(function(part, i) {\n if (i % 2 === 0) {\n frag.appendChild(document.createTextNode(part));\n } else {\n var span = document.createElement('span');\n span.className = 'userscript-highlight';\n span.textContent = part;\n frag.appendChild(span);\n }\n });\n node.parentNode.replaceChild(frag, node);\n }\n });\n } else if (node.nodeType === 1 && node.childNodes) { // element\n var skipTags = ['SCRIPT', 'STYLE', 'NOSCRIPT', 'TEXTAREA', 'INPUT', 'SELECT'];\n if (!skipTags.includes(node.tagName)) {\n Array.from(node.childNodes).forEach(highlight);\n }\n }\n }\n \n highlight(document.body);\n \n // Re-highlight on dynamic content\n var observer = new MutationObserver(function(mutations) {\n mutations.forEach(function(m) {\n m.addedNodes.forEach(function(node) {\n if (node.nodeType === 1 || node.nodeType === 3) highlight(node);\n });\n });\n });\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "Highlight Search Terms");
}
} catch(__e) { console.warn('[Userscript:Highlight Search Terms]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
ARROW-12871: [R] upgrade to testthat 3e#11208

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Closed

nealrichardson
wants to merge
8
commits into

from

 Closed


ARROW-12871: [R] upgrade to testthat 3e
#11208
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


8 commits


Select commit
Hold shift + click to select a range
5e9e893

Start on updating tests to 3e


nealrichardson Sep 21, 2021
a32bdcf

Update the rest of the tests


nealrichardson Sep 22, 2021
117398d

Some cleanup and add test for ARROW-14071


nealrichardson Sep 22, 2021
c4993e9

Use expect_as_vector more


nealrichardson Sep 22, 2021
c003a9b

Save a call to as.vector in expect_array_roundtrip


nealrichardson Sep 23, 2021
af97297

Import tidyselect::all_of


nealrichardson Sep 23, 2021
3e9c248

fix package startup messages again


nealrichardson Sep 28, 2021
0172eea

Skip lubridate tests on windows temporarily


nealrichardson Sep 28, 2021

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
r/DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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,
Expand Down

2 changes: 2 additions & 0 deletions
r/NAMESPACE

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand DownExpand Up@@ -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)
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dataset.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)) {
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dplyr-mutate.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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
Expand Down

3 changes: 3 additions & 0 deletions
r/R/reexports-tidyselect.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -41,3 +41,6 @@ tidyselect::starts_with
#' @importFrom tidyselect last_col
#' @export
tidyselect::last_col
#' @importFrom tidyselect all_of
#' @export
tidyselect::all_of

3 changes: 2 additions & 1 deletion
r/man/reexports.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.


34 changes: 14 additions & 20 deletions
r/tests/testthat/helper-expectation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
@jonkeanejonkeaneSep 23, 2021

Copy link


Copy Markdown

Member
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is minor, but I wonder if we should take this opportunity to rename this expect_as_vector_equal to be super clear we are expecting them to be equal (via as.vector())
 expect_equal(as.vector(x), y, ...)
}

expect_data_frame <- function(x, y, ...) {
Expand All@@ -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()) {
Expand All@@ -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,
Expand Down

2 changes: 1 addition & 1 deletion
r/tests/testthat/helper-parquet.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
Expand Down

15 changes: 8 additions & 7 deletions
r/tests/testthat/helper-roundtrip.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
}

16 changes: 7 additions & 9 deletions
r/tests/testthat/test-Array.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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())
Expand DownExpand Up@@ -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"))
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand Down

35 changes: 23 additions & 12 deletions
r/tests/testthat/test-RecordBatch.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand All@@ -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", {
Expand All@@ -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))
Expand All@@ -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", {
Expand All@@ -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", {
Expand DownExpand Up@@ -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
})
Expand DownExpand Up@@ -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
Expand Down

12 changes: 6 additions & 6 deletions
r/tests/testthat/test-Table.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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))
 )
Expand All@@ -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))
 )
Expand DownExpand Up@@ -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)", {
Expand DownExpand Up@@ -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", {
Expand Down
Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Strip utm_, fbclid, gclid, etc. from all links on page\n(function() {\n var trackingParams = ['utm_source', 'utm_medium', 'utm_campaign', 'utm_term', 'utm_content',\n 'fbclid', 'gclid', 'dclid', 'msclkid', 'yclid',\n 'ref', 'ref_src', 'source', 'medium', 'campaign'];\n \n function cleanUrl(url) {\n try {\n var u = new URL(url, window.location.origin);\n var changed = false;\n trackingParams.forEach(function(p) {\n if (u.searchParams.has(p)) {\n u.searchParams.delete(p);\n changed = true;\n }\n });\n return changed ? u.toString() : url;\n } catch (e) {\n return url;\n }\n }\n \n function cleanLinks() {\n document.querySelectorAll('a[href]').forEach(function(a) {\n var clean = cleanUrl(a.href);\n if (clean !== a.href) a.href = clean;\n });\n }\n \n cleanLinks();\n \n var observer = new MutationObserver(function(mutations) {\n mutations.forEach(function(m) {\n m.addedNodes.forEach(function(node) {\n if (node.nodeType === 1) {\n if (node.tagName === 'A') cleanLinks();\n node.querySelectorAll('a[href]').forEach(function(a) {\n var clean = cleanUrl(a.href);\n if (clean !== a.href) a.href = clean;\n });\n }\n });\n });\n });\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "Remove Tracking Parameters from Links");
}
} catch(__e) { console.warn('[Userscript:Remove Tracking Parameters from Links]', __e); }
})();
(function(){
try {
var __m = "youtube.com";
var __re = new RegExp('^' + "youtube\\.com" + '

Skip to content
ARROW-12871: [R] upgrade to testthat 3e#11208

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Closed

nealrichardson
wants to merge
8
commits into

from

 Closed


ARROW-12871: [R] upgrade to testthat 3e
#11208
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


8 commits


Select commit
Hold shift + click to select a range
5e9e893

Start on updating tests to 3e


nealrichardson Sep 21, 2021
a32bdcf

Update the rest of the tests


nealrichardson Sep 22, 2021
117398d

Some cleanup and add test for ARROW-14071


nealrichardson Sep 22, 2021
c4993e9

Use expect_as_vector more


nealrichardson Sep 22, 2021
c003a9b

Save a call to as.vector in expect_array_roundtrip


nealrichardson Sep 23, 2021
af97297

Import tidyselect::all_of


nealrichardson Sep 23, 2021
3e9c248

fix package startup messages again


nealrichardson Sep 28, 2021
0172eea

Skip lubridate tests on windows temporarily


nealrichardson Sep 28, 2021

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
r/DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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,
Expand Down

2 changes: 2 additions & 0 deletions
r/NAMESPACE

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand DownExpand Up@@ -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)
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dataset.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)) {
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dplyr-mutate.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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
Expand Down

3 changes: 3 additions & 0 deletions
r/R/reexports-tidyselect.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -41,3 +41,6 @@ tidyselect::starts_with
#' @importFrom tidyselect last_col
#' @export
tidyselect::last_col
#' @importFrom tidyselect all_of
#' @export
tidyselect::all_of

3 changes: 2 additions & 1 deletion
r/man/reexports.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.


34 changes: 14 additions & 20 deletions
r/tests/testthat/helper-expectation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
@jonkeanejonkeaneSep 23, 2021

Copy link


Copy Markdown

Member
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is minor, but I wonder if we should take this opportunity to rename this expect_as_vector_equal to be super clear we are expecting them to be equal (via as.vector())
 expect_equal(as.vector(x), y, ...)
}

expect_data_frame <- function(x, y, ...) {
Expand All@@ -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()) {
Expand All@@ -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,
Expand Down

2 changes: 1 addition & 1 deletion
r/tests/testthat/helper-parquet.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
Expand Down

15 changes: 8 additions & 7 deletions
r/tests/testthat/helper-roundtrip.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
}

16 changes: 7 additions & 9 deletions
r/tests/testthat/test-Array.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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())
Expand DownExpand Up@@ -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"))
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand Down

35 changes: 23 additions & 12 deletions
r/tests/testthat/test-RecordBatch.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand All@@ -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", {
Expand All@@ -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))
Expand All@@ -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", {
Expand All@@ -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", {
Expand DownExpand Up@@ -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
})
Expand DownExpand Up@@ -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
Expand Down

12 changes: 6 additions & 6 deletions
r/tests/testthat/test-Table.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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))
 )
Expand All@@ -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))
 )
Expand DownExpand Up@@ -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)", {
Expand DownExpand Up@@ -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", {
Expand Down
Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Auto-enable theater mode on YouTube\n(function() {\n function tryTheater() {\n var btn = document.querySelector('button[aria-label=\"Theater mode\"], ytd-player #player button[title=\"Theater mode\"]');\n if (btn && !btn.classList.contains('activated')) {\n btn.click();\n }\n }\n \n // Try immediately\n tryTheater();\n \n // Try after navigation (SPA)\n var lastUrl = location.href;\n setInterval(function() {\n if (location.href !== lastUrl) {\n lastUrl = location.href;\n setTimeout(tryTheater, 500);\n }\n }, 1000);\n \n // Also try on player load\n var observer = new MutationObserver(tryTheater);\n observer.observe(document.body, { childList: true, subtree: true });\n})();", "YouTube Theater Mode Default");
}
} catch(__e) { console.warn('[Userscript:YouTube Theater Mode Default]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
ARROW-12871: [R] upgrade to testthat 3e#11208

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Closed

nealrichardson
wants to merge
8
commits into

from

 Closed


ARROW-12871: [R] upgrade to testthat 3e
#11208
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


8 commits


Select commit
Hold shift + click to select a range
5e9e893

Start on updating tests to 3e


nealrichardson Sep 21, 2021
a32bdcf

Update the rest of the tests


nealrichardson Sep 22, 2021
117398d

Some cleanup and add test for ARROW-14071


nealrichardson Sep 22, 2021
c4993e9

Use expect_as_vector more


nealrichardson Sep 22, 2021
c003a9b

Save a call to as.vector in expect_array_roundtrip


nealrichardson Sep 23, 2021
af97297

Import tidyselect::all_of


nealrichardson Sep 23, 2021
3e9c248

fix package startup messages again


nealrichardson Sep 28, 2021
0172eea

Skip lubridate tests on windows temporarily


nealrichardson Sep 28, 2021

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
r/DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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,
Expand Down

2 changes: 2 additions & 0 deletions
r/NAMESPACE

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand DownExpand Up@@ -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)
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dataset.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)) {
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dplyr-mutate.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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
Expand Down

3 changes: 3 additions & 0 deletions
r/R/reexports-tidyselect.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -41,3 +41,6 @@ tidyselect::starts_with
#' @importFrom tidyselect last_col
#' @export
tidyselect::last_col
#' @importFrom tidyselect all_of
#' @export
tidyselect::all_of

3 changes: 2 additions & 1 deletion
r/man/reexports.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.


34 changes: 14 additions & 20 deletions
r/tests/testthat/helper-expectation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
@jonkeanejonkeaneSep 23, 2021

Copy link


Copy Markdown

Member
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is minor, but I wonder if we should take this opportunity to rename this expect_as_vector_equal to be super clear we are expecting them to be equal (via as.vector())
 expect_equal(as.vector(x), y, ...)
}

expect_data_frame <- function(x, y, ...) {
Expand All@@ -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()) {
Expand All@@ -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,
Expand Down

2 changes: 1 addition & 1 deletion
r/tests/testthat/helper-parquet.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
Expand Down

15 changes: 8 additions & 7 deletions
r/tests/testthat/helper-roundtrip.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
}

16 changes: 7 additions & 9 deletions
r/tests/testthat/test-Array.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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())
Expand DownExpand Up@@ -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"))
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand Down

35 changes: 23 additions & 12 deletions
r/tests/testthat/test-RecordBatch.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand All@@ -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", {
Expand All@@ -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))
Expand All@@ -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", {
Expand All@@ -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", {
Expand DownExpand Up@@ -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
})
Expand DownExpand Up@@ -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
Expand Down

12 changes: 6 additions & 6 deletions
r/tests/testthat/test-Table.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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))
 )
Expand All@@ -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))
 )
Expand DownExpand Up@@ -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)", {
Expand DownExpand Up@@ -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", {
Expand Down
Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Remove or un-stick sticky/fixed headers that block content\n(function() {\n function unstick() {\n document.querySelectorAll('header, nav, [role=\"banner\"], .header, .navbar, .sticky, .fixed-top, [style*=\"position: fixed\"], [style*=\"position:sticky\"]').forEach(function(el) {\n if (el.style.position === 'fixed' || el.style.position === 'sticky' || \n getComputedStyle(el).position === 'fixed' || getComputedStyle(el).position === 'sticky') {\n el.style.position = 'static';\n el.style.top = 'auto';\n el.style.zIndex = 'auto';\n }\n });\n }\n \n unstick();\n \n var observer = new MutationObserver(unstick);\n observer.observe(document.body, { childList: true, subtree: true, attributes: true, attributeFilter: ['style', 'class'] });\n})();", "Kill Sticky Headers");
}
} catch(__e) { console.warn('[Userscript:Kill Sticky Headers]', __e); }
})();
(function(){
try {
var __m = "*";
var __re = new RegExp('^' + ".*" + '

Skip to content
ARROW-12871: [R] upgrade to testthat 3e#11208

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Closed

nealrichardson
wants to merge
8
commits into

from

 Closed


ARROW-12871: [R] upgrade to testthat 3e
#11208
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


8 commits


Select commit
Hold shift + click to select a range
5e9e893

Start on updating tests to 3e


nealrichardson Sep 21, 2021
a32bdcf

Update the rest of the tests


nealrichardson Sep 22, 2021
117398d

Some cleanup and add test for ARROW-14071


nealrichardson Sep 22, 2021
c4993e9

Use expect_as_vector more


nealrichardson Sep 22, 2021
c003a9b

Save a call to as.vector in expect_array_roundtrip


nealrichardson Sep 23, 2021
af97297

Import tidyselect::all_of


nealrichardson Sep 23, 2021
3e9c248

fix package startup messages again


nealrichardson Sep 28, 2021
0172eea

Skip lubridate tests on windows temporarily


nealrichardson Sep 28, 2021

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
r/DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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,
Expand Down

2 changes: 2 additions & 0 deletions
r/NAMESPACE

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand DownExpand Up@@ -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)
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dataset.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)) {
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dplyr-mutate.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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
Expand Down

3 changes: 3 additions & 0 deletions
r/R/reexports-tidyselect.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -41,3 +41,6 @@ tidyselect::starts_with
#' @importFrom tidyselect last_col
#' @export
tidyselect::last_col
#' @importFrom tidyselect all_of
#' @export
tidyselect::all_of

3 changes: 2 additions & 1 deletion
r/man/reexports.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.


34 changes: 14 additions & 20 deletions
r/tests/testthat/helper-expectation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
@jonkeanejonkeaneSep 23, 2021

Copy link


Copy Markdown

Member
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is minor, but I wonder if we should take this opportunity to rename this expect_as_vector_equal to be super clear we are expecting them to be equal (via as.vector())
 expect_equal(as.vector(x), y, ...)
}

expect_data_frame <- function(x, y, ...) {
Expand All@@ -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()) {
Expand All@@ -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,
Expand Down

2 changes: 1 addition & 1 deletion
r/tests/testthat/helper-parquet.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
Expand Down

15 changes: 8 additions & 7 deletions
r/tests/testthat/helper-roundtrip.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
}

16 changes: 7 additions & 9 deletions
r/tests/testthat/test-Array.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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())
Expand DownExpand Up@@ -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"))
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand Down

35 changes: 23 additions & 12 deletions
r/tests/testthat/test-RecordBatch.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand All@@ -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", {
Expand All@@ -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))
Expand All@@ -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", {
Expand All@@ -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", {
Expand DownExpand Up@@ -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
})
Expand DownExpand Up@@ -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
Expand Down

12 changes: 6 additions & 6 deletions
r/tests/testthat/test-Table.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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))
 )
Expand All@@ -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))
 )
Expand DownExpand Up@@ -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)", {
Expand DownExpand Up@@ -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", {
Expand Down
Loading

, 'i');
if (__m === '*' || __re.test(location.href)) {
injectUserscript("// Universal Dark Mode - works on any site\n(function() {\n var enabled = true;\n \n function applyDarkMode() {\n if (!enabled) return;\n \n // Create style element if it doesn't exist\n var style = document.getElementById('universal-dark-mode-style');\n if (!style) {\n style = document.createElement('style');\n style.id = 'universal-dark-mode-style';\n document.head.appendChild(style);\n }\n \n // Dark mode CSS - inverts colors but preserves images/video\n style.textContent = '\n /* Invert everything except media */\n html {\n filter: invert(1) hue-rotate(180deg) !important;\n background: #1a1a2e !important;\n }\n \n /* Restore images, videos, iframes, canvas */\n img, video, iframe, canvas, svg, picture, [style*=\"background-image\"] {\n filter: invert(1) hue-rotate(180deg) !important;\n }\n \n /* Preserve specific elements that should not be inverted */\n .no-dark-mode, .no-dark-mode *,\n [data-theme=\"light\"], [data-theme=\"light\"],\n .ace_editor, .ace_editor *,\n .CodeMirror, .CodeMirror *,\n .monaco-editor, .monaco-editor *,\n .markdown-body pre, .markdown-body pre *,\n .highlight, .highlight *,\n pre code, pre code * {\n filter: none !important;\n }\n \n /* Fix common UI elements */\n .modal, .popup, .dropdown-menu, .tooltip, .popover {\n filter: invert(1) hue-rotate(180deg) !important;\n background: #2d2d44 !important;\n border-color: #444 !important;\n }\n \n /* Scrollbars */\n ::-webkit-scrollbar { background: #1a1a2e !important; }\n ::-webkit-scrollbar-thumb { background: #444 !important; }\n ::-webkit-scrollbar-thumb:hover { background: #555 !important; }\n \n /* Selection */\n ::selection { background: #4ecdc4 !important; color: #1a1a2e !important; }\n ::-moz-selection { background: #4ecdc4 !important; color: #1a1a2e !important; }\n ';\n }\n \n function removeDarkMode() {\n var style = document.getElementById('universal-dark-mode-style');\n if (style) style.remove();\n }\n \n // Toggle with Alt+Shift+D\n document.addEventListener('keydown', function(e) {\n if (e.altKey && e.shiftKey && e.key === 'D') {\n e.preventDefault();\n enabled = !enabled;\n if (enabled) {\n applyDarkMode();\n console.log('[Universal Dark Mode] Enabled');\n } else {\n removeDarkMode();\n console.log('[Universal Dark Mode] Disabled');\n }\n }\n });\n \n // Apply on load\n applyDarkMode();\n \n // Re-apply on dynamic content\n var observer = new MutationObserver(function(mutations) {\n if (enabled && !document.getElementById('universal-dark-mode-style')) {\n applyDarkMode();\n }\n });\n observer.observe(document.head, { childList: true });\n \n console.log('[Universal Dark Mode] Loaded - Press Alt+Shift+D to toggle');\n})();", "Universal Dark Mode");
}
} catch(__e) { console.warn('[Userscript:Universal Dark Mode]', __e); }
})();
})();

Skip to content
ARROW-12871: [R] upgrade to testthat 3e#11208

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

 Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and
privacy statement. We’ll occasionally send you account related emails.

Already on GitHub?
Sign in
to your account

 Closed

nealrichardson
wants to merge
8
commits into

from

 Closed


ARROW-12871: [R] upgrade to testthat 3e
#11208
Show file tree
Hide file tree
 Changes from all commits
Commits

Show all changes


8 commits


Select commit
Hold shift + click to select a range
5e9e893

Start on updating tests to 3e


nealrichardson Sep 21, 2021
a32bdcf

Update the rest of the tests


nealrichardson Sep 22, 2021
117398d

Some cleanup and add test for ARROW-14071


nealrichardson Sep 22, 2021
c4993e9

Use expect_as_vector more


nealrichardson Sep 22, 2021
c003a9b

Save a call to as.vector in expect_array_roundtrip


nealrichardson Sep 23, 2021
af97297

Import tidyselect::all_of


nealrichardson Sep 23, 2021
3e9c248

fix package startup messages again


nealrichardson Sep 28, 2021
0172eea

Skip lubridate tests on windows temporarily


nealrichardson Sep 28, 2021

File filter

Filter by extension
Filter by extension
Conversations

Failed to load comments. 
Loading
Jump to

Jump to file


Failed to load files. 
Loading
 Diff view

 Diff view


1 change: 1 addition & 0 deletions
r/DESCRIPTION

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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,
Expand Down

2 changes: 2 additions & 0 deletions
r/NAMESPACE

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand DownExpand Up@@ -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)
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dataset.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)) {
Expand Down

2 changes: 1 addition & 1 deletion
r/R/dplyr-mutate.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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
Expand Down

3 changes: 3 additions & 0 deletions
r/R/reexports-tidyselect.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -41,3 +41,6 @@ tidyselect::starts_with
#' @importFrom tidyselect last_col
#' @export
tidyselect::last_col
#' @importFrom tidyselect all_of
#' @export
tidyselect::all_of

3 changes: 2 additions & 1 deletion
r/man/reexports.Rd

View file


Open in desktop


Some generated files are not rendered by default. Learn more about how customized files appear on GitHub.


34 changes: 14 additions & 20 deletions
r/tests/testthat/helper-expectation.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
@jonkeanejonkeaneSep 23, 2021

Copy link


Copy Markdown

Member
Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

This is minor, but I wonder if we should take this opportunity to rename this expect_as_vector_equal to be super clear we are expecting them to be equal (via as.vector())
 expect_equal(as.vector(x), y, ...)
}

expect_data_frame <- function(x, y, ...) {
Expand All@@ -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()) {
Expand All@@ -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,
Expand Down

2 changes: 1 addition & 1 deletion
r/tests/testthat/helper-parquet.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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, ...) {
Expand Down

15 changes: 8 additions & 7 deletions
r/tests/testthat/helper-roundtrip.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
}

16 changes: 7 additions & 9 deletions
r/tests/testthat/test-Array.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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())
Expand DownExpand Up@@ -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"))
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand DownExpand Up@@ -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", {
Expand Down

35 changes: 23 additions & 12 deletions
r/tests/testthat/test-RecordBatch.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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)
Expand All@@ -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", {
Expand All@@ -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))
Expand All@@ -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", {
Expand All@@ -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", {
Expand DownExpand Up@@ -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
})
Expand DownExpand Up@@ -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
Expand Down

12 changes: 6 additions & 6 deletions
r/tests/testthat/test-Table.R

View file


Open in desktop

Original file line numberDiff line numberDiff line change
Expand Up@@ -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))
 )
Expand All@@ -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))
 )
Expand DownExpand Up@@ -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)", {
Expand DownExpand Up@@ -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", {
Expand Down
Loading