From 240da9e12a265ad800e48ab6cb80f80a37579e81 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Kirill=20M=C3=BCller?= <krlmlr@users.noreply.github.com>
Date: Tue, 13 Feb 2024 23:04:23 +0100
Subject: [PATCH] Test that `summarize()` strips off the subclass (#6988)

* Test that `summarize()` strips off the subclass

* Align snapshot tests (#6987)

* Align snapshot tests

* Bump rlang and cli for snapshot tests

---------

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

* Tweak the test a little

* Mention `summarise()` / `reframe()` behavior in extension docs

---------

Co-authored-by: Davis Vaughan <davis@posit.co>
---
 R/generics.R                    |  4 +++-
 man/dplyr_extending.Rd          |  4 +++-
 tests/testthat/test-summarise.R | 29 ++++++++++++++++++++++++++---
 3 files changed, 32 insertions(+), 5 deletions(-)

diff --git a/R/generics.R b/R/generics.R
index a9155f1a44..cfb440e838 100644
--- a/R/generics.R
+++ b/R/generics.R
@@ -63,7 +63,9 @@
 #'
 #' * `summarise()` and `reframe()` work similarly to `mutate()` but the data
 #'   modified by `dplyr_col_modify()` comes from `group_data()` or is built
-#'   from `.by`.
+#'   from `.by`. Note that this means that the data frames returned by
+#'   `summarise()` and `reframe()` are fundamentally new data frames, and
+#'   will not retain any custom subclasses or attributes.
 #'
 #' * `select()` uses 1d `[` to select columns, then `names<-` to rename them.
 #'   `rename()` just uses `names<-`. `relocate()` just uses 1d `[`.
diff --git a/man/dplyr_extending.Rd b/man/dplyr_extending.Rd
index 72d5106e6d..0aec418efe 100644
--- a/man/dplyr_extending.Rd
+++ b/man/dplyr_extending.Rd
@@ -82,7 +82,9 @@ It also uses 1d \code{[} to implement \code{.keep}, and will call \code{relocate
 either \code{.before} or \code{.after} are supplied.
 \item \code{summarise()} and \code{reframe()} work similarly to \code{mutate()} but the data
 modified by \code{dplyr_col_modify()} comes from \code{group_data()} or is built
-from \code{.by}.
+from \code{.by}. Note that this means that the data frames returned by
+\code{summarise()} and \code{reframe()} are fundamentally new data frames, and
+will not retain any custom subclasses or attributes.
 \item \code{select()} uses 1d \code{[} to select columns, then \verb{names<-} to rename them.
 \code{rename()} just uses \verb{names<-}. \code{relocate()} just uses 1d \code{[}.
 \item \code{inner_join()}, \code{left_join()}, \code{right_join()}, and \code{full_join()}
diff --git a/tests/testthat/test-summarise.R b/tests/testthat/test-summarise.R
index eec046542a..2a0db3b23f 100644
--- a/tests/testthat/test-summarise.R
+++ b/tests/testthat/test-summarise.R
@@ -60,21 +60,44 @@ test_that("no expressions yields grouping data", {
   expect_equal(summarise(gf, !!!list()), tibble(x = 1:2))
 })
 
-test_that("preserved class, but not attributes", {
+test_that("doesn't preserve attributes", {
   df <- structure(
     data.frame(x = 1:10, g1 = rep(1:2, each = 5), g2 = rep(1:5, 2)),
     meta = "this is important"
   )
 
   out <- df %>% summarise(n = n())
-  expect_s3_class(out, "data.frame", exact = TRUE)
   expect_null(attr(out, "res"))
 
   out <- df %>% group_by(g1) %>% summarise(n = n())
-  # expect_s3_class(out, "data.frame", exact = TRUE)
   expect_null(attr(out, "res"))
 })
 
+test_that("strips off subclass", {
+  # We consider the data frame returned by `summarise()` to be
+  # "fundamentally a new data frame"
+
+  df <- new_data_frame(list(a = 1), class = "myclass")
+  out <- df %>% summarise(n = n())
+  expect_s3_class(out, "data.frame", exact = TRUE)
+  out <- df %>% summarise(.by = a, n = n())
+  expect_s3_class(out, "data.frame", exact = TRUE)
+
+  df <- new_tibble(list(a = 1), class = "myclass")
+  out <- df %>% summarise(n = n())
+  expect_s3_class(out, class(tibble()), exact = TRUE)
+  out <- df %>% summarise(.by = a, n = n())
+  expect_s3_class(out, class(tibble()), exact = TRUE)
+
+  gdf <- group_by(tibble(a = 1), a)
+  df <- gdf
+  class(df) <- c("myclass", class(gdf))
+  out <- df %>% summarise(n = n(), .groups = "drop")
+  expect_s3_class(out, class(tibble()), exact = TRUE)
+  out <- df %>% summarise(n = n(), .groups = "keep")
+  expect_s3_class(out, class(gdf), exact = TRUE)
+})
+
 test_that("works with unquoted values", {
   df <- tibble(g = c(1, 1, 2, 2, 2), x = 1:5)
   expect_equal(summarise(df, out = !!1), tibble(out = 1))