Teach C level vec_ptype_common() how to opt out of ptype finalization

DavisVaughan · DavisVaughan · commit d485b4532b99 · 2025-11-11T15:56:26.000-05:00
And ensure that we always finalize on the way out from `vec_ptype_common()`, even with a user supplied `ptype`!
diff --git a/R/type.R b/R/type.R
@@ -120,11 +120,18 @@ vec_ptype_common <- function(
 vec_ptype_common_params <- function(
   ...,
   .ptype = NULL,
+  .finalise = TRUE,
   .fallback_opts = fallback_opts(),
   .arg = "",
   .call = caller_env()
 ) {
-  .External2(ffi_ptype_common_params, list2(...), .ptype, .fallback_opts)
+  .External2(
+    ffi_ptype_common_params,
+    list2(...),
+    .ptype,
+    .finalise,
+    .fallback_opts
+  )
 }
 
 vec_ptype_common_fallback <- function(
diff --git a/src/bind.c b/src/bind.c
@@ -74,6 +74,7 @@ r_obj* vec_rbind(r_obj* xs,
   ptype = vec_ptype_common(
     xs,
     ptype,
+    PTYPE_FINALISE_DEFAULT,
     S3_FALLBACK_true,
     p_arg,
     error_call
@@ -498,6 +499,7 @@ r_obj* vec_cbind(r_obj* xs,
   r_obj* type = KEEP(vec_ptype_common(
     xs_data_frames,
     ptype,
+    PTYPE_FINALISE_DEFAULT,
     S3_FALLBACK_false,
     p_arg,
     error_call
diff --git a/src/cast.c b/src/cast.c
@@ -257,6 +257,7 @@ r_obj* vec_cast_common_opts(r_obj* xs,
   r_obj* type = KEEP(vec_ptype_common(
     xs,
     to,
+    PTYPE_FINALISE_DEFAULT,
     opts->s3_fallback,
     opts->p_arg,
     opts->call
diff --git a/src/init.c b/src/init.c
@@ -392,7 +392,7 @@ extern r_obj* ffi_new_data_frame(r_obj*);
 static
 const R_ExternalMethodDef ExtEntries[] = {
   {"ffi_ptype_common",                 (DL_FUNC) &ffi_ptype_common, 2},
-  {"ffi_ptype_common_params",          (DL_FUNC) &ffi_ptype_common_params, 3},
+  {"ffi_ptype_common_params",          (DL_FUNC) &ffi_ptype_common_params, 4},
   {"ffi_size_common",                  (DL_FUNC) &ffi_size_common, 3},
   {"ffi_recycle_common",               (DL_FUNC) &ffi_recycle_common, 2},
   {"ffi_cast_common",                  (DL_FUNC) &ffi_cast_common, 2},
diff --git a/src/list-combine.c b/src/list-combine.c
@@ -809,6 +809,7 @@ r_obj* list_combine_common_class_fallback(
     vec_ptype_common(
       xs,
       ptype,
+      PTYPE_FINALISE_DEFAULT,
       s3_fallback,
       p_xs_arg,
       error_call
@@ -1806,6 +1807,8 @@ r_obj* ptype_common_with_default(
   ptype = KEEP(vec_ptype_common(
     xs,
     ptype,
+    // TODO!: This should be `false`
+    PTYPE_FINALISE_true,
     s3_fallback,
     p_xs_arg,
     error_call
diff --git a/src/ptype-common.c b/src/ptype-common.c
@@ -18,10 +18,15 @@ r_obj* ffi_ptype_common(r_obj* ffi_call, r_obj* op, r_obj* args, r_obj* env) {
   struct r_lazy xs_arg_lazy = { .x = syms.dot_arg, .env = env };
   struct vctrs_arg xs_arg = new_lazy_arg(&xs_arg_lazy);
 
+  // User calls to `vec_ptype_common()` are always finalised and never fall back
+  const enum ptype_finalise finalise = PTYPE_FINALISE_DEFAULT;
+  const enum s3_fallback s3_fallback = S3_FALLBACK_false;
+
   r_obj* out = vec_ptype_common(
     xs,
     ptype,
-    S3_FALLBACK_false,
+    finalise,
+    s3_fallback,
     &xs_arg,
     call
   );
@@ -35,17 +40,22 @@ r_obj* ffi_ptype_common_params(r_obj* ffi_call, r_obj* op, r_obj* args, r_obj* e
 
   r_obj* xs = r_node_car(args); args = r_node_cdr(args);
   r_obj* ptype = r_node_car(args); args = r_node_cdr(args);
+  r_obj* ffi_finalise = r_node_car(args); args = r_node_cdr(args);
   r_obj* opts = r_node_car(args);
 
   struct r_lazy call = { .x = syms.dot_call, .env = env };
   struct r_lazy xs_arg_lazy = { .x = syms.dot_arg, .env = env };
   struct vctrs_arg xs_arg = new_lazy_arg(&xs_arg_lazy);
 
+  const enum ptype_finalise finalise = r_arg_as_bool(ffi_finalise, "finalise") ?
+    PTYPE_FINALISE_true :
+    PTYPE_FINALISE_false;
   const enum s3_fallback s3_fallback = s3_fallback_from_opts(opts);
 
   r_obj* out = vec_ptype_common(
     xs,
     ptype,
+    finalise,
     s3_fallback,
     &xs_arg,
     call
@@ -54,39 +64,52 @@ r_obj* ffi_ptype_common_params(r_obj* ffi_call, r_obj* op, r_obj* args, r_obj* e
   return out;
 }
 
+// Output is always finalised unless `PTYPE_FINALISE_false` is set, even if the
+// user supplies a `ptype`!
 r_obj* vec_ptype_common(
   r_obj* dots,
   r_obj* ptype,
+  enum ptype_finalise finalise,
   enum s3_fallback s3_fallback,
   struct vctrs_arg* p_arg,
   struct r_lazy call
 ) {
+  int n_prot = 0;
+
+  r_obj* out;
+
   if (!vec_is_partial(ptype)) {
-    return vec_ptype(ptype, vec_args.dot_ptype, call);
+    out = KEEP_N(vec_ptype(ptype, vec_args.dot_ptype, call), &n_prot);
+  } else {
+    if (r_is_true(r_peek_option("vctrs.no_guessing"))) {
+      r_abort_lazy_call(r_lazy_null, "strict mode is activated; you must supply complete `.ptype`.");
+    }
+
+    struct ptype_common_reduce_opts reduce_opts = {
+      .call = call,
+      .s3_fallback = s3_fallback
+    };
+
+    // Start reduction with `ptype` in case it's a partial type
+    out = KEEP_N(
+      reduce(
+        ptype,
+        vec_args.dot_ptype,
+        p_arg,
+        dots,
+        &ptype2_common,
+        &reduce_opts
+      ),
+      &n_prot
+    );
   }
 
-  if (r_is_true(r_peek_option("vctrs.no_guessing"))) {
-    r_abort_lazy_call(r_lazy_null, "strict mode is activated; you must supply complete `.ptype`.");
+  if (should_finalise(finalise)) {
+    out = KEEP_N(vec_ptype_finalise(out), &n_prot);
   }
 
-  struct ptype_common_reduce_opts reduce_opts = {
-    .call = call,
-    .s3_fallback = s3_fallback
-  };
-
-  // Start reduction with the `.ptype` argument
-  r_obj* type = KEEP(reduce(
-    ptype,
-    vec_args.dot_ptype,
-    p_arg,
-    dots,
-    &ptype2_common,
-    &reduce_opts
-  ));
-  type = vec_ptype_finalise(type);
-
-  FREE(1);
-  return type;
+  FREE(n_prot);
+  return out;
 }
 
 static
diff --git a/src/ptype-common.h b/src/ptype-common.h
@@ -2,6 +2,7 @@
 #define VCTRS_PTYPE_COMMON_H
 
 #include "vctrs-core.h"
+#include "ptype.h"
 #include "ptype2.h"
 #include "utils.h"
 
@@ -13,6 +14,7 @@ bool vec_is_common_class_fallback(r_obj* ptype) {
 r_obj* vec_ptype_common(
   r_obj* dots,
   r_obj* ptype,
+  enum ptype_finalise finalise,
   enum s3_fallback s3_fallback,
   struct vctrs_arg* p_arg,
   struct r_lazy call
diff --git a/src/ptype.h b/src/ptype.h
@@ -3,6 +3,18 @@
 
 #include "vctrs-core.h"
 
+enum ptype_finalise {
+  PTYPE_FINALISE_false,
+  PTYPE_FINALISE_true
+};
+
+#define PTYPE_FINALISE_DEFAULT PTYPE_FINALISE_true
+
+static inline
+bool should_finalise(enum ptype_finalise finalise) {
+  return finalise == PTYPE_FINALISE_true;
+}
+
 r_obj* vec_ptype(r_obj* x, struct vctrs_arg* x_arg, struct r_lazy call);
 r_obj* vec_ptype_final(r_obj* x, struct vctrs_arg* x_arg, struct r_lazy call);
 
diff --git a/src/recode.c b/src/recode.c
@@ -777,6 +777,7 @@ r_obj* ptype_finalize(
     ptype = KEEP(vec_ptype_common(
       to,
       r_null,
+      PTYPE_FINALISE_DEFAULT,
       S3_FALLBACK_DEFAULT,
       p_to_arg,
       error_call
diff --git a/tests/testthat/_snaps/cast.md b/tests/testthat/_snaps/cast.md
@@ -83,3 +83,11 @@
       i Please use `allow_lossy_cast()` instead.
       i We detected a lossy transformation from `x` <fct> to `to` <fct>. The result will contain lower-resolution values or missing values. To suppress this warning, wrap your code with `allow_lossy_cast()`.
 
+# can cast to unspecified `NA` with `vec_cast()` and `vec_cast_common()` (#2099)
+
+    Code
+      vec_cast(TRUE, to = unspecified(1))
+    Condition
+      Error:
+      ! Can't convert `TRUE` <logical> to <vctrs_unspecified>.
+
diff --git a/tests/testthat/test-cast.R b/tests/testthat/test-cast.R
@@ -342,3 +342,98 @@ test_that("bare-type fallback for df-cast works", {
 
   expect_error(vec_rbind(gdf, gdf), NA)
 })
+
+test_that("can cast to unspecified `NA` with `vec_cast()` and `vec_cast_common()` (#2099)", {
+  # It feels important that this works
+  expect_identical(vec_cast(TRUE, to = NA), TRUE)
+  expect_identical(vec_cast_common(TRUE, .to = NA), list(TRUE))
+
+  # The cast-common case works here due to `.to` being finalized to `<logical>`
+  # before casting. `vec_cast()` itself does not finalize before casting. This
+  # feels like a rarer inconsistency than the above `NA` cases.
+  expect_snapshot(error = TRUE, {
+    vec_cast(TRUE, to = unspecified(1))
+  })
+  expect_identical(vec_cast_common(TRUE, .to = unspecified(1)), list(TRUE))
+})
+
+test_that("can opt out of ptype finalization for <unspecified> (#2099)", {
+  # Typically always finalizes
+  expect_identical(vec_ptype_common(NA), logical())
+  expect_identical(vec_ptype_common(NA, NA), logical())
+  expect_identical(vec_ptype_common(unspecified(1)), logical())
+  expect_identical(vec_ptype_common(unspecified(1), unspecified(1)), logical())
+
+  # Can opt out of finalization using low level `.finalise` option
+  expect_identical(
+    vec_ptype_common_params(NA, .finalise = FALSE),
+    unspecified()
+  )
+  expect_identical(
+    vec_ptype_common_params(NA, NA, .finalise = FALSE),
+    unspecified()
+  )
+  expect_identical(
+    vec_ptype_common_params(unspecified(1), .finalise = FALSE),
+    unspecified()
+  )
+  expect_identical(
+    vec_ptype_common_params(unspecified(1), unspecified(1), .finalise = FALSE),
+    unspecified()
+  )
+
+  # Typically always finalizes explicit `.ptype`
+  expect_identical(
+    vec_ptype_common(.ptype = NA),
+    logical()
+  )
+  expect_identical(
+    vec_ptype_common(.ptype = unspecified(1)),
+    logical()
+  )
+
+  # Can opt out of finalization using low level `.finalise` option
+  expect_identical(
+    vec_ptype_common_params(.ptype = NA, .finalise = FALSE),
+    unspecified()
+  )
+  expect_identical(
+    vec_ptype_common_params(.ptype = unspecified(1), .finalise = FALSE),
+    unspecified()
+  )
+})
+
+test_that("can opt out of ptype finalization for <vctrs_partial> (#2099)", {
+  # Typically always finalizes
+  expect_identical(vec_ptype_common(partial_factor()), factor())
+  expect_identical(
+    vec_ptype_common(partial_factor("a"), partial_factor("b")),
+    factor(levels = c("a", "b"))
+  )
+
+  # Can opt out of finalization using low level `.finalise` option
+  expect_identical(
+    vec_ptype_common_params(partial_factor(), .finalise = FALSE),
+    partial_factor()
+  )
+  expect_identical(
+    vec_ptype_common_params(
+      partial_factor("a"),
+      partial_factor("b"),
+      .finalise = FALSE
+    ),
+    partial_factor(c("a", "b"))
+  )
+
+  # Typically always finalizes explicit `.ptype`
+  expect_identical(
+    vec_ptype_common(.ptype = partial_factor()),
+    factor()
+  )
+
+  # Can opt out of finalization using low level `.finalise` option
+  expect_identical(
+    vec_ptype_common_params(.ptype = partial_factor(), .finalise = FALSE),
+    partial_factor()
+  )
+})
