Skip to content

Commit 0fb16b5

Browse files
krlmlrkrlmlr
committed
feat: Fix specification for Arrow tests
1 parent ff21452 commit 0fb16b5

7 files changed

+44
-61
lines changed

‎R/spec-arrow-append-table-arrow.R

+9-25
Original file line numberDiff line numberDiff line change
@@ -184,6 +184,8 @@ spec_arrow_append_table_arrow <- list(
184184

185185
#' - 64-bit values (using `"bigint"` as field type); the result can be
186186
arrow_append_table_arrow_roundtrip_64_bit_numeric = function(ctx, con) {
187+
skip("Internal: Need to enhance test_arrow_roundtrip()")
188+
187189
tbl_in <- data.frame(a = c(-1e14, 1e15))
188190
test_arrow_roundtrip(
189191
use_append = TRUE,
@@ -197,7 +199,7 @@ spec_arrow_append_table_arrow <- list(
197199
},
198200
#
199201
arrow_append_table_arrow_roundtrip_64_bit_character = function(ctx, con) {
200-
skip_if_not_dbitest(ctx, "1.8.0.47")
202+
skip("Internal: Need to enhance test_arrow_roundtrip()")
201203

202204
tbl_in <- data.frame(a = c(-1e14, 1e15))
203205
tbl_exp <- tbl_in
@@ -215,7 +217,7 @@ spec_arrow_append_table_arrow <- list(
215217
},
216218
#
217219
arrow_append_table_arrow_roundtrip_64_bit_roundtrip = function(ctx, con, table_name) {
218-
skip_if_not_dbitest(ctx, "1.8.0.46")
220+
skip("Internal: Need to enhance test_arrow_roundtrip()")
219221

220222
tbl_in <- data.frame(a = c(-1e14, 1e15))
221223
dbWriteTable(con, table_name, tbl_in, field.types = c(a = "BIGINT"))
@@ -268,37 +270,19 @@ spec_arrow_append_table_arrow <- list(
268270
arrow_append_table_arrow_roundtrip_factor = function(ctx, con) {
269271
skip_if_not_dbitest(ctx, "1.8.0.43")
270272

271-
#' - factor (returned as character,
273+
#' - factor (possibly returned as character)
272274
tbl_in <- data.frame(
273275
a = factor(get_texts())
274276
)
275277
tbl_exp <- tbl_in
276278
tbl_exp$a <- as.character(tbl_exp$a)
277-
#' with a warning)
278-
suppressWarnings(
279-
expect_warning(
280-
test_arrow_roundtrip(use_append = TRUE, con, tbl_in, tbl_exp)
281-
)
282-
)
283-
},
284-
285-
arrow_append_table_arrow_roundtrip_raw = function(ctx, con) {
286-
skip_if_not_dbitest(ctx, "1.8.0.42")
287-
288-
#' - list of raw
289-
#' (if supported by the database)
290-
if (isTRUE(ctx$tweaks$omit_blob_tests)) {
291-
skip("tweak: omit_blob_tests")
292-
}
293-
294-
tbl_in <- data.frame(id = 1L, a = I(list(as.raw(0:10))))
295-
tbl_exp <- tbl_in
296-
tbl_exp$a <- blob::as_blob(unclass(tbl_in$a))
297279
test_arrow_roundtrip(
298280
use_append = TRUE,
299-
con, tbl_in, tbl_exp,
281+
con,
282+
tbl_in,
283+
tbl_exp,
300284
transform = function(tbl_out) {
301-
tbl_out$a <- blob::as_blob(tbl_out$a)
285+
tbl_out$a <- as.character(tbl_out$a)
302286
tbl_out
303287
}
304288
)

‎R/spec-arrow-get-query-arrow.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -106,7 +106,7 @@ spec_arrow_get_query_arrow <- list(
106106
values <- trivial_values(3) - 1
107107
params <- stats::setNames(list(values), names(placeholder))
108108
ret <- dbGetQueryArrow(con, query, params = params)
109-
expect_equal(ret, trivial_df(3), info = placeholder)
109+
expect_equal(as.data.frame(ret), trivial_df(3), info = placeholder)
110110
}
111111
},
112112
#
@@ -141,7 +141,7 @@ spec_arrow_get_query_arrow <- list(
141141
#' 1. `params` not given: waiting for parameters via [dbBind()]
142142
#' 1. `params` given: query is executed
143143
res <- expect_visible(dbGetQueryArrow(con, trivial_query(), immediate = TRUE))
144-
expect_s3_class(res, "data.frame")
144+
check_arrow(res)
145145
},
146146
#
147147
NULL

‎R/spec-arrow-write-table-arrow.R

+12-28
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ spec_arrow_write_table_arrow <- list(
5757
skip_if_not_dbitest(ctx, "1.8.0.38")
5858

5959
#' An error is also raised
60-
test_in <- stream_frame(a = 1L)
60+
test_in <- data.frame(a = 1L)
6161
#' if `name` cannot be processed with [dbQuoteIdentifier()] or
6262
expect_error(dbWriteTableArrow(con, NA, test_in %>% stream_frame()))
6363
#' if this results in a non-scalar.
@@ -79,11 +79,6 @@ spec_arrow_write_table_arrow <- list(
7979
expect_error(dbWriteTableArrow(con, table_name, test_in %>% stream_frame(), temporary = NA))
8080
#' incompatible values,
8181
expect_error(dbWriteTableArrow(con, table_name, test_in %>% stream_frame(), overwrite = TRUE, append = TRUE))
82-
expect_error(dbWriteTableArrow(con, table_name, test_in %>% stream_frame(), append = TRUE))
83-
#' duplicate
84-
expect_error(dbWriteTableArrow(con, table_name, test_in %>% stream_frame()))
85-
#' or missing names,
86-
expect_error(dbWriteTableArrow(con, table_name, test_in %>% stream_frame()))
8782

8883
#' incompatible columns)
8984
dbWriteTableArrow(con, table_name, test_in %>% stream_frame())
@@ -428,6 +423,8 @@ spec_arrow_write_table_arrow <- list(
428423

429424
#' - 64-bit values (using `"bigint"` as field type); the result can be
430425
arrow_write_table_arrow_roundtrip_64_bit_numeric = function(ctx, con) {
426+
skip("Internal: Need to enhance test_arrow_roundtrip()")
427+
431428
tbl_in <- data.frame(a = c(-1e14, 1e15))
432429
test_arrow_roundtrip(
433430
con, tbl_in,
@@ -440,7 +437,7 @@ spec_arrow_write_table_arrow <- list(
440437
},
441438
#
442439
arrow_write_table_arrow_roundtrip_64_bit_character = function(ctx, con) {
443-
skip_if_not_dbitest(ctx, "1.8.0.24")
440+
skip("Internal: Need to enhance test_arrow_roundtrip()")
444441

445442
tbl_in <- data.frame(a = c(-1e14, 1e15))
446443
tbl_exp <- tbl_in
@@ -457,7 +454,7 @@ spec_arrow_write_table_arrow <- list(
457454
},
458455
#
459456
arrow_write_table_arrow_roundtrip_64_bit_roundtrip = function(ctx, con, table_name) {
460-
skip_if_not_dbitest(ctx, "1.8.0.23")
457+
skip("Internal: Need to enhance test_arrow_roundtrip()")
461458

462459
tbl_in <- data.frame(a = c(-1e14, 1e15))
463460
dbWriteTableArrow(con, table_name, tbl_in, field.types = c(a = "BIGINT"))
@@ -510,31 +507,18 @@ spec_arrow_write_table_arrow <- list(
510507
arrow_write_table_arrow_roundtrip_factor = function(ctx, con) {
511508
skip_if_not_dbitest(ctx, "1.8.0.20")
512509

513-
#' - factor (returned as character)
510+
#' - factor (possibly returned as character)
514511
tbl_in <- data.frame(
515512
a = factor(get_texts())
516513
)
517514
tbl_exp <- tbl_in
518515
tbl_exp$a <- as.character(tbl_exp$a)
519-
test_arrow_roundtrip(con, tbl_in, tbl_exp)
520-
},
521-
522-
arrow_write_table_arrow_roundtrip_raw = function(ctx, con) {
523-
skip_if_not_dbitest(ctx, "1.8.0.19")
524-
525-
#' - list of raw
526-
#' (if supported by the database)
527-
if (isTRUE(ctx$tweaks$omit_blob_tests)) {
528-
skip("tweak: omit_blob_tests")
529-
}
530-
531-
tbl_in <- data.frame(id = 1L, a = I(list(as.raw(0:10))))
532-
tbl_exp <- tbl_in
533-
tbl_exp$a <- blob::as_blob(unclass(tbl_in$a))
534516
test_arrow_roundtrip(
535-
con, tbl_in, tbl_exp,
517+
con,
518+
tbl_in,
519+
tbl_exp,
536520
transform = function(tbl_out) {
537-
tbl_out$a <- blob::as_blob(tbl_out$a)
521+
tbl_out$a <- as.character(tbl_out$a)
538522
tbl_out
539523
}
540524
)
@@ -764,8 +748,8 @@ test_arrow_roundtrip_one <- function(con, tbl_in, tbl_expected = tbl_in, transfo
764748
dbWriteTableArrow(con, name, tbl_in %>% stream_frame())
765749
}
766750

767-
tbl_read <- check_df(dbReadTable(con, name, check.names = FALSE))
768-
tbl_out <- transform(tbl_read)
751+
stream <- dbReadTableArrow(con, name)
752+
tbl_out <- check_arrow(stream, transform)
769753
expect_equal_df(tbl_out, tbl_expected)
770754
}
771755

‎R/spec-arrow.R

+6-1
Original file line numberDiff line numberDiff line change
@@ -21,7 +21,12 @@ stream_frame <- function(..., .select = NULL) {
2121
skip("dplyr is not installed")
2222
}
2323

24-
data <- data.frame(..., stringsAsFactors = FALSE)
24+
data <- data.frame(..., stringsAsFactors = FALSE, check.names = FALSE)
25+
as_is <- map_lgl(data, inherits, "AsIs")
26+
data[as_is] <- map(data[as_is], function(.x) {
27+
class(.x) <- setdiff(class(.x), "AsIs")
28+
.x
29+
})
2530

2631
select <- enquo(.select)
2732

‎R/spec-result-get-query.R

+1-1
Original file line numberDiff line numberDiff line change
@@ -211,7 +211,7 @@ spec_result_get_query <- list(
211211
#' 1. `params` not given: waiting for parameters via [dbBind()]
212212
#' 1. `params` given: query is executed
213213
res <- expect_visible(dbGetQuery(con, trivial_query(), immediate = TRUE))
214-
expect_s3_class(res, "data.frame")
214+
check_df(res)
215215
},
216216
#
217217
NULL

‎R/spec-sql-create-table.R

+2-2
Original file line numberDiff line numberDiff line change
@@ -135,10 +135,10 @@ spec_sql_create_table <- list(
135135
create_table_value_array = function(ctx, con) {
136136
skip_if_not_dbitest(ctx, "1.8.0.10")
137137

138-
#' - a named list of vectors
138+
#' - a named list of SQL types
139139
table_name <- "ct_array"
140140
local_remove_test_table(con, table_name)
141-
array <- list(a = 1)
141+
array <- list(a = "NUMERIC")
142142
dbCreateTable(con, table_name, array)
143143
expect_equal_df(dbReadTable(con, table_name), data.frame(a = numeric()))
144144
},

‎R/utils.R

+12-2
Original file line numberDiff line numberDiff line change
@@ -90,6 +90,16 @@ check_df <- function(df) {
9090
df
9191
}
9292

93-
check_arrow <- function(stream) {
94-
check_df(as.data.frame(stream))
93+
check_arrow <- function(stream, transform = identity) {
94+
to <- function(schema, ptype) transform(ptype)
95+
if (inherits(stream, "nanoarrow_array_stream")) {
96+
on.exit(stream$release())
97+
df <- nanoarrow::convert_array_stream(stream, to)
98+
} else if (inherits(stream, "nanoarrow_array")) {
99+
df <- nanoarrow::convert_array(stream, to)
100+
} else {
101+
stop("Unexpected conversion of type ", class(stream), ".", call. = FALSE)
102+
}
103+
104+
check_df(df)
95105
}

0 commit comments

Comments
 (0)