PROTECT() result of Rf_getAttrib() and Rf_findVarInFrame() (rchk) (ti…

…dyverse#5616)
mkoohafkan · Nov 19, 2020 · 9cf468c · 9cf468c
1 parent 5b29134
commit 9cf468c
Show file tree

Hide file tree

Showing 4 changed files with 44 additions and 20 deletions.
diff --git a/src/chop.cpp b/src/chop.cpp
@@ -122,8 +122,9 @@ SEXP env_resolved(SEXP env, SEXP names) {
   const SEXP* p_names = STRING_PTR_RO(names);
 
   for(R_xlen_t i = 0; i < n; i++) {
-    SEXP prom = Rf_findVarInFrame(env, dplyr::as_symbol(p_names[i]));
+    SEXP prom = PROTECT(Rf_findVarInFrame(env, dplyr::as_symbol(p_names[i])));
     p_res[i] = PRVALUE(prom) != R_UnboundValue;
+    UNPROTECT(1);
   }
 
   Rf_namesgets(res, names);

diff --git a/src/group_by.cpp b/src/group_by.cpp
@@ -122,8 +122,9 @@ class FactorExpander : public Expander {
   end(end_)
   {
     SEXP fac = data[depth_];
-    SEXP levels = Rf_getAttrib(fac, dplyr::symbols::levels);
+    SEXP levels = PROTECT(Rf_getAttrib(fac, dplyr::symbols::levels));
     R_xlen_t n_levels = XLENGTH(levels);
+    UNPROTECT(1);
 
     expanders.resize(n_levels);
 
@@ -271,20 +272,26 @@ SEXP dplyr_validate_grouped_df(SEXP df, SEXP s_check_bounds) {
     return Rf_mkString("not a `grouped_df` object.");
   }
 
-  SEXP groups = Rf_getAttrib(df, dplyr::symbols::groups);
+  SEXP groups = PROTECT(Rf_getAttrib(df, dplyr::symbols::groups));
 
   if (!Rf_inherits(groups, "data.frame") || XLENGTH(groups) < 1) {
-    return Rf_mkString("The `groups` attribute is not a data frame with its last column called `.rows`.");
+    SEXP out = Rf_mkString("The `groups` attribute is not a data frame with its last column called `.rows`.");
+    UNPROTECT(1);
+    return out;
   }
 
-  SEXP groups_names = Rf_getAttrib(groups, R_NamesSymbol);
+  SEXP groups_names = PROTECT(Rf_getAttrib(groups, R_NamesSymbol));
   if (Rf_isNull(groups_names) || TYPEOF(groups_names) != STRSXP || ::strcmp(CHAR(STRING_ELT(groups_names, XLENGTH(groups_names) - 1)), ".rows")) {
-    return Rf_mkString("The `groups` attribute is not a data frame with its last column called `.rows`.");
+    SEXP out = Rf_mkString("The `groups` attribute is not a data frame with its last column called `.rows`.");
+    UNPROTECT(2);
+    return out;
   }
 
   SEXP dot_rows = VECTOR_ELT(groups, XLENGTH(groups) - 1);
   if (TYPEOF(dot_rows) != VECSXP) {
-    return Rf_mkString("The `groups` attribute is not a data frame with its last column called `.rows`.");
+    SEXP out = Rf_mkString("The `groups` attribute is not a data frame with its last column called `.rows`.");
+    UNPROTECT(2);
+    return out;
   }
   const SEXP* p_dot_rows = VECTOR_PTR_RO(dot_rows);
 
@@ -293,7 +300,9 @@ SEXP dplyr_validate_grouped_df(SEXP df, SEXP s_check_bounds) {
     for (R_xlen_t i = 0; i < nr; i++) {
       SEXP rows_i = p_dot_rows[i];
       if (TYPEOF(rows_i) != INTSXP) {
-        return Rf_mkString("`.rows` column is not a list of one-based integer vectors.");
+        SEXP out = Rf_mkString("`.rows` column is not a list of one-based integer vectors.");
+        UNPROTECT(2);
+        return out;
       }
     }
 
@@ -304,12 +313,15 @@ SEXP dplyr_validate_grouped_df(SEXP df, SEXP s_check_bounds) {
       int* p_rows_i = INTEGER(rows_i);
       for (R_xlen_t j = 0; j < n_i; j++, ++p_rows_i) {
         if (*p_rows_i < 1 || *p_rows_i > nr_df) {
-          return Rf_mkString("out of bounds indices.");
+          SEXP out = Rf_mkString("out of bounds indices.");
+          UNPROTECT(2);
+          return out;
         }
       }
     }
 
   }
 
+  UNPROTECT(2);
   return R_NilValue;
 }
diff --git a/src/init.cpp b/src/init.cpp
@@ -73,10 +73,17 @@ SEXP dplyr_init_library(SEXP ns_dplyr, SEXP ns_vctrs, SEXP ns_rlang) {
   dplyr::envs::ns_dplyr = ns_dplyr;
   dplyr::envs::ns_vctrs = ns_vctrs;
   dplyr::envs::ns_rlang = ns_rlang;
-  dplyr::functions::vec_chop = Rf_findVarInFrame(ns_vctrs, Rf_install("vec_chop"));
-  dplyr::functions::dot_subset2 = Rf_findVarInFrame(R_BaseEnv, Rf_install(".subset2"));
-  dplyr::functions::list = Rf_findVarInFrame(R_BaseEnv, Rf_install("list"));
-  dplyr::functions::function = Rf_eval(Rf_install("function"), R_BaseEnv);
+  dplyr::functions::vec_chop = PROTECT(Rf_findVarInFrame(ns_vctrs, Rf_install("vec_chop")));
+  dplyr::functions::dot_subset2 = PROTECT(Rf_findVarInFrame(R_BaseEnv, Rf_install(".subset2")));
+  dplyr::functions::list = PROTECT(Rf_findVarInFrame(R_BaseEnv, Rf_install("list")));
+  dplyr::functions::function = PROTECT(Rf_eval(Rf_install("function"), R_BaseEnv));
+
+  R_PreserveObject(dplyr::functions::vec_chop);
+  R_PreserveObject(dplyr::functions::dot_subset2);
+  R_PreserveObject(dplyr::functions::list);
+  R_PreserveObject(dplyr::functions::function);
+
+  UNPROTECT(4);
 
   return R_NilValue;
 }

diff --git a/src/mask.cpp b/src/mask.cpp
@@ -35,7 +35,7 @@ SEXP dplyr_mask_add(SEXP env_private, SEXP s_name, SEXP chunks) {
   SEXP name = STRING_ELT(s_name, 0);
 
   // we assume control over these
-  SEXP all_vars = Rf_findVarInFrame(env_private, dplyr::symbols::all_vars);
+  SEXP all_vars = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::all_vars));
 
   // search for position of name
   R_xlen_t n = XLENGTH(all_vars);
@@ -56,12 +56,13 @@ SEXP dplyr_mask_add(SEXP env_private, SEXP s_name, SEXP chunks) {
   }
 
   SEXP sym_name = dplyr::as_symbol(name);
-  SEXP chops = Rf_findVarInFrame(env_private, dplyr::symbols::chops);
+  SEXP chops = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::chops));
   Rf_defineVar(sym_name, chunks, chops);
 
