From 579ae5fe102e741e4bebe59b107dca6bf07c1d12 Mon Sep 17 00:00:00 2001
From: Lionel Henry <lionel.hry@gmail.com>
Date: Fri, 17 Apr 2020 18:00:57 +0200
Subject: [PATCH 1/5] Unname common prototypes

---
 NEWS.md                     |  3 +++
 src/type.c                  | 12 +++++++++++-
 src/type2.c                 |  8 ++++----
 src/vctrs.h                 |  1 +
 tests/testthat/test-type2.R |  9 +++++++++
 5 files changed, 28 insertions(+), 5 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index f1f7c9866..abe8bcd98 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,6 +1,9 @@
 
 # vctrs (development version)
 
+* `vec_ptype2()` and `vec_ptype_common()` now consistently return
+  unnamed prototypes.
+
 * `new_vctr()` now always appends a base `"list"` class to list `.data` to
   be compatible with changes to `vec_is_list()`. This affects `new_list_of()`,
   which now returns an object with a base class of `"list"`.
diff --git a/src/type.c b/src/type.c
index 4d1c290b4..7987346dc 100644
--- a/src/type.c
+++ b/src/type.c
@@ -37,6 +37,14 @@ SEXP vec_ptype(SEXP x, struct vctrs_arg* x_arg) {
   never_reached("vec_ptype");
 }
 
+// [[ include("vctrs.h") ]]
+SEXP vec_ptype_unnamed(SEXP x, struct vctrs_arg* x_arg) {
+  SEXP out = PROTECT(vec_ptype(x, x_arg));
+  out = vec_set_names(out, R_NilValue);
+  UNPROTECT(1);
+  return out;
+}
+
 static SEXP col_ptype(SEXP x) {
   return vec_ptype(x, args_empty);
 }
@@ -161,9 +169,11 @@ SEXP vctrs_type_common(SEXP call, SEXP op, SEXP args, SEXP env) {
   return out;
 }
 
