Check for data frame columns in melt_dataframe

Fixes #553
tidyverse · Feb 28, 2019 · 95f4a2f · 95f4a2f
1 parent c267c48
commit 95f4a2f
Show file tree

Hide file tree

Showing 3 changed files with 26 additions and 9 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,3 +1,5 @@
+* `gather()` throws an error if a column is a data frame (#553)
+
 # tidyr 0.8.3
 
 * `crossing()` preserves factor levels (#410), now works with list-columns 

diff --git a/src/melt.cpp b/src/melt.cpp
@@ -15,8 +15,13 @@ using namespace Rcpp;
   }
 
 SEXP rep_(SEXP x, int n, std::string var_name) {
-  if (!Rf_isVectorAtomic(x) && TYPEOF(x) != VECSXP)
-    stop("'%s' must be an atomic vector or list", var_name);
+  if (!Rf_isVectorAtomic(x) && TYPEOF(x) != VECSXP) {
+    Rf_errorcall(
+      R_NilValue,
+      "All columns must be atomic vectors or lists. Problem with '%s'",
+      var_name.c_str()
+    );
+  }
 
   if (Rf_inherits(x, "POSIXlt")) {
     stop("'%s' is a POSIXlt. Please convert to POSIXct.", var_name);
@@ -171,7 +176,10 @@ SEXP concatenate(const DataFrame& x, IntegerVector ind, bool factorsAsStrings) {
         break;
       }
     default:
-      stop("Must be atomic vector or list (not %s)", Rf_type2char(max_type));
+      Rf_errorcall(
+        R_NilValue,
+        "All columns be atomic vectors or lists (not %s)", Rf_type2char(max_type)
+      );
     }
   }
 
@@ -201,8 +209,12 @@ List melt_dataframe(const DataFrame& data,
 
   // Don't melt if the value variables are non-atomic
   for (int i = 0; i < n_measure; ++i) {
-    if (!Rf_isVector(data[measure_ind[i]])) {
-      stop("Must be atomic vector or list (column %i)", measure_ind[i] + 1);
+    if (!Rf_isVector(data[measure_ind[i]]) || Rf_inherits(data[measure_ind[i]], "data.frame")) {
+      Rf_errorcall(
+        R_NilValue,
+        "All columns must be atomic vectors or lists. Problem with column %i.",
+        measure_ind[i] + 1
+      );
     }
   }
 

diff --git a/tests/testthat/test-gather.R b/tests/testthat/test-gather.R
@@ -127,15 +127,18 @@ test_that("gather throws error for POSIXlt", {
 test_that("gather throws error for weird objects", {
   df <- data.frame(y = 1)
   df$x <- expression(x)
-  expect_error(gather(df, key, val, -x), "atomic vector or list")
-  expect_error(gather(df, key, val, -y), "atomic vector or list")
+  expect_error(gather(df, key, val, -x), "atomic vectors or lists")
+  expect_error(gather(df, key, val, -y), "atomic vectors or lists")
 
   e <- new.env(parent = emptyenv())
   e$x <- 1
   df <- data.frame(y = 1)
   df$x <- e
-  expect_error(gather(df, key, val, -x), "atomic vector or list")
-  expect_error(gather(df, key, val, -y), "atomic vector or list")
+  expect_error(gather(df, key, val, -x), "atomic vectors or list")
+  expect_error(gather(df, key, val, -y), "atomic vectors or list")
+
+  df <- tibble(tibble(x = 1))
+  expect_error(gather(df), "atomic vectors or lists")
 })