-  SEXP mask = Rf_findVarInFrame(env_private, dplyr::symbols::mask);
+  SEXP mask = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::mask));
   add_mask_binding(sym_name, ENCLOS(mask), chops);
 
+  UNPROTECT(3);
   return R_NilValue;
 }
 
@@ -84,7 +85,7 @@ void rm(SEXP name, SEXP env) {
 SEXP dplyr_mask_remove(SEXP env_private, SEXP s_name) {
   SEXP name = STRING_ELT(s_name, 0);
 
-  SEXP all_vars = Rf_findVarInFrame(env_private, dplyr::symbols::all_vars);
+  SEXP all_vars = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::all_vars));
 
   // search for position of name
   R_xlen_t n = XLENGTH(all_vars);
@@ -99,13 +100,16 @@ SEXP dplyr_mask_remove(SEXP env_private, SEXP s_name) {
     }
     Rf_defineVar(dplyr::symbols::all_vars, new_all_vars, env_private);
 
-    SEXP chops = Rf_findVarInFrame(env_private, dplyr::symbols::chops);
+    SEXP chops = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::chops));
     SEXP sym_name = dplyr::as_symbol(name);
     rm(sym_name, chops);
-    rm(sym_name, ENCLOS(Rf_findVarInFrame(env_private, dplyr::symbols::mask)));
 
-    UNPROTECT(1);
+    SEXP mask = PROTECT(Rf_findVarInFrame(env_private, dplyr::symbols::mask));
+    rm(sym_name, ENCLOS(mask));
+
+    UNPROTECT(3);
   }
 
+  UNPROTECT(1);
   return R_NilValue;
 }