GH-35038: [R] argument order in arrow_table affects object return type (#35039)

thisisnic · nealrichardson · web-flow · commit 6b4e0f6d8b76 · 2023-04-11T17:16:32.000+01:00
* Closes: #35038 Lead-authored-by: Nic Crane <thisisnic@gmail.com> Co-authored-by: Neal Richardson <neal.p.richardson@gmail.com> Signed-off-by: Nic Crane <thisisnic@gmail.com>
diff --git a/r/src/table.cpp b/r/src/table.cpp
@@ -228,7 +228,8 @@ arrow::Status AddMetadataFromDots(SEXP lst, int num_fields,
   // "top level" attributes, only relevant if the first object is not named and a data
   // frame
   cpp11::strings names = Rf_getAttrib(lst, R_NamesSymbol);
-  if (names[0] == "" && Rf_inherits(VECTOR_ELT(lst, 0), "data.frame")) {
+  if (names[0] == "" && Rf_inherits(VECTOR_ELT(lst, 0), "data.frame") &&
+      Rf_xlength(lst) == 1) {
     SEXP top_level = metadata[0] = arrow_attributes(VECTOR_ELT(lst, 0), true);
     if (!Rf_isNull(top_level) && XLENGTH(top_level) > 0) {
       has_top_level_metadata = true;
diff --git a/r/tests/testthat/test-Table.R b/r/tests/testthat/test-Table.R
@@ -711,3 +711,22 @@ test_that("as_arrow_table() errors on data.frame with NULL names", {
   names(df) <- NULL
   expect_error(as_arrow_table(df), "Input data frame columns must be named")
 })
+
+test_that("we only preserve metadata of input to arrow_table when passed a single data.frame", {
+  # data.frame in, data.frame out
+  df <- data.frame(x = 1)
+  out1 <- as.data.frame(arrow_table(df))
+  expect_s3_class(out1, "data.frame", exact = TRUE)
+
+  # tibble in, tibble out
+  tib <- tibble::tibble(x = 1)
+  out2 <- as.data.frame(arrow_table(tib))
+  expect_s3_class(out2, c("tbl_df", "tbl", "data.frame"), exact = TRUE)
+
+  # GH-35038 - passing in multiple arguments doesn't affect return type
+  out3 <- as.data.frame(arrow_table(df, name = "1"))
+  out4 <- as.data.frame(arrow_table(name = "1", df))
+
+  expect_s3_class(out3, c("tbl_df", "tbl", "data.frame"), exact = TRUE)
+  expect_s3_class(out4, c("tbl_df", "tbl", "data.frame"), exact = TRUE)
+})
