Use vec_is_list() in bind_cols() and bind_rows() (tidyverse#4990)

* Use `vec_is_list()` in `bind_cols()` * Use `vec_is_list()` in `bind_rows()`
DavisVaughan · Mar 18, 2020 · e2e5a5b · e2e5a5b
1 parent 3e3850b
commit e2e5a5b
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 6 deletions.
diff --git a/R/bind.r b/R/bind.r
@@ -81,7 +81,7 @@ bind_rows <- function(..., .id = NULL) {
   dots <- list2(...)
 
   # bind_rows() has weird legacy squashing behaviour
-  is_flattenable <- function(x) is.list(x) && !is_named(x) && !is.data.frame(x)
+  is_flattenable <- function(x) vec_is_list(x) && !is_named(x)
   if (length(dots) == 1 && is_bare_list(dots[[1]])) {
     dots <- dots[[1]]
   }
@@ -129,8 +129,7 @@ bind_rows <- function(..., .id = NULL) {
 bind_cols <- function(...) {
   dots <- list2(...)
 
-  is_flattenable <- function(x) is.list(x) && !is.data.frame(x)
-  dots <- squash_if(dots, is_flattenable)
+  dots <- squash_if(dots, vec_is_list)
   dots <- discard(dots, is.null)
 
   # Strip names off of data frame components so that vec_cbind() unpacks them

diff --git a/tests/testthat/test-bind.R b/tests/testthat/test-bind.R
@@ -483,10 +483,24 @@ test_that("bind_cols() handles unnamed list with name repair (#3402)", {
   )
 })
 
-test_that("bind_rows handles typed lists (#3924)", {
+test_that("bind_cols() doesn't squash record types", {
+  df <- data.frame(x = 1)
+  posixlt <- as.POSIXlt(as.Date("1970-01-01"))
+
+  expect_identical(
+    bind_cols(df, y = posixlt),
+    new_data_frame(list(x = 1, y = posixlt))
+  )
+})
+
+test_that("bind_rows() only flattens list subclasses with explicit inheritance (#3924)", {
   df <- data.frame(x = 1, y = 2)
-  lst <- structure(list(df, df, df), class = "special_lst")
-  expect_equal(bind_rows(lst), bind_rows(df,df,df))
+
+  lst1 <- structure(list(df, df, df), class = "special_lst")
+  expect_error(bind_rows(lst1), "must be a data frame or a named atomic vector")
+
+  lst2 <- structure(list(df, df, df), class = c("special_lst", "list"))
+  expect_equal(bind_rows(lst2), bind_rows(df,df,df))
 })
 
 test_that("bind_rows() handles named list", {