krlmlr commented on code in PR #288:
URL: https://github.com/apache/arrow-nanoarrow/pull/288#discussion_r1311071380
##########
r/R/convert-array.R:
##########
@@ -85,14 +85,28 @@ convert_array <- function(array, to = NULL, ...) {
#' @export
convert_array.default <- function(array, to = NULL, ..., .from_c = FALSE) {
if (.from_c) {
+ # Handle extension conversion
+ # We don't need the user-friendly versions and this is
performance-sensitive
+ schema <- .Call(nanoarrow_c_infer_schema_array, array)
+ parsed <- .Call(nanoarrow_c_schema_parse, schema)
Review Comment:
Since this seems to throw away `schema`, perhaps offer a C entry point that
combines both functions?
##########
r/R/convert-array.R:
##########
@@ -85,14 +85,28 @@ convert_array <- function(array, to = NULL, ...) {
#' @export
convert_array.default <- function(array, to = NULL, ..., .from_c = FALSE) {
if (.from_c) {
+ # Handle extension conversion
+ # We don't need the user-friendly versions and this is
performance-sensitive
+ schema <- .Call(nanoarrow_c_infer_schema_array, array)
+ parsed <- .Call(nanoarrow_c_schema_parse, schema)
+ if (!is.null(parsed$extension_name)) {
+ spec <- resolve_nanoarrow_extension(parsed$extension_name)
+ return(convert_array_extension(spec, array, to, ...))
+ }
+
# Handle default dictionary conversion since it's the same for all types
dictionary <- array$dictionary
if (!is.null(dictionary)) {
values <- .Call(nanoarrow_c_convert_array, dictionary, to)
array$dictionary <- NULL
indices <- .Call(nanoarrow_c_convert_array, array, integer())
- return(values[indices + 1L])
+
+ if (is.data.frame(values)) {
+ return(values[indices + 1L, , drop = FALSE])
+ } else {
+ return(values[indices + 1L])
+ }
Review Comment:
This is `vec_slice()` :
```suggestion
return(vec_slice(values, indices + 1L))
```
##########
r/R/extension-vctrs.R:
##########
@@ -0,0 +1,92 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+#' Vctrs extension type
+#'
+#' The Arrow format provides a rich type system that can handle most R
+#' vector types; however, many R vector types do not roundtrip perfectly
+#' through Arrow memory. The vctrs extension type uses [vctrs::vec_data()],
+#' [vctrs::vec_restore()], and [vctrs::vec_ptype()] in calls to
+#' [as_nanoarrow_array()] and [convert_array()] to ensure roundtrip fidelity.
+#'
+#' @param ptype A vctrs prototype as returned by [vctrs::vec_ptype()].
Review Comment:
Is this correct?
```suggestion
#' @param ptype A vctrs prototype as returned by [vctrs::vec_ptype()].
#' The prototype can be of arbitrary size, but a zero-size vector
#' is sufficient here.
```
##########
r/src/convert_array.c:
##########
@@ -100,7 +100,26 @@ static SEXP convert_array_default(SEXP array_xptr, enum
VectorType vector_type,
return result;
}
-static SEXP convert_array_chr(SEXP array_xptr) {
+static SEXP convert_array_chr(SEXP array_xptr, SEXP ptype_sexp) {
+ struct ArrowSchema* schema = schema_from_array_xptr(array_xptr);
+ struct ArrowSchemaView schema_view;
+ if (ArrowSchemaViewInit(&schema_view, schema, NULL) != NANOARROW_OK) {
+ Rf_error("Invalid schema");
+ }
+
+ // If array_xptr is an extension, use default conversion
+ if (schema_view.extension_name.size_bytes > 0) {
+ if (ptype_sexp == R_NilValue) {
+ ptype_sexp =
PROTECT(nanoarrow_c_infer_ptype(array_xptr_get_schema(array_xptr)));
+ SEXP default_result =
+ PROTECT(convert_array_default(array_xptr, VECTOR_TYPE_OTHER,
ptype_sexp));
+ UNPROTECT(2);
+ return default_result;
+ } else {
+ return convert_array_default(array_xptr, VECTOR_TYPE_OTHER, ptype_sexp);
+ }
Review Comment:
This gave me pause. Perhaps:
```suggestion
if (ptype_sexp == R_NilValue) {
ptype_sexp =
PROTECT(nanoarrow_c_infer_ptype(array_xptr_get_schema(array_xptr)));
} else {
ptype_sexp = PROTECT(ptype_sexp);
}
SEXP default_result =
convert_array_default(array_xptr, VECTOR_TYPE_OTHER, ptype_sexp);
UNPROTECT(1);
return default_result;
```
##########
r/tests/testthat/test-extension.R:
##########
@@ -0,0 +1,116 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+test_that("extension types can be registered and unregistered", {
+ spec <- nanoarrow_extension_spec()
+ register_nanoarrow_extension("some_ext", spec)
+ expect_identical(resolve_nanoarrow_extension("some_ext"), spec)
+ unregister_nanoarrow_extension("some_ext")
+ expect_identical(resolve_nanoarrow_extension("some_ext"), NULL)
+})
+
+test_that("infer_nanoarrow_ptype() dispatches on registered extension spec", {
+ register_nanoarrow_extension(
+ "some_ext",
+ nanoarrow_extension_spec(subclass = "some_spec_class")
+ )
+ on.exit(unregister_nanoarrow_extension("some_ext"))
+
+ infer_nanoarrow_ptype_extension.some_spec_class <- function(spec, x, ...) {
Review Comment:
There's `rlang::local_bindings()` .
##########
r/R/extension-vctrs.R:
##########
@@ -0,0 +1,92 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+#' Vctrs extension type
+#'
+#' The Arrow format provides a rich type system that can handle most R
+#' vector types; however, many R vector types do not roundtrip perfectly
+#' through Arrow memory. The vctrs extension type uses [vctrs::vec_data()],
+#' [vctrs::vec_restore()], and [vctrs::vec_ptype()] in calls to
+#' [as_nanoarrow_array()] and [convert_array()] to ensure roundtrip fidelity.
+#'
+#' @param ptype A vctrs prototype as returned by [vctrs::vec_ptype()].
+#' @inheritParams na_type
+#'
+#' @return A [nanoarrow_schema][as_nanoarrow_schema].
+#' @export
+#'
+#' @examples
+#' vctr <- as.POSIXlt("2000-01-02 03:45", tz = "UTC")
+#' array <- as_nanoarrow_array(vctr, schema = na_vctrs(vctrs::vec_ptype(vctr)))
Review Comment:
Would `na_vctrs` also accept a non-length-0 vector?
```suggestion
#' array <- as_nanoarrow_array(vctr, schema = na_vctrs(vctr))
```
##########
r/tests/testthat/test-extension-vctrs.R:
##########
@@ -0,0 +1,72 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+test_that("vctrs extension type can roundtrip built-in vector types", {
+ skip_if_not_installed("tibble")
+
+ # Arrow tibbleifies everything, so we do here too
+ # Lists aren't automatically handled in nanoarrow conversion, so they
+ # aren't listed here yet.
+ vectors <- list(
+ lgl = c(FALSE, TRUE, NA),
+ int = c(0L, 1L, NA_integer_),
+ dbl = c(0, 1, NA_real_),
+ chr = c("a", NA_character_),
+ posixct = as.POSIXct("2000-01-01 12:23", tz = "UTC"),
+ posixlt = as.POSIXlt("2000-01-01 12:23", tz = "UTC"),
+ date = as.Date("2000-01-01"),
+ difftime = as.difftime(123, units = "secs"),
+ data_frame_simple = tibble::tibble(x = 1:5),
+ data_frame_nested = tibble::tibble(x = 1:5, y = tibble::tibble(z =
letters[1:5]))
+ )
+
+ for (nm in names(vectors)) {
+ vctr <- vectors[[nm]]
+ ptype <- vctrs::vec_ptype(vctr)
+ schema <- na_vctrs(vctr)
+
+ array <- as_nanoarrow_array(vctr, schema = schema)
+ array_schema <- infer_nanoarrow_schema(array)
+
+ # Roundtrip through convert_array()
+ expect_true(nanoarrow_schema_identical(array_schema, schema))
+ expect_identical(infer_nanoarrow_ptype(array), ptype)
+ expect_identical(convert_array(array), vctr)
+
+ # Roundtrip with an empty array stream
+ stream <- basic_array_stream(list(), schema = schema)
+ expect_identical(convert_array_stream(stream), ptype)
+
+ # Roundtrip with multiple chunks
+ stream <- basic_array_stream(list(array, array))
+ expect_identical(convert_array_stream(stream), vctrs::vec_rep(vctr, 2))
+
+ if (requireNamespace("arrow", quietly = TRUE)) {
Review Comment:
This will also allow you to use `skip_if_not_installed("arrow")` here.
##########
r/src/materialize.c:
##########
@@ -190,6 +190,67 @@ static void fill_vec_with_nulls(SEXP x, R_xlen_t offset,
R_xlen_t len) {
}
}
+static void copy_vec_into(SEXP x, SEXP dst, R_xlen_t offset, R_xlen_t len) {
+ if (nanoarrow_ptype_is_data_frame(dst)) {
+ if (!nanoarrow_ptype_is_data_frame(x)) {
+ Rf_error("Expected record-style vctr result but got non-record-style
result");
+ }
+
+ R_xlen_t x_len = nanoarrow_data_frame_size(x);
+ if (len != x_len) {
+ Rf_error("Unexpected data.frame row count in copy_vec_into()");
+ }
+
+ // This does not currently consider column names (i.e., it blindly copies
+ // by index).
+ if (Rf_xlength(x) != Rf_xlength(dst)) {
+ Rf_error("Unexpected data.frame column count in copy_vec_into()");
+ }
+
+ for (R_xlen_t i = 0; i < Rf_xlength(x); i++) {
+ copy_vec_into(VECTOR_ELT(x, i), VECTOR_ELT(dst, i), offset, len);
+ }
+
+ return;
+ } else if (nanoarrow_ptype_is_data_frame(x)) {
+ Rf_error("Expected non-record-style vctr result but got record-style
result");
+ }
+
+ if (TYPEOF(dst) != TYPEOF(x)) {
+ Rf_error("Unexpected SEXP type in result copy_vec_into()");
+ }
+
+ if (Rf_length(x) != len) {
+ Rf_error("Unexpected length of result in copy_vec_into()");
+ }
+
+ switch (TYPEOF(dst)) {
+ case RAWSXP:
+ memcpy(RAW(dst) + offset, RAW(x), len * sizeof(double));
+ break;
+ case REALSXP:
+ memcpy(REAL(dst) + offset, REAL(x), len * sizeof(double));
+ break;
+ case INTSXP:
+ case LGLSXP:
+ memcpy(INTEGER(dst) + offset, INTEGER(x), len * sizeof(int));
+ break;
+ case STRSXP:
+ for (R_xlen_t i = 0; i < len; i++) {
+ SET_STRING_ELT(dst, offset + i, STRING_ELT(x, i));
+ }
+ break;
+ case VECSXP:
+ for (R_xlen_t i = 0; i < len; i++) {
+ SET_VECTOR_ELT(dst, offset + i, VECTOR_ELT(x, i));
+ }
+ break;
+ default:
+ Rf_error("Unhandled SEXP type in copy_vec_into()");
Review Comment:
`CPLXSXP` ?
##########
r/src/convert_array.c:
##########
@@ -117,19 +136,26 @@ static SEXP convert_array_chr(SEXP array_xptr) {
SEXP nanoarrow_c_convert_array(SEXP array_xptr, SEXP ptype_sexp);
static SEXP convert_array_data_frame(SEXP array_xptr, SEXP ptype_sexp) {
- // If array_xptr is a union, use default convert behaviour
struct ArrowSchema* schema = schema_from_array_xptr(array_xptr);
struct ArrowSchemaView schema_view;
if (ArrowSchemaViewInit(&schema_view, schema, NULL) != NANOARROW_OK) {
Rf_error("Invalid schema");
}
- if (schema_view.storage_type != NANOARROW_TYPE_STRUCT) {
- ptype_sexp =
PROTECT(nanoarrow_c_infer_ptype(array_xptr_get_schema(array_xptr)));
- SEXP default_result =
- convert_array_default(array_xptr, VECTOR_TYPE_DATA_FRAME, ptype_sexp);
- UNPROTECT(1);
- return default_result;
+ // If array_xptr is an extension, union, or the ptype isn't a data.frame
+ // use convert/materialize convert behaviour.
+ if (schema_view.storage_type != NANOARROW_TYPE_STRUCT ||
+ schema_view.extension_name.size_bytes > 0 ||
+ (ptype_sexp != R_NilValue && !Rf_inherits(ptype_sexp, "data.frame"))) {
+ if (ptype_sexp == R_NilValue) {
+ ptype_sexp =
PROTECT(nanoarrow_c_infer_ptype(array_xptr_get_schema(array_xptr)));
Review Comment:
Same pattern as above.
##########
r/R/extension.R:
##########
@@ -0,0 +1,187 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+#' Register Arrow extension types
+#'
+#' @param extension_name An Arrow extension type name (e.g., arrow.r.vctrs)
+#' @param extension_spec An extension specification inheriting from
+#' 'nanoarrow_extension_spec'.
+#' @param data Optional data to include in the extension type specification
+#' @param subclass A subclass for the extension type specification. Extension
+#' methods will dispatch on this object.
+#'
+#' @return
+#' - `nanoarrow_extension_spec()` returns an object of class
+#' 'nanoarrow_extension_spec'.
+#' - `register_nanoarrow_extension()` returns `extension_spec`, invisibly.
+#' - `unregister_nanoarrow_extension()` returns `extension_name`, invisibly.
+#' - `resolve_nanoarrow_extension()` returns an object of class
+#' 'nanoarrow_extension_spec' or NULL if the extension type was not
+#' registered.
+#' @export
+#'
+#' @examples
+#' nanoarrow_extension_spec("mynamespace.mytype", subclass =
"mypackage_mytype_spec")
+nanoarrow_extension_spec <- function(data = list(), subclass = character()) {
+ structure(
+ data,
+ class = union(subclass, "nanoarrow_extension_spec")
+ )
+}
+
+#' @rdname nanoarrow_extension_spec
+#' @export
+register_nanoarrow_extension <- function(extension_name, extension_spec) {
+ extension_registry[[extension_name]] <- extension_spec
+ invisible(extension_name)
+}
+
+#' @rdname nanoarrow_extension_spec
+#' @export
+unregister_nanoarrow_extension <- function(extension_name) {
+ extension_registry[[extension_name]] <- NULL
+ invisible(extension_name)
+}
+
+#' @rdname nanoarrow_extension_spec
+#' @export
+resolve_nanoarrow_extension <- function(extension_name) {
+ extension_registry[[extension_name]]
+}
+
+
+#' Implement Arrow extension types
+#'
+#' @inheritParams nanoarrow_extension_spec
+#' @param warn_unregistered Use `FALSE` to infer/convert based on the storage
+#' type without a warning.
+#' @param x,array,to,schema,... Passed from [infer_nanoarrow_ptype()],
+#' [convert_array()], [as_nanoarrow_array()], and/or
+#' [as_nanoarrow_array_stream()].
+#'
+#' @return
+#' - `infer_nanoarrow_ptype_extension()`: The R vector prototype to be used
+#' as the default conversion target.
+#' - `convert_array_extension()`: An R vector of type `to`.
+#' - `as_nanoarrow_array_extension()`: A
[nanoarrow_array][as_nanoarrow_array]
+#' of type `schema`.
+#' @export
+#'
+infer_nanoarrow_ptype_extension <- function(extension_spec, x, ...,
+ warn_unregistered = TRUE) {
+ UseMethod("infer_nanoarrow_ptype_extension")
+}
+
+#' @rdname infer_nanoarrow_ptype_extension
+#' @export
+convert_array_extension <- function(extension_spec, array, to, ...,
+ warn_unregistered = TRUE) {
+ UseMethod("convert_array_extension")
+}
+
+#' @rdname infer_nanoarrow_ptype_extension
+#' @export
+as_nanoarrow_array_extension <- function(extension_spec, x, ..., schema =
NULL) {
+ UseMethod("as_nanoarrow_array_extension")
+}
+
+#' @export
+infer_nanoarrow_ptype_extension.default <- function(extension_spec, x, ...,
+ warn_unregistered = TRUE) {
+ if (warn_unregistered) {
+ warn_unregistered_extension_type(x)
+ }
Review Comment:
Should this be part of the generic?
##########
r/src/materialize.c:
##########
@@ -190,6 +190,67 @@ static void fill_vec_with_nulls(SEXP x, R_xlen_t offset,
R_xlen_t len) {
}
}
+static void copy_vec_into(SEXP x, SEXP dst, R_xlen_t offset, R_xlen_t len) {
+ if (nanoarrow_ptype_is_data_frame(dst)) {
+ if (!nanoarrow_ptype_is_data_frame(x)) {
+ Rf_error("Expected record-style vctr result but got non-record-style
result");
+ }
+
+ R_xlen_t x_len = nanoarrow_data_frame_size(x);
+ if (len != x_len) {
+ Rf_error("Unexpected data.frame row count in copy_vec_into()");
+ }
+
+ // This does not currently consider column names (i.e., it blindly copies
+ // by index).
+ if (Rf_xlength(x) != Rf_xlength(dst)) {
+ Rf_error("Unexpected data.frame column count in copy_vec_into()");
+ }
+
+ for (R_xlen_t i = 0; i < Rf_xlength(x); i++) {
+ copy_vec_into(VECTOR_ELT(x, i), VECTOR_ELT(dst, i), offset, len);
+ }
+
+ return;
+ } else if (nanoarrow_ptype_is_data_frame(x)) {
+ Rf_error("Expected non-record-style vctr result but got record-style
result");
+ }
+
+ if (TYPEOF(dst) != TYPEOF(x)) {
+ Rf_error("Unexpected SEXP type in result copy_vec_into()");
+ }
+
+ if (Rf_length(x) != len) {
+ Rf_error("Unexpected length of result in copy_vec_into()");
+ }
+
+ switch (TYPEOF(dst)) {
+ case RAWSXP:
+ memcpy(RAW(dst) + offset, RAW(x), len * sizeof(double));
Review Comment:
```suggestion
memcpy(RAW(dst) + offset, RAW(x), len * sizeof(*RAW(x)));
```
or simply `char` .
##########
r/R/convert-array.R:
##########
@@ -85,14 +85,28 @@ convert_array <- function(array, to = NULL, ...) {
#' @export
convert_array.default <- function(array, to = NULL, ..., .from_c = FALSE) {
if (.from_c) {
+ # Handle extension conversion
+ # We don't need the user-friendly versions and this is
performance-sensitive
+ schema <- .Call(nanoarrow_c_infer_schema_array, array)
+ parsed <- .Call(nanoarrow_c_schema_parse, schema)
+ if (!is.null(parsed$extension_name)) {
+ spec <- resolve_nanoarrow_extension(parsed$extension_name)
+ return(convert_array_extension(spec, array, to, ...))
+ }
+
# Handle default dictionary conversion since it's the same for all types
dictionary <- array$dictionary
if (!is.null(dictionary)) {
values <- .Call(nanoarrow_c_convert_array, dictionary, to)
array$dictionary <- NULL
indices <- .Call(nanoarrow_c_convert_array, array, integer())
Review Comment:
Perhaps enable this function to add an offset directly, to avoid the `+ 1L`
below?
##########
r/tests/testthat/test-extension-vctrs.R:
##########
@@ -0,0 +1,72 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+test_that("vctrs extension type can roundtrip built-in vector types", {
+ skip_if_not_installed("tibble")
+
+ # Arrow tibbleifies everything, so we do here too
+ # Lists aren't automatically handled in nanoarrow conversion, so they
+ # aren't listed here yet.
+ vectors <- list(
+ lgl = c(FALSE, TRUE, NA),
+ int = c(0L, 1L, NA_integer_),
+ dbl = c(0, 1, NA_real_),
+ chr = c("a", NA_character_),
+ posixct = as.POSIXct("2000-01-01 12:23", tz = "UTC"),
+ posixlt = as.POSIXlt("2000-01-01 12:23", tz = "UTC"),
+ date = as.Date("2000-01-01"),
+ difftime = as.difftime(123, units = "secs"),
+ data_frame_simple = tibble::tibble(x = 1:5),
Review Comment:
Do you support packed columns (structs) here too?
##########
r/tests/testthat/test-extension-vctrs.R:
##########
@@ -0,0 +1,72 @@
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+
+test_that("vctrs extension type can roundtrip built-in vector types", {
+ skip_if_not_installed("tibble")
+
+ # Arrow tibbleifies everything, so we do here too
+ # Lists aren't automatically handled in nanoarrow conversion, so they
+ # aren't listed here yet.
+ vectors <- list(
+ lgl = c(FALSE, TRUE, NA),
+ int = c(0L, 1L, NA_integer_),
+ dbl = c(0, 1, NA_real_),
+ chr = c("a", NA_character_),
+ posixct = as.POSIXct("2000-01-01 12:23", tz = "UTC"),
+ posixlt = as.POSIXlt("2000-01-01 12:23", tz = "UTC"),
+ date = as.Date("2000-01-01"),
+ difftime = as.difftime(123, units = "secs"),
+ data_frame_simple = tibble::tibble(x = 1:5),
+ data_frame_nested = tibble::tibble(x = 1:5, y = tibble::tibble(z =
letters[1:5]))
+ )
+
+ for (nm in names(vectors)) {
Review Comment:
Experience from DBItest has taught me that you'll be much better off writing
multiple `test_that(...)` blocks, one per element. Why not create a small
script that generates this code for you?
Canonical reference: https://mtlynch.io/good-developers-bad-tests/ .
--
This is an automated message from the Apache Git Service.
To respond to the message, please log on to GitHub and use the
URL above to go to the specific comment.
To unsubscribe, e-mail: [email protected]
For queries about this service, please contact Infrastructure at:
[email protected]
