Pass prototypes to vec_ptype2() methods (#1049)

Author: lionel-

NEWS.md

@@ -86,6 +86,10 @@ The following errors are caused by breaking changes.
   worked correctly in a double-dispatch setting. Parent methods must
   now be called manually.
 
+* `vec_ptype2()` methods now get zero-size prototypes as inputs. This
+  guarantees that methods do not peek at the data to determine the
+  richer type.
+
 * `vec_is_list()` no longer allows S3 lists that implement a `vec_proxy()`
   method to automatically be considered lists. A S3 list must explicitly
   inherit from `"list"` in the base class to be considered a list.

src/ptype2-dispatch.c

@@ -65,8 +65,8 @@ static inline SEXP vec_ptype2_default(SEXP x,
 
 // [[ include("vctrs.h") ]]
 SEXP vec_ptype2_dispatch_s3(const struct ptype2_opts* opts) {
-  SEXP x = opts->x;
-  SEXP y = opts->y;
+  SEXP x = PROTECT(vec_ptype(opts->x, opts->x_arg));
+  SEXP y = PROTECT(vec_ptype(opts->y, opts->y_arg));
 
   SEXP x_arg_obj = PROTECT(vctrs_arg(opts->x_arg));
   SEXP y_arg_obj = PROTECT(vctrs_arg(opts->y_arg));
@@ -99,7 +99,7 @@ SEXP vec_ptype2_dispatch_s3(const struct ptype2_opts* opts) {
 
   if (method == R_NilValue) {
     SEXP out = vec_ptype2_default(x, y, x_arg_obj, y_arg_obj, opts->df_fallback);
-    UNPROTECT(3);
+    UNPROTECT(5);
     return out;
   }
 
@@ -109,7 +109,7 @@ SEXP vec_ptype2_dispatch_s3(const struct ptype2_opts* opts) {
                              syms_x_arg, x_arg_obj,
                              syms_y_arg, y_arg_obj);
 
-  UNPROTECT(3);
+  UNPROTECT(5);
   return out;
 }
 

tests/testthat/test-type2.R

@@ -282,6 +282,26 @@ test_that("common type warnings for data frames take attributes into account", {
   })
 })
 
+test_that("vec_ptype2() methods get prototypes", {
+  x <- NULL
+  y <- NULL
+
+  local_methods(vec_ptype2.vctrs_foobar.vctrs_foobar = function(x, y, ...) {
+    x <<- x
+    y <<- y
+    NULL
+  })
+
+  vec_ptype2(foobar(1:3), foobar(letters))
+  expect_identical(x, foobar(int()))
+  expect_identical(y, foobar(chr()))
+
+  skip("Figure out what to do with row names in `vec_ptype()`")
+  vec_ptype2(foobar(mtcars), foobar(iris))
+  expect_identical(x, foobar(mtcars[0, , drop = FALSE]))
+  expect_identical(y, foobar(iris[0, , drop = FALSE]))
+})
+
 test_that("vec_ptype2() errors have informative output", {
   verify_output(test_path("error", "test-type2.txt"), {
     "# can override scalar vector error message for base scalar types"