Fix slice() error with gctorture() (tidyverse#2794)

* fix slice() error with gctorture() * add test * return DataFrame instead of SEXP or RObject to avoid destruction when calling `~GroupedHybridEnv()` via `~GroupedCallProxy()` aka `~CallProxy()`
daonv · May 17, 2017 · aece1a5 · aece1a5
1 parent 496d777
commit aece1a5
Show file tree

Hide file tree

Showing 6 changed files with 27 additions and 23 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -26,23 +26,24 @@ Imports:
     tibble (>= 1.3.0.9008),
     utils
 Suggests: 
+    bit64,
     covr,
     dbplyr,
+    dtplyr,
     DBI,
-    RMySQL,
-    RPostgreSQL,
-    RSQLite,
-    testthat,
-    knitr,
-    microbenchmark,
     ggplot2,
-    mgcv,
+    hms,
+    knitr,
     Lahman (>= 3.0-1),
+    mgcv,
+    microbenchmark,
     nycflights13,
     rmarkdown,
-    dtplyr,
-    bit64,
-    hms
+    RMySQL,
+    RPostgreSQL,
+    RSQLite,
+    testthat,
+    withr
 VignetteBuilder: knitr
 LinkingTo: Rcpp (>= 0.12.0),
     BH (>= 1.58.0-1),

diff --git a/src/mutate.cpp b/src/mutate.cpp
@@ -61,7 +61,7 @@ SEXP validate_unquoted_value(SEXP value, int nrows, SymbolString& name) {
   return value;
 }
 
-SEXP mutate_not_grouped(DataFrame df, const QuosureList& dots) {
+DataFrame mutate_not_grouped(DataFrame df, const QuosureList& dots) {
   const int nexpr = dots.size();
   const int nrows = df.nrows();
 
@@ -130,7 +130,7 @@ SEXP mutate_not_grouped(DataFrame df, const QuosureList& dots) {
 }
 
 template <typename Data, typename Subsets>
-SEXP mutate_grouped(const DataFrame& df, const QuosureList& dots) {
+DataFrame mutate_grouped(const DataFrame& df, const QuosureList& dots) {
   LOG_VERBOSE << "checking zero rows";
 
   // special 0 rows case

diff --git a/src/slice.cpp b/src/slice.cpp
@@ -54,7 +54,7 @@ class CountIndices {
   int n_neg;
 };
 
-SEXP slice_grouped(GroupedDataFrame gdf, const QuosureList& dots) {
+DataFrame slice_grouped(GroupedDataFrame gdf, const QuosureList& dots) {
   typedef GroupedCallProxy<GroupedDataFrame, LazyGroupedSubsets> Proxy;
 
   const DataFrame& data = gdf.data();
@@ -112,18 +112,17 @@ SEXP slice_grouped(GroupedDataFrame gdf, const QuosureList& dots) {
         indx.push_back(indices[j++]);
         k++;
       }
-
     }
   }
+
   DataFrame res = subset(data, indx, names, classes_grouped<GroupedDataFrame>());
   set_vars(res, get_vars(data));
   strip_index(res);
 
   return GroupedDataFrame(res).data();
-
 }
 
-SEXP slice_not_grouped(const DataFrame& df, const QuosureList& dots) {
+DataFrame slice_not_grouped(const DataFrame& df, const QuosureList& dots) {
   CharacterVector names = df.names();
 
   const NamedQuosure& quosure = dots[0];
@@ -154,8 +153,7 @@ SEXP slice_not_grouped(const DataFrame& df, const QuosureList& dots) {
   // special case where only NA
   if (counter.get_n_negative() == 0) {
     std::vector<int> indices;
-    DataFrame res = subset(df, indices, df.names(), classes_not_grouped());
-    return res;
+    return subset(df, indices, df.names(), classes_not_grouped());
   }
 
   // just negatives (out of range is dealt with early in CountIndices).
@@ -181,9 +179,7 @@ SEXP slice_not_grouped(const DataFrame& df, const QuosureList& dots) {
     indices[i++] = j++;
   }
 
-  DataFrame res = subset(df, indices, df.names(), classes_not_grouped());
-  return res;
-
+  return subset(df, indices, df.names(), classes_not_grouped());
 }
 
 // [[Rcpp::export]]

diff --git a/src/summarise.cpp b/src/summarise.cpp
@@ -33,7 +33,7 @@ SEXP validate_unquoted_value(SEXP value, int nrows, const SymbolString& name) {
 }
 
 template <typename Data, typename Subsets>
-SEXP summarise_grouped(const DataFrame& df, const QuosureList& dots) {
+DataFrame summarise_grouped(const DataFrame& df, const QuosureList& dots) {
   Data gdf(df);
 
   int nexpr = dots.size();
@@ -113,7 +113,7 @@ SEXP summarise_grouped(const DataFrame& df, const QuosureList& dots) {
 }
 
 
-SEXP summarise_not_grouped(DataFrame df, const QuosureList& dots) {
+DataFrame summarise_not_grouped(DataFrame df, const QuosureList& dots) {
   int nexpr = dots.size();
   if (nexpr == 0) return DataFrame();
 

diff --git a/tests/testthat/helper-torture.R b/tests/testthat/helper-torture.R
@@ -0,0 +1 @@
+with_gctorture2 <- withr::with_(gctorture2)
diff --git a/tests/testthat/test-slice.r b/tests/testthat/test-slice.r
@@ -107,3 +107,9 @@ test_that("slice works with zero-column data frames (#2490)", {
     1L
   )
 })
+
+test_that("slice works under gctorture2", {
+  x <- tibble(y = 1:10)
+  with_gctorture2(999, x2 <- slice(x, 1:10))
+  expect_identical(x, x2)
+})