Ensure we vec_ptype_finalise() when we treat vec_ptype2() like a "common" ptype computation (#2107)

* Adding finalise ptype before casting parameters

* Fix protection issues

* Finalize `ptype` in `vec_if_else()`

* Finalize `ptype` in interval functions

* Delay `ptype` finalization in `vec_recode_values()`

Until after `default` has been included, then we `vec_ptype_finalize()` on the way out

* Header is already included

---------

Co-authored-by: Davis Vaughan <davis@posit.co>

Author: jtlandis

src/dictionary.c

@@ -396,23 +396,37 @@ SEXP vec_match_params(SEXP needles,
                       struct vctrs_arg* haystack_arg,
                       struct r_lazy call) {
   int nprot = 0;
+
   int _;
-  SEXP type = vec_ptype2_params(needles, haystack,
-                                needles_arg, haystack_arg,
-                                call,
-                                &_);
+  SEXP type = vec_ptype2_params(
+    needles,
+    haystack,
+    needles_arg,
+    haystack_arg,
+    call,
+    &_
+  );
   PROTECT_N(type, &nprot);
+  type = PROTECT_N(vec_ptype_finalise(type), &nprot);
 
-  needles = vec_cast_params(needles, type,
-                            needles_arg, vec_args.empty,
-                            call,
-                            S3_FALLBACK_false);
+  needles = vec_cast_params(
+    needles,
+    type,
+    needles_arg,
+    vec_args.empty,
+    call,
+    S3_FALLBACK_false
+  );
   PROTECT_N(needles, &nprot);
 
-  haystack = vec_cast_params(haystack, type,
-                             haystack_arg, vec_args.empty,
-                             call,
-                             S3_FALLBACK_false);
+  haystack = vec_cast_params(
+    haystack,
+    type,
+    haystack_arg,
+    vec_args.empty,
+    call,
+    S3_FALLBACK_false
+  );
   PROTECT_N(haystack, &nprot);
 
   needles = PROTECT_N(vec_proxy_equal(needles), &nprot);
@@ -559,7 +573,6 @@ SEXP vec_in(
   int nprot = 0;
 
   int _;
-
   SEXP type = vec_ptype2_params(
     needles,
     haystack,
@@ -569,6 +582,7 @@ SEXP vec_in(
     &_
   );
   PROTECT_N(type, &nprot);
+  type = PROTECT_N(vec_ptype_finalise(type), &nprot);
 
   needles = vec_cast_params(
     needles,

src/if-else.c

@@ -588,6 +588,9 @@ r_obj* ptype_finalize(
     );
   }
 
+  // Finalize on the way out
+  ptype = vec_ptype_finalise(ptype);
+
   FREE(n_prot);
   return ptype;
 }

src/interval.c

@@ -82,6 +82,7 @@ r_obj* vec_interval_group_info(r_obj* start,
     &_
   );
   KEEP_N(ptype, &n_prot);
+  ptype = KEEP_N(vec_ptype_finalise(ptype), &n_prot);
 
   start = vec_cast_params(
     start,
@@ -324,6 +325,7 @@ r_obj* vec_interval_complement(r_obj* start,
     &_
   );
   KEEP_N(ptype, &n_prot);
+  ptype = KEEP_N(vec_ptype_finalise(ptype), &n_prot);
 
   start = vec_cast_params(
     start,
@@ -733,6 +735,7 @@ r_obj* vec_interval_locate_containers(r_obj* start, r_obj* end) {
     &_
   );
   KEEP_N(ptype, &n_prot);
+  ptype = KEEP_N(vec_ptype_finalise(ptype), &n_prot);
 
   start = vec_cast_params(
     start,

src/match.c

@@ -154,6 +154,7 @@ r_obj* vec_locate_matches(r_obj* needles,
     error_call,
     &_
   ), &n_prot);
+  ptype = KEEP_N(vec_ptype_finalise(ptype), &n_prot);
 
   needles = KEEP_N(vec_cast_params(
     needles,

src/recode.c

@@ -771,28 +771,35 @@ r_obj* ptype_finalize(
   }
 
   // Otherwise `ptype` is `NULL`, and we determine it from `to` and `default`
+  r_keep_loc ptype_pi;
+  KEEP_HERE(ptype, &ptype_pi);
 
   if (to_as_list_of_vectors) {
     // Use only `to` and `p_to_arg` first for best errors
-    ptype = KEEP(vec_ptype_common(
+    // Not finalising `ptype` yet in case we need to incorporate `default`!
+    ptype = vec_ptype_common(
       to,
       r_null,
-      PTYPE_FINALISE_DEFAULT,
+      PTYPE_FINALISE_false,
       S3_FALLBACK_DEFAULT,
       p_to_arg,
       error_call
-    ));
+    );
+    KEEP_AT(ptype, ptype_pi);
 
     // Now incorporate `default` and `p_default_arg`
     int _;
-    ptype = KEEP(vec_ptype2_params(default_, ptype, p_default_arg, vec_args.empty, error_call, &_));
-
-    FREE(2);
+    ptype = vec_ptype2_params(default_, ptype, p_default_arg, vec_args.empty, error_call, &_);
+    KEEP_AT(ptype, ptype_pi);
   } else {
     int _;
-    ptype = KEEP(vec_ptype2_params(to, default_, p_to_arg, p_default_arg, error_call, &_));
-    FREE(1);
+    ptype = vec_ptype2_params(to, default_, p_to_arg, p_default_arg, error_call, &_);
+    KEEP_AT(ptype, ptype_pi);
   }
 
+  // Finalize on the way out
+  ptype = vec_ptype_finalise(ptype);
+
+  FREE(1);
   return ptype;
 }

tests/testthat/test-recode.R

@@ -460,9 +460,7 @@ test_that("proof that `ptype` finalization is important", {
   to <- FALSE
 
   # If no `ptype` finalization happened, then `ptype = x` would result in
-  # `unspecified` being the output type and these would error. `list_combine()`
-  # now does `ptype` finalization when an explicit `ptype` is provided, so this
-  # works.
+  # `unspecified` being the output type and these would error
   expect_identical(
     vec_recode_values(x, from = from, to = to, default = x, ptype = x),
     c(FALSE, FALSE)
@@ -473,6 +471,31 @@ test_that("proof that `ptype` finalization is important", {
   )
 })
 
+test_that("common `ptype` of `to` isn't finalized until `default` has been included", {
+  # If the common type of `to` is finalized early, we get `logical`, which can't
+  # combine with `default`'s `character` type
+  expect_identical(
+    vec_recode_values(
+      x = "a",
+      from = "a",
+      to = list(NA),
+      default = "x",
+      to_as_list_of_vectors = TRUE
+    ),
+    NA_character_
+  )
+  expect_identical(
+    vec_recode_values(
+      x = "a",
+      from = "b",
+      to = list(NA),
+      default = "x",
+      to_as_list_of_vectors = TRUE
+    ),
+    "x"
+  )
+})
+
 test_that("extraneous `to` attributes don't end up on the final output", {
   x <- c(1, 2, 3)