diff --git a/r/R/extension.R b/r/R/extension.R index 3529144e11500..e5b12b80ae615 100644 --- a/r/R/extension.R +++ b/r/R/extension.R @@ -429,7 +429,8 @@ VctrsExtensionType <- R6Class("VctrsExtensionType", paste0(capture.output(print(self$ptype())), collapse = "\n") }, deserialize_instance = function() { - private$.ptype <- safe_r_metadata(safe_unserialize(self$extension_metadata())) + private$.ptype <- safe_unserialize(self$extension_metadata()) + attributes(private$.ptype) <- safe_r_metadata(attributes(private$.ptype)) }, ExtensionEquals = function(other) { inherits(other, "VctrsExtensionType") && identical(self$ptype(), other$ptype()) @@ -510,11 +511,13 @@ vctrs_extension_array <- function(x, ptype = vctrs::vec_ptype(x), vctrs_extension_type <- function(x, storage_type = infer_type(vctrs::vec_data(x))) { ptype <- vctrs::vec_ptype(x) + # Make sure there are no unsupported objects buried in there + attributes(ptype) <- safe_r_metadata(attributes(ptype)) new_extension_type( storage_type = storage_type, extension_name = "arrow.r.vctrs", - extension_metadata = serialize(ptype, NULL), + extension_metadata = serialize(ptype, NULL, ascii = TRUE), type_class = VctrsExtensionType ) } diff --git a/r/tests/testthat/test-extension.R b/r/tests/testthat/test-extension.R index 8b3d7d8aaa902..db26a70acb419 100644 --- a/r/tests/testthat/test-extension.R +++ b/r/tests/testthat/test-extension.R @@ -343,3 +343,11 @@ test_that("Dataset/arrow_dplyr_query can roundtrip extension types", { expect_identical(unclass(roundtripped$extension), roundtripped$letter) }) + +test_that("Handling vctrs_rcrd type", { + df <- data.frame( + x = vctrs::new_rcrd(fields = list(special = 1:3), class = "special") + ) + tab <- arrow_table(df) + expect_identical(as.data.frame(tab), df) +})