bring back warnings on coercion with intersect, etc ...

mikeaddison93 · Nov 1, 2015 · e69f99c · e69f99c
1 parent 838d766
commit e69f99c
Show file tree

Hide file tree

Showing 4 changed files with 14 additions and 8 deletions.
diff --git a/inst/include/dplyr/DataFrameSubsetVisitors.h b/inst/include/dplyr/DataFrameSubsetVisitors.h
@@ -22,7 +22,8 @@ namespace dplyr {
             {
 
                 for( int i=0; i<nvisitors; i++){
-                    visitors.push_back( subset_visitor( data[i] ) ) ;
+                    SubsetVectorVisitor* v = subset_visitor( data[i] ) ;
+                    visitors.push_back(v) ;
                 }
             }
 
@@ -44,8 +45,8 @@ namespace dplyr {
                     } catch( ... ){
                         stop( "unknown column '%s' ", name ) ;
                     }
-
-                    visitors.push_back( subset_visitor( column ) ) ;
+                    SubsetVectorVisitor* v = subset_visitor( column ) ;
+                    visitors.push_back(v) ;
 
                 }
 

diff --git a/src/dplyr.cpp b/src/dplyr.cpp
@@ -1074,6 +1074,7 @@ SEXP promote(SEXP x){
     if( TYPEOF(x) == INTSXP ){
         IntegerVector data(x) ;
         if( Rf_inherits( x, "factor" ) ){
+            Rf_warning( "coercing factor to character vector" ) ; 
             CharacterVector levels = data.attr( "levels" ) ;
             int n = data.size() ;
             CharacterVector out( data.size() ) ;
@@ -1202,6 +1203,9 @@ dplyr::BoolResult compatible_data_frame( DataFrame& x, DataFrame& y, bool ignore
                << visitor_y->get_r_type() ;
             ok = false ;
         }
+        if(convert && typeid(*visitor_x) != typeid(*visitor_y) ){
+          Rf_warning("type coercion") ;
+        }
     }
     if(!ok) return no_because( ss.str() ) ;
     return yes() ;
@@ -1322,7 +1326,7 @@ dplyr::BoolResult all_equal_data_frame( List args, Environment env ){
 
 // [[Rcpp::export]]
 DataFrame union_data_frame( DataFrame x, DataFrame y){
-    BoolResult compat = compatible_data_frame(x,y) ;
+    BoolResult compat = compatible_data_frame(x,y,true,true) ;
     if( !compat ){
         stop( "not compatible: %s", compat.why_not() );
     }
@@ -1339,12 +1343,13 @@ DataFrame union_data_frame( DataFrame x, DataFrame y){
 
 // [[Rcpp::export]]
 DataFrame intersect_data_frame( DataFrame x, DataFrame y){
-    BoolResult compat = compatible_data_frame(x,y) ;
+    BoolResult compat = compatible_data_frame(x,y,true,true) ;
     if( !compat ){
         stop( "not compatible: %s", compat.why_not() );
     }
 
     typedef VisitorSetIndexSet<DataFrameJoinVisitors> Set ;
+
     DataFrameJoinVisitors visitors(x, y, x.names(), x.names(), true ) ;
     Set set(visitors);
 
@@ -1365,7 +1370,7 @@ DataFrame intersect_data_frame( DataFrame x, DataFrame y){
 
 // [[Rcpp::export]]
 DataFrame setdiff_data_frame( DataFrame x, DataFrame y){
-    BoolResult compat = compatible_data_frame(x,y) ;
+    BoolResult compat = compatible_data_frame(x,y,true,true) ;
     if( !compat ){
         stop( "not compatible: %s", compat.why_not() );
     }
@@ -1391,7 +1396,7 @@ DataFrame setdiff_data_frame( DataFrame x, DataFrame y){
 
 // [[Rcpp::export]]
 IntegerVector match_data_frame( DataFrame x, DataFrame y){
-    if( !compatible_data_frame(x,y) )
+    if( !compatible_data_frame(x,y,true,true) )
         stop( "not compatible" );
 
     typedef VisitorSetIndexSet<DataFrameJoinVisitors> Set ;

diff --git a/src/join.cpp b/src/join.cpp
@@ -228,7 +228,6 @@ namespace dplyr{
     }
 
     JoinVisitor* join_visitor( SEXP left, SEXP right, const std::string& name_left, const std::string& name_right, bool warn_ ){
-
         // handle Date separately
         bool lhs_date = Rf_inherits( left, "Date") ;
         bool rhs_date = Rf_inherits( right, "Date") ;

diff --git a/tests/testthat/test-sets.R b/tests/testthat/test-sets.R
@@ -45,6 +45,7 @@ test_that("set operations use coercion rules (#799)", {
   expect_warning( { res <- intersect(df2, df1) })
   expect_equal( res, data_frame(x = letters[6:10]) )
 
+
   expect_warning( { res <- union(df1, df2) })
   expect_equal( res, data_frame(x = letters[1:15]) )
   expect_warning( { res <- union(df2, df1) })