melt.data.frame throws when encountering POSIXlt

hadley · Aug 25, 2015 · 02f9884 · 02f9884
1 parent d5ea93d
commit 02f9884
Show file tree

Hide file tree

Showing 4 changed files with 46 additions and 27 deletions.
diff --git a/NEWS.md b/NEWS.md
@@ -1,5 +1,8 @@
 # Version 1.4.1.9000
 
+* `melt.data.frame()` throws when encountering objects of type `POSIXlt`,
+  and requests a conversion to the (much saner) `POSIXct` type.
+
 # Version 1.4.1
 
 * `melt.data.frame()` now properly sets the OBJECT bit on `value` variable 

diff --git a/src/RcppExports.cpp b/src/RcppExports.cpp
@@ -9,21 +9,17 @@ using namespace Rcpp;
 List melt_dataframe(const DataFrame& data, const IntegerVector& id_ind, const IntegerVector& measure_ind, String variable_name, String value_name, SEXP measure_attributes, bool factorsAsStrings, bool valueAsFactor);
 RcppExport SEXP reshape2_melt_dataframe(SEXP dataSEXP, SEXP id_indSEXP, SEXP measure_indSEXP, SEXP variable_nameSEXP, SEXP value_nameSEXP, SEXP measure_attributesSEXP, SEXP factorsAsStringsSEXP, SEXP valueAsFactorSEXP) {
 BEGIN_RCPP
-    SEXP __sexp_result;
-    {
-        Rcpp::RNGScope __rngScope;
-        Rcpp::traits::input_parameter< const DataFrame& >::type data(dataSEXP );
-        Rcpp::traits::input_parameter< const IntegerVector& >::type id_ind(id_indSEXP );
-        Rcpp::traits::input_parameter< const IntegerVector& >::type measure_ind(measure_indSEXP );
-        Rcpp::traits::input_parameter< String >::type variable_name(variable_nameSEXP );
-        Rcpp::traits::input_parameter< String >::type value_name(value_nameSEXP );
-        Rcpp::traits::input_parameter< SEXP >::type measure_attributes(measure_attributesSEXP );
-        Rcpp::traits::input_parameter< bool >::type factorsAsStrings(factorsAsStringsSEXP );
-        Rcpp::traits::input_parameter< bool >::type valueAsFactor(valueAsFactorSEXP );
-        List __result = melt_dataframe(data, id_ind, measure_ind, variable_name, value_name, measure_attributes, factorsAsStrings, valueAsFactor);
-        PROTECT(__sexp_result = Rcpp::wrap(__result));
-    }
-    UNPROTECT(1);
-    return __sexp_result;
+    Rcpp::RObject __result;
+    Rcpp::RNGScope __rngScope;
+    Rcpp::traits::input_parameter< const DataFrame& >::type data(dataSEXP);
+    Rcpp::traits::input_parameter< const IntegerVector& >::type id_ind(id_indSEXP);
+    Rcpp::traits::input_parameter< const IntegerVector& >::type measure_ind(measure_indSEXP);
+    Rcpp::traits::input_parameter< String >::type variable_name(variable_nameSEXP);
+    Rcpp::traits::input_parameter< String >::type value_name(value_nameSEXP);
+    Rcpp::traits::input_parameter< SEXP >::type measure_attributes(measure_attributesSEXP);
+    Rcpp::traits::input_parameter< bool >::type factorsAsStrings(factorsAsStringsSEXP);
+    Rcpp::traits::input_parameter< bool >::type valueAsFactor(valueAsFactorSEXP);
+    __result = Rcpp::wrap(melt_dataframe(data, id_ind, measure_ind, variable_name, value_name, measure_attributes, factorsAsStrings, valueAsFactor));
+    return __result;
 END_RCPP
 }
diff --git a/src/melt.cpp b/src/melt.cpp
@@ -237,22 +237,30 @@ List melt_dataframe(const DataFrame& data,
   // we repeat each ID vector n_measure times
 
   // A define to handle the different possible types
-  #define REP(RTYPE)                                 \
+  #define REP(OBJECT, RTYPE)                         \
     case RTYPE: {                                    \
-      output[i] = rep_(data[id_ind[i]], n_measure);  \
-      Rf_copyMostAttrib(data[id_ind[i]], output[i]); \
+      output[i] = rep_(OBJECT, n_measure);           \
+      Rf_copyMostAttrib(OBJECT, output[i]);          \
       break;                                         \
     }
 
   for (int i = 0; i < n_id; ++i) {
-    switch (TYPEOF(data[id_ind[i]])) {
-      REP(LGLSXP);
-      REP(INTSXP);
-      REP(REALSXP);
-      REP(STRSXP);
-      REP(CPLXSXP);
-      REP(RAWSXP);
-      REP(VECSXP);
+
+    SEXP object = data[id_ind[i]];
+
+    if (Rf_inherits(object, "POSIXlt")) {
+      std::string var = std::string(data_names[id_ind[i]]);
+      Rcpp::stop("'%s' is a POSIXlt. Please convert to POSIXct.", var);
+    }
+
+    switch (TYPEOF(object)) {
+      REP(object, LGLSXP);
+      REP(object, INTSXP);
+      REP(object, REALSXP);
+      REP(object, STRSXP);
+      REP(object, CPLXSXP);
+      REP(object, RAWSXP);
+      REP(object, VECSXP);
       default: { stop("internal error: unnhandled vector type in REP"); }
     }
   }

diff --git a/tests/testthat/test-melt.r b/tests/testthat/test-melt.r
@@ -214,3 +214,15 @@ test_that("melt.data.frame allows for lists in the set of id variables", {
   result <- melt(df, id=1:2)
   expect_identical(result$y[1:5], df$y)
 })
+
+test_that("melt.data.frame throws when encountering POSIXlt", {
+
+  df <- data.frame(
+    x = 1:5,
+    y = 6:10
+  )
+
+  df$z <- as.POSIXlt(Sys.time())
+  expect_error(melt(df, measure.vars = c("x", "y")))
+
+})