feat(r): Allow opt-out of warning for unregistered extension types

r/R/convert-array.R

@@ -24,6 +24,10 @@
 #' dispatching on `to`: developers may implement their own S3 methods for
 #' custom vector types.
 #'
+#' Note that unregistered extension types will by default issue a warning.
+#' Use `options(nanoarrow.warn_unregistered_extension = FALSE)` to disable
+#' this behaviour.
+#'
 #' @param array A [nanoarrow_array][as_nanoarrow_array].
 #' @param to A target prototype object describing the type to which `array`
 #'   should be converted, or `NULL` to use the default conversion as

r/R/extension.R

@@ -164,23 +164,28 @@ nanoarrow_extension_array <- function(storage_array, extension_name,
 }
 
 warn_unregistered_extension_type <- function(x) {
+  # Allow an opt-out of this warning for consumers that don't have
+  # control over their source and want to drop unknown extensions
+  if (!getOption("nanoarrow.warn_unregistered_extension", TRUE)) {
+    return()
+  }
+
   # Warn that we're about to ignore an extension type
+  message <- sprintf(
+    paste0(
+      "Converting unknown extension %s as storage type\n",
+      "Disable warning with ",
+      "options(nanoarrow.warn_unregistered_extension = FALSE)"
+    ),
+    nanoarrow_schema_formatted(x)
+  )
+
+  # Add the field name if we know it
   if (!is.null(x$name) && !identical(x$name, "")) {
-    warning(
-      sprintf(
-        "%s: Converting unknown extension %s as storage type",
-        x$name,
-        nanoarrow_schema_formatted(x)
-      )
-    )
-  } else {
-    warning(
-      sprintf(
-        "Converting unknown extension %s as storage type",
-        nanoarrow_schema_formatted(x)
-      )
-    )
+    message <- paste0(x$name, ": ", message)
   }
+
+  warning(message)
 }
 
 # Mutable registry to look up extension specifications

r/tests/testthat/test-extension.R

@@ -126,6 +126,28 @@ test_that("as_nanoarrow_array() dispatches on registered extension spec", {
   )
 })
 
+test_that("inferring the type of an unregistered extension warns", {
+  unknown_extension <- na_extension(na_int32(), "definitely not registered")
+  expect_warning(
+    infer_nanoarrow_ptype(unknown_extension),
+    "Converting unknown extension"
+  )
+
+  # Check that warning contains a field name if present
+  struct_with_unknown_ext <- na_struct(list(some_col = unknown_extension))
+  expect_warning(
+    infer_nanoarrow_ptype(struct_with_unknown_ext),
+    "some_col: Converting unknown extension"
+  )
+
+  previous_opts <- options(nanoarrow.warn_unregistered_extension = FALSE)
+  on.exit(options(previous_opts))
+  expect_warning(
+    infer_nanoarrow_ptype(unknown_extension),
+    NA
+  )
+})
+
 test_that("extensions can infer a schema of a nanoarrow_vctr() subclass", {
   register_nanoarrow_extension(
     "some_ext",