only allow global(<symbol>)

tidyverse · Oct 28, 2015 · 4367328 · 4367328
1 parent b1ce96e
commit 4367328
Show file tree

Hide file tree

Showing 3 changed files with 15 additions and 2 deletions.
diff --git a/inst/include/dplyr/Result/GroupedCallProxy.h b/inst/include/dplyr/Result/GroupedCallProxy.h
@@ -97,6 +97,7 @@ namespace dplyr {
 
             if( TYPEOF(obj) == LANGSXP && CAR(obj) == Rf_install("global") ){
               SEXP symb = CADR(obj) ;
+              if( TYPEOF(symb) != SYMSXP ) stop( "global only handles symbols" ) ;
               SEXP res = env.find(CHAR(PRINTNAME(symb))) ;
               call = res ;
               return ;
@@ -107,8 +108,10 @@ namespace dplyr {
 
                 switch( TYPEOF( head ) ){
                 case LANGSXP:
-                    if( CAR(head) == Rf_install("global") && TYPEOF(CADR(head)) == SYMSXP ){
+                    if( CAR(head) == Rf_install("global") ){
                         SEXP symb = CADR(head) ;
+                        if( TYPEOF(symb) != SYMSXP ) stop( "global only handles symbols" ) ;
+
                         SEXP res  = env.find( CHAR(PRINTNAME(symb)) ) ;
 
                         SETCAR(obj, res) ;

diff --git a/src/api.cpp b/src/api.cpp
@@ -76,6 +76,7 @@ namespace dplyr{
 
         if( TYPEOF(obj) == LANGSXP && CAR(obj) == Rf_install("global") ){
           SEXP symb = CADR(obj) ;
+          if( TYPEOF(symb) != SYMSXP ) stop( "global only handles symbols" ) ;
           SEXP res = env.find(CHAR(PRINTNAME(symb))) ;
           call = res ;
           return ;
@@ -85,8 +86,9 @@ namespace dplyr{
             SEXP head = CAR(obj) ;
             switch( TYPEOF( head ) ){
             case LANGSXP:
-                if( CAR(head) == Rf_install("global") && TYPEOF(CADR(head)) == SYMSXP ){
+                if( CAR(head) == Rf_install("global") ){
                     SEXP symb = CADR(head) ;
+                    if( TYPEOF(symb) != SYMSXP ) stop( "global only handles symbols" ) ;
                     SEXP res  = env.find( CHAR(PRINTNAME(symb)) ) ;
 
                     SETCAR(obj, res) ;

diff --git a/tests/testthat/test-mutate.r b/tests/testthat/test-mutate.r
@@ -443,15 +443,23 @@ test_that("mutate recognizes global #1469", {
     vs <- 4
     res <- mtcars %>% mutate(a = global(vs))
     expect_true( all(res$a == 4) )
+    expect_error( mtcars %>% mutate(global("vs")), "global only handles symbols" )
     res <- mtcars %>% mutate(a = global(vs) + 1)
     expect_true( all(res$a == 5) )
+    expect_error( mtcars %>% mutate(global("vs") + 1), "global only handles symbols" )
     res <- mtcars %>% mutate(a = 1+global(vs) )
     expect_true( all(res$a == 5) )
+    expect_error( mtcars %>% mutate(1 + global("vs")), "global only handles symbols" )
 
     res <- mtcars %>% group_by(cyl) %>% mutate(a = global(vs))
     expect_true( all(res$a == 4) )
+    expect_error( mtcars %>% group_by(cyl) %>% mutate(a = global("vs")), "global only handles symbols" )
     res <- mtcars %>% group_by(cyl) %>% mutate(a = global(vs)+1)
     expect_true( all(res$a == 5) )
+    expect_error( mtcars %>% group_by(cyl) %>% mutate(a = global("vs") + 1), "global only handles symbols" )
+
     res <- mtcars %>% group_by(cyl) %>% mutate(a = 1+global(vs))
     expect_true( all(res$a == 5) )
+    expect_error( mtcars %>% group_by(cyl) %>% mutate(a = 1 + global("vs")), "global only handles symbols" )
+
 })