+
+
 SEXP vctrs_type_common_impl(SEXP dots, SEXP ptype) {
   if (!vec_is_partial(ptype)) {
-    return vec_ptype(ptype, args_dot_ptype);
+    return vec_ptype_unnamed(ptype, args_dot_ptype);
   }
 
   if (r_is_true(r_peek_option("vctrs.no_guessing"))) {
diff --git a/src/type2.c b/src/type2.c
index 88db9abd3..b6716f405 100644
--- a/src/type2.c
+++ b/src/type2.c
@@ -18,21 +18,21 @@ SEXP vec_ptype2(SEXP x, SEXP y,
                int* left) {
   if (x == R_NilValue) {
     *left = y == R_NilValue;
-    return vec_ptype(y, y_arg);
+    return vec_ptype_unnamed(y, y_arg);
   }
   if (y == R_NilValue) {
     *left = x == R_NilValue;
-    return vec_ptype(x, x_arg);
+    return vec_ptype_unnamed(x, x_arg);
   }
 
   enum vctrs_type type_x = vec_typeof(x);
   enum vctrs_type type_y = vec_typeof(y);
 
   if (type_x == vctrs_type_unspecified) {
-    return vec_ptype(y, y_arg);
+    return vec_ptype_unnamed(y, y_arg);
   }
   if (type_y == vctrs_type_unspecified) {
-    return vec_ptype(x, x_arg);
+    return vec_ptype_unnamed(x, x_arg);
   }
 
   if (type_x == vctrs_type_scalar) {
diff --git a/src/vctrs.h b/src/vctrs.h
index c2d270017..4a25b45c5 100644
--- a/src/vctrs.h
+++ b/src/vctrs.h
@@ -373,6 +373,7 @@ SEXP vec_assign_shaped(SEXP proxy, SEXP index, SEXP value);
 bool vec_requires_fallback(SEXP x, struct vctrs_proxy_info info);
 SEXP vec_init(SEXP x, R_len_t n);
 SEXP vec_ptype(SEXP x, struct vctrs_arg* x_arg);
+SEXP vec_ptype_unnamed(SEXP x, struct vctrs_arg* x_arg);
 SEXP vec_ptype_finalise(SEXP x);
 bool vec_is_unspecified(SEXP x);
 SEXP vec_recycle(SEXP x, R_len_t size, struct vctrs_arg* x_arg);
diff --git a/tests/testthat/test-type2.R b/tests/testthat/test-type2.R
index 0dbb57685..e7efa6edc 100644
--- a/tests/testthat/test-type2.R
+++ b/tests/testthat/test-type2.R
@@ -225,3 +225,12 @@ test_that("vec_ptype2() errors have informative output", {
   })
 })
 
+test_that("common type doesn't have names", {
+  # For reference, vec_ptype() currently keeps names
+  expect_identical(vec_ptype(c(foo = 1)), named(dbl()))
+
+  expect_identical(vec_ptype2(c(foo = 1), c(bar = 2)), dbl())
+  expect_identical(vec_ptype_common(c(foo = 1)), dbl())
+  expect_identical(vec_ptype_common(c(foo = 1), c(bar = 2)), dbl())
+  expect_identical(vec_ptype_common(c(foo = 1), .ptype = c(bar = 2)), dbl())
+})

From 2126fdee6531fb5b002e413b8c59682db3b45548 Mon Sep 17 00:00:00 2001
From: Lionel Henry <lionel.hry@gmail.com>
Date: Fri, 17 Apr 2020 18:05:19 +0200
Subject: [PATCH 2/5] Allow setting names of partial and rcrd vectors to NULL

Now a requirement of `vec_ptype2()`
---
 NAMESPACE                       |  2 ++
 R/partial.R                     | 12 ++++++++++++
 R/type-rcrd.R                   | 11 +++++++++++
 tests/testthat/test-type-rcrd.R | 16 ++++++++++++++++
 4 files changed, 41 insertions(+)

diff --git a/NAMESPACE b/NAMESPACE
index fa37ca761..1f55db9ed 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -49,6 +49,8 @@ S3method("length<-",vctrs_rcrd)
 S3method("length<-",vctrs_vctr)
 S3method("levels<-",vctrs_sclr)
 S3method("levels<-",vctrs_vctr)
+S3method("names<-",vctrs_partial)
+S3method("names<-",vctrs_rcrd)
 S3method("names<-",vctrs_sclr)
 S3method("names<-",vctrs_vctr)
 S3method("|",vctrs_vctr)
diff --git a/R/partial.R b/R/partial.R
index a4a1ce5ea..1c9f78e43 100644
--- a/R/partial.R
+++ b/R/partial.R
@@ -18,6 +18,18 @@ new_partial <- function(..., class = character()) {
   new_sclr(..., class = c(class, "vctrs_partial"))
 }
 
+## Needed because partial classes inherit from `vctrs_sclr` which
+## can't be renamed. And `vec_ptype2()` etc zap the names.
+#' @export
+`names<-.vctrs_partial` <- function(x, value) {
+  # Allow setting names to `NULL` for compatibility with `vec_ptype2()`
+  if (!is_null(value)) {
+    abort("Can't set names of partial vectors.")
+  }
+  x
+}
+
+
 #' @export
 obj_print_header.vctrs_partial <- function(x, ...) {
   NULL
diff --git a/R/type-rcrd.R b/R/type-rcrd.R
index c0a55d2e0..3dd147628 100644
--- a/R/type-rcrd.R
+++ b/R/type-rcrd.R
@@ -61,6 +61,17 @@ vec_restore.vctrs_rcrd <- function(x, to, ...) {
   x
 }
 
+#' @export
+`names<-.vctrs_rcrd` <- function(x, value) {
+  # Allow setting names to `NULL` for compatibility with `vec_ptype2()`.
+  # Eventually we should add full names support via a special rcrd
+  # field.
+  if (!is_null(value)) {
+    abort("Setting the names of record vectors is currently unimplemented.")
+  }
+  x
+}
+
 #' @export
 length.vctrs_rcrd <- function(x) {
   .Call(vctrs_size, x)
diff --git a/tests/testthat/test-type-rcrd.R b/tests/testthat/test-type-rcrd.R
index 7b34b8316..02eee6985 100644
--- a/tests/testthat/test-type-rcrd.R
+++ b/tests/testthat/test-type-rcrd.R
@@ -28,6 +28,22 @@ test_that("vec_proxy() transforms records to data frames", {
   )
 })
 
+test_that("can't set names", {
+  x <- new_rcrd(list(x = 1, y = 2))
+  expect_error(vec_set_names(x, "foo"), "unimplemented")
+  expect_error(set_names(x, "foo"), "unimplemented")
+})
+
+test_that("can set names to NULL", {
+  x <- new_rcrd(list(x = 1, y = 2))
+
+  out <- vec_set_names(x, NULL)
+  expect_identical(unclass(out), list(x = 1, y = 2))
+
+  out <- set_names(x, NULL)
+  expect_identical(unclass(out), list(x = 1, y = 2))
+})
+
 
 # coercion ----------------------------------------------------------------
 

From fdfd2a047986de20c698a6ba50baa311774af064 Mon Sep 17 00:00:00 2001
From: Lionel Henry <lionel.hry@gmail.com>
Date: Fri, 17 Apr 2020 18:36:48 +0200
Subject: [PATCH 3/5] Remove row names of common prototypes

---
 src/type.c                  | 16 +++++++++++++++-
 tests/testthat/test-type2.R | 26 ++++++++++++++++++++------
 2 files changed, 35 insertions(+), 7 deletions(-)

diff --git a/src/type.c b/src/type.c
index 7987346dc..cab2a76bb 100644
--- a/src/type.c
+++ b/src/type.c
@@ -1,6 +1,7 @@
 #include "vctrs.h"
 #include "utils.h"
 #include "arg-counter.h"
+#include "type-data-frame.h"
 
 // Initialised at load time
 static SEXP syms_vec_ptype_finalise_dispatch = NULL;
@@ -9,6 +10,7 @@ static SEXP fns_vec_ptype_finalise_dispatch = NULL;
 
 static inline SEXP vec_ptype_slice(SEXP x, SEXP empty);
 static SEXP s3_type(SEXP x, struct vctrs_arg* x_arg);
+static SEXP df_ptype(SEXP x);
 
 // [[ register() ]]
 SEXP vctrs_ptype(SEXP x, SEXP x_arg) {
@@ -30,7 +32,7 @@ SEXP vec_ptype(SEXP x, struct vctrs_arg* x_arg) {
   case vctrs_type_character:   return vec_ptype_slice(x, vctrs_shared_empty_chr);
   case vctrs_type_raw:         return vec_ptype_slice(x, vctrs_shared_empty_raw);
   case vctrs_type_list:        return vec_ptype_slice(x, vctrs_shared_empty_list);
-  case vctrs_type_dataframe:   return bare_df_map(x, &col_ptype);
+  case vctrs_type_dataframe:   return df_ptype(x);
   case vctrs_type_s3:          return s3_type(x, x_arg);
   case vctrs_type_scalar:      stop_scalar_type(x, x_arg);
   }
@@ -83,6 +85,18 @@ static SEXP s3_type(SEXP x, struct vctrs_arg* x_arg) {
   return vec_slice(x, R_NilValue);
 }
 
+SEXP df_ptype(SEXP x) {
+  SEXP row_nms = PROTECT(df_rownames(x));
+  SEXP ptype = PROTECT(bare_df_map(x, &col_ptype));
+
+  if (TYPEOF(row_nms) == STRSXP) {
+    Rf_setAttrib(ptype, R_RowNamesSymbol, vctrs_shared_empty_chr);
+  }
+
+  UNPROTECT(2);
+  return ptype;
+}
+
 static SEXP vec_ptype_finalise_unspecified(SEXP x);
 static SEXP vec_ptype_finalise_dispatch(SEXP x);
 
diff --git a/tests/testthat/test-type2.R b/tests/testthat/test-type2.R
index e7efa6edc..d5ec42a9f 100644
--- a/tests/testthat/test-type2.R
+++ b/tests/testthat/test-type2.R
@@ -226,11 +226,25 @@ test_that("vec_ptype2() errors have informative output", {
 })
 
 test_that("common type doesn't have names", {
-  # For reference, vec_ptype() currently keeps names
-  expect_identical(vec_ptype(c(foo = 1)), named(dbl()))
+  vec1 <- c(foo = 1)
+  vec2 <- c(bar = 2)
+
+  expect_identical(vec_ptype2(vec1, vec2), dbl())
+  expect_identical(vec_ptype_common(vec1), dbl())
+  expect_identical(vec_ptype_common(vec1, vec2), dbl())
+  expect_identical(vec_ptype_common(vec1, .ptype = vec2), dbl())
+
+  df1 <- mtcars[1:2, ]
+  df2 <- mtcars[3:4, ]
+  exp <- unrownames(mtcars[0, ])
+  expect_identical(vec_ptype2(df1, df2), exp)
+  expect_identical(vec_ptype_common(df1), exp)
+  expect_identical(vec_ptype_common(df1, df2), exp)
+  expect_identical(vec_ptype_common(df1, .ptype = df2), exp)
 
-  expect_identical(vec_ptype2(c(foo = 1), c(bar = 2)), dbl())
-  expect_identical(vec_ptype_common(c(foo = 1)), dbl())
-  expect_identical(vec_ptype_common(c(foo = 1), c(bar = 2)), dbl())
-  expect_identical(vec_ptype_common(c(foo = 1), .ptype = c(bar = 2)), dbl())
+  # Note: Zero-rows matrices can't be named so they are not tested here
+
+  # For reference, vec_ptype() currently keeps names
+  expect_identical(vec_ptype(vec1), named(dbl()))
+  expect_identical(vec_ptype(df1), mtcars[0, ])
 })

From 66d299a853cc12ae00fbeb39d4f284565d2cba9d Mon Sep 17 00:00:00 2001
From: Lionel Henry <lionel.hry@gmail.com>
Date: Fri, 17 Apr 2020 19:16:17 +0200
Subject: [PATCH 4/5] Fix names handling of S3 classes in `vec_ptype()` and
 `vec_ptype2()`

---
 src/type.c                  | 18 ++++++++-----
 src/type2.c                 | 10 +++++--
 tests/testthat/helper-s3.R  |  8 +++++-
 tests/testthat/test-type2.R | 53 +++++++++++++++++++++++++------------
 4 files changed, 63 insertions(+), 26 deletions(-)

diff --git a/src/type.c b/src/type.c
index cab2a76bb..9ea756ac8 100644
--- a/src/type.c
+++ b/src/type.c
@@ -10,7 +10,7 @@ static SEXP fns_vec_ptype_finalise_dispatch = NULL;
 
 static inline SEXP vec_ptype_slice(SEXP x, SEXP empty);
 static SEXP s3_type(SEXP x, struct vctrs_arg* x_arg);
-static SEXP df_ptype(SEXP x);
+static SEXP df_ptype(SEXP x, bool bare);
 
 // [[ register() ]]
 SEXP vctrs_ptype(SEXP x, SEXP x_arg) {
@@ -32,7 +32,7 @@ SEXP vec_ptype(SEXP x, struct vctrs_arg* x_arg) {
   case vctrs_type_character:   return vec_ptype_slice(x, vctrs_shared_empty_chr);
   case vctrs_type_raw:         return vec_ptype_slice(x, vctrs_shared_empty_raw);
   case vctrs_type_list:        return vec_ptype_slice(x, vctrs_shared_empty_list);
-  case vctrs_type_dataframe:   return df_ptype(x);
+  case vctrs_type_dataframe:   return df_ptype(x, true);
   case vctrs_type_s3:          return s3_type(x, x_arg);
   case vctrs_type_scalar:      stop_scalar_type(x, x_arg);
   }
@@ -62,10 +62,10 @@ static inline SEXP vec_ptype_slice(SEXP x, SEXP empty) {
 static SEXP s3_type(SEXP x, struct vctrs_arg* x_arg) {
   switch (class_type(x)) {
   case vctrs_class_bare_tibble:
-    return bare_df_map(x, &col_ptype);
+    return df_ptype(x, true);
 
   case vctrs_class_data_frame:
-    return df_map(x, &col_ptype);
+    return df_ptype(x, false);
 
   case vctrs_class_bare_data_frame:
     Rf_errorcall(R_NilValue, "Internal error: Bare data frames should be handled by `vec_ptype()`");
@@ -85,9 +85,15 @@ static SEXP s3_type(SEXP x, struct vctrs_arg* x_arg) {
   return vec_slice(x, R_NilValue);
 }
 
-SEXP df_ptype(SEXP x) {
+SEXP df_ptype(SEXP x, bool bare) {
   SEXP row_nms = PROTECT(df_rownames(x));
-  SEXP ptype = PROTECT(bare_df_map(x, &col_ptype));
+
+  SEXP ptype = R_NilValue;
+  if (bare) {
+    ptype = PROTECT(bare_df_map(x, &col_ptype));
+  } else {
+    ptype = PROTECT(df_map(x, &col_ptype));
+  }
 
   if (TYPEOF(row_nms) == STRSXP) {
     Rf_setAttrib(ptype, R_RowNamesSymbol, vctrs_shared_empty_chr);
diff --git a/src/type2.c b/src/type2.c
index b6716f405..a7151197d 100644
--- a/src/type2.c
+++ b/src/type2.c
@@ -42,11 +42,17 @@ SEXP vec_ptype2(SEXP x, SEXP y,
     stop_scalar_type(y, y_arg);
   }
 
+  SEXP ptype = R_NilValue;
   if (type_x == vctrs_type_s3 || type_y == vctrs_type_s3) {
-    return vec_ptype2_dispatch(x, y, type_x, type_y, x_arg, y_arg, left);
+    ptype = PROTECT(vec_ptype2_dispatch(x, y, type_x, type_y, x_arg, y_arg, left));
   } else {
-    return vec_ptype2_switch_native(x, y, type_x, type_y, x_arg, y_arg, left);
+    ptype = PROTECT(vec_ptype2_switch_native(x, y, type_x, type_y, x_arg, y_arg, left));
   }
+
+  ptype = vec_set_names(ptype, R_NilValue);
+
+  UNPROTECT(1);
+  return ptype;
 }
 
 static SEXP vec_ptype2_switch_native(SEXP x,
diff --git a/tests/testthat/helper-s3.R b/tests/testthat/helper-s3.R
index 6d1ac1ac3..06afef2fa 100644
--- a/tests/testthat/helper-s3.R
+++ b/tests/testthat/helper-s3.R
@@ -1,5 +1,11 @@
 
-foobar <- function(x = list()) structure(x, class = "vctrs_foobar")
+foobar <- function(x = list()) {
+  if (is.data.frame(x)) {
+    structure(x, class = c("vctrs_foobar", "data.frame"))
+  } else {
+    structure(x, class = "vctrs_foobar")
+  }
+}
 
 with_c_foobar <- function(expr) {
   with_methods(
diff --git a/tests/testthat/test-type2.R b/tests/testthat/test-type2.R
index d5ec42a9f..5a4fdfca0 100644
--- a/tests/testthat/test-type2.R
+++ b/tests/testthat/test-type2.R
@@ -226,25 +226,44 @@ test_that("vec_ptype2() errors have informative output", {
 })
 
 test_that("common type doesn't have names", {
-  vec1 <- c(foo = 1)
-  vec2 <- c(bar = 2)
-
-  expect_identical(vec_ptype2(vec1, vec2), dbl())
-  expect_identical(vec_ptype_common(vec1), dbl())
-  expect_identical(vec_ptype_common(vec1, vec2), dbl())
-  expect_identical(vec_ptype_common(vec1, .ptype = vec2), dbl())
-
-  df1 <- mtcars[1:2, ]
-  df2 <- mtcars[3:4, ]
-  exp <- unrownames(mtcars[0, ])
-  expect_identical(vec_ptype2(df1, df2), exp)
-  expect_identical(vec_ptype_common(df1), exp)
-  expect_identical(vec_ptype_common(df1, df2), exp)
-  expect_identical(vec_ptype_common(df1, .ptype = df2), exp)
+  expect_unnamed <- function(vec1, vec2) {
+    exp <- vec_slice(vec1, 0)
+
+    if (is.data.frame(exp)) {
+      exp <- unrownames(exp)
+    } else {
+      exp <- unname(exp)
+    }
+
+    expect_identical(vec_ptype2(vec1, vec2), exp)
+    expect_identical(vec_ptype_common(vec1), exp)
+    expect_identical(vec_ptype_common(vec1, vec2), exp)
+    expect_identical(vec_ptype_common(vec1, .ptype = vec2), exp)
+  }
+
+  expect_unnamed(c(foo = 1), c(bar = 2))
+  expect_unnamed(foobar(c(foo = 1)), foobar(c(bar = 2)))
+
+  # Unlike the `vctrs_foobar` test above, this doesn't hit the is-same-type fallback
+  with_methods(
+    vec_ptype2.vctrs_foobar = function(x, y, ...) NULL,
+    vec_ptype2.vctrs_foobar.vctrs_foobar = function(x, y, ...) vec_slice(x, 0),
+    expect_unnamed(foobar(c(foo = 1)), foobar(c(bar = 2)))
+  )
+
+  expect_unnamed(mtcars[1:2, ], mtcars[3:4, ])
+  expect_unnamed(
+    foobar(mtcars[1:2, ]),
+    foobar(mtcars[3:4, ])
+  )
 
   # Note: Zero-rows matrices can't be named so they are not tested here
 
   # For reference, vec_ptype() currently keeps names
-  expect_identical(vec_ptype(vec1), named(dbl()))
-  expect_identical(vec_ptype(df1), mtcars[0, ])
+  expect_identical(vec_ptype(c(foo = 1)), named(dbl()))
+  expect_identical(vec_ptype(mtcars), mtcars[0, ])
+  expect_identical(vec_ptype(foobar(mtcars)), foobar(mtcars[0, ]))
+
+  skip("FIXME: vec_slice() doesn't restore foreign classes?")
+  expect_identical(vec_ptype(foobar(c(foo = 1))), foobar(named(dbl())))
 })

From 3b869ce8b706000d27c2d7ca189ab35cd1d80c53 Mon Sep 17 00:00:00 2001
From: Lionel Henry <lionel.hry@gmail.com>
Date: Fri, 17 Apr 2020 19:30:07 +0200
Subject: [PATCH 5/5] Empty the results of `vec_ptype2()` methods

---
 NEWS.md                         |  4 ++++
 src/type2.c                     |  2 +-
 tests/testthat/test-type-bare.R | 15 +++++++++++----
 tests/testthat/test-type2.R     | 24 +++++++++++++++++-------
 4 files changed, 33 insertions(+), 12 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index abe8bcd98..bf940ed68 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -1,6 +1,10 @@
 
 # vctrs (development version)
 
+* `vec_ptype2()` and `vec_ptype_common()` now always return empty
+  vectors. This simplifies the implementation of ptype2 methods, which
+  no longer need to worry about returning an empty vector.
+
 * `vec_ptype2()` and `vec_ptype_common()` now consistently return
   unnamed prototypes.
 
diff --git a/src/type2.c b/src/type2.c
index a7151197d..65929258a 100644
--- a/src/type2.c
+++ b/src/type2.c
@@ -49,7 +49,7 @@ SEXP vec_ptype2(SEXP x, SEXP y,
     ptype = PROTECT(vec_ptype2_switch_native(x, y, type_x, type_y, x_arg, y_arg, left));
   }
 
-  ptype = vec_set_names(ptype, R_NilValue);
+  ptype = vec_ptype_unnamed(ptype, NULL);
 
   UNPROTECT(1);
   return ptype;
diff --git a/tests/testthat/test-type-bare.R b/tests/testthat/test-type-bare.R
index b966949b7..973c99453 100644
--- a/tests/testthat/test-type-bare.R
+++ b/tests/testthat/test-type-bare.R
@@ -356,13 +356,20 @@ test_that("raw has informative type summaries", {
 })
 
 test_that("can provide common type with raw", {
+  lhs_dispatched <- FALSE
+  rhs_dispatched <- FALSE
+
   local_methods(
-    vec_ptype2.raw.vctrs_foobar = function(...) "dispatched-left",
+    vec_ptype2.raw.vctrs_foobar = function(...) rhs_dispatched <<- TRUE,
     vec_ptype2.vctrs_foobar = function(...) NULL,
-    vec_ptype2.vctrs_foobar.raw = function(...) "dispatched-right"
+    vec_ptype2.vctrs_foobar.raw = function(...) lhs_dispatched <<- TRUE
   )
-  expect_identical(vec_ptype2(raw(), foobar("")), "dispatched-left")
-  expect_identical(vec_ptype2(foobar(""), raw()), "dispatched-right")
+
+  vec_ptype2(raw(), foobar(""))
+  vec_ptype2(foobar(""), raw())
+
+  expect_true(lhs_dispatched)
+  expect_true(rhs_dispatched)
 })
 
 
diff --git a/tests/testthat/test-type2.R b/tests/testthat/test-type2.R
index 5a4fdfca0..2c317e773 100644
--- a/tests/testthat/test-type2.R
+++ b/tests/testthat/test-type2.R
@@ -143,19 +143,29 @@ test_that("vec_ptype2() returns empty prototype when other input is NULL", {
 test_that("Subclasses of data.frame dispatch to `vec_ptype2()` methods", {
   local_methods(
     vec_ptype2.quuxframe = function(x, y, ...) UseMethod("vec_ptype2.quuxframe"),
-    vec_ptype2.quuxframe.data.frame = function(x, y, ...) "dispatched!",
-    vec_ptype2.data.frame.quuxframe = function(x, y, ...) "dispatched!"
+    vec_ptype2.quuxframe.data.frame = function(x, y, ...) lhs_dispatched <<- TRUE,
+    vec_ptype2.data.frame.quuxframe = function(x, y, ...) rhs_dispatched <<- TRUE
   )
 
   quux <- structure(data.frame(), class = c("quuxframe", "data.frame"))
 
-  expect_identical(vec_ptype2(quux, mtcars), "dispatched!")
-  expect_identical(vec_ptype2(mtcars, quux), "dispatched!")
+  lhs_dispatched <- FALSE
+  rhs_dispatched <- FALSE
+
+  vec_ptype2(quux, mtcars)
+  vec_ptype2(mtcars, quux)
+  expect_true(lhs_dispatched)
+  expect_true(rhs_dispatched)
+
+  lhs_dispatched <- FALSE
+  rhs_dispatched <- FALSE
 
   quux <- structure(data.frame(), class = c("quuxframe", "tbl_df", "data.frame"))
 
-  expect_identical(vec_ptype2(quux, mtcars), "dispatched!")
-  expect_identical(vec_ptype2(mtcars, quux), "dispatched!")
+  vec_ptype2(quux, mtcars)
+  vec_ptype2(mtcars, quux)
+  expect_true(lhs_dispatched)
+  expect_true(rhs_dispatched)
 })
 
 test_that("Subclasses of `tbl_df` do not have `tbl_df` common type (#481)", {
@@ -247,7 +257,7 @@ test_that("common type doesn't have names", {
   # Unlike the `vctrs_foobar` test above, this doesn't hit the is-same-type fallback
   with_methods(
     vec_ptype2.vctrs_foobar = function(x, y, ...) NULL,
-    vec_ptype2.vctrs_foobar.vctrs_foobar = function(x, y, ...) vec_slice(x, 0),
+    vec_ptype2.vctrs_foobar.vctrs_foobar = function(x, y, ...) x,
     expect_unnamed(foobar(c(foo = 1)), foobar(c(bar = 2)))
   )