Delay ptype finalization in list_combine()

Until after `default` has been considered as well

Author: DavisVaughan

src/list-combine.c

@@ -1803,12 +1803,12 @@ r_obj* ptype_common_with_default(
 
   // Okay `ptype` is `NULL`. We determine it from `xs` and `default`.
 
-  // Use only `xs` and `p_xs_arg` first for best errors
+  // Use only `xs` and `p_xs_arg` first for best errors.
+  // Not finalising `ptype` yet in case we need to incorporating `default`!
   ptype = KEEP(vec_ptype_common(
     xs,
     ptype,
-    // TODO!: This should be `false`
-    PTYPE_FINALISE_true,
+    PTYPE_FINALISE_false,
     s3_fallback,
     p_xs_arg,
     error_call
@@ -1829,7 +1829,10 @@ r_obj* ptype_common_with_default(
   }
   KEEP(ptype);
 
-  FREE(2);
+  // Now finalise after incorporating `default`
+  ptype = KEEP(vec_ptype_finalise(ptype));
+
+  FREE(3);
   return ptype;
 }
 

tests/testthat/test-case-when.R

@@ -272,6 +272,17 @@ test_that("`default` that is an unused logical `NA` can still be cast to `values
   expect_identical(vec_case_when(list(TRUE), list("x"), default = NA), "x")
 })
 
+test_that("`default` type is used when all values are logical `NA` (#2094)", {
+  expect_identical(
+    vec_case_when(list(TRUE), list(NA), default = "a"),
+    NA_character_
+  )
+  expect_identical(
+    vec_case_when(list(c(TRUE, FALSE)), list(NA), default = "a"),
+    c(NA_character_, "a")
+  )
+})
+
 test_that("`default_arg` can be customized", {
   expect_snapshot(error = TRUE, {
     vec_case_when(list(FALSE), list(1L), default = 2:3, default_arg = "foo")

tests/testthat/test-list-combine.R

@@ -1886,6 +1886,27 @@ test_that("can specify a ptype to override common type", {
   })
 })
 
+test_that("common type is correctly computed with unspecified values and a `default` (#2094)", {
+  expect_identical(
+    list_combine(
+      x = list(NA),
+      indices = list(1),
+      size = 1,
+      default = "a"
+    ),
+    NA_character_
+  )
+  expect_identical(
+    list_combine(
+      x = list(NA),
+      indices = list(1),
+      size = 2,
+      default = "a"
+    ),
+    c(NA, "a")
+  )
+})
+
 test_that("outer names are kept", {
   x <- list(x = 1, y = 2)
   expect_named_list_combine(