Remove private environment accessors (#1721)

Author: lionel-

NEWS.md

@@ -3,10 +3,14 @@
 * `env_browse()` and `env_is_browsed()` are now defunct as they require an API
   that is no longer available to packages (#1727).
 
+* The SEXP iterator of the rlang C library (used in r-lib/memtools) is now
+  behind a feature flag because it requires private API accessors. Compile
+  rlang with `-DRLANG_USE_PRIVATE_ACCESSORS` to enable it.
+
 * `env_unlock()` is now defunct because recent versions of R no long
   make it possible to unlock an environment (#1705). Make sure to use an
   up-to-date version of pkgload (>= 1.4.0) following this change.
-  
+
 * `is_dictionaryish()` now will return TRUE for NULL (@ilovemane, #1712).
 
 

R/c-lib.R

@@ -145,6 +145,10 @@ detect_rlang_lib_usage <- function(src_path) {
   FALSE
 }
 
+has_private_accessors <- function() {
+  .Call(ffi_has_private_accessors)
+}
+
 
 # cnd.c
 
@@ -401,5 +405,5 @@ vec_resize <- function(x, n) {
 # walk.c
 
 sexp_iterate <- function(x, fn) {
-  .Call(ffi_sexp_iterate, x, fn)
+  do.call(".Call", list(ffi_sexp_iterate, x, fn))
 }

R/obj.R

@@ -45,12 +45,6 @@ unmark_object <- function(x) {
 true_length <- function(x) {
   .Call(ffi_true_length, x)
 }
-env_frame <- function(x) {
-  .Call(ffi_env_frame, x)
-}
-env_hash_table <- function(x) {
-  .Call(ffi_env_hash_table, x)
-}
 
 promise_expr <- function(name, env = caller_env()) {
   .Call(ffi_promise_expr, name, env)

src/internal/exported.c

@@ -476,13 +476,6 @@ r_obj* ffi_env_poke_parent(r_obj* env, r_obj* new_parent) {
   return env;
 }
 
-r_obj* ffi_env_frame(r_obj* env) {
-  return FRAME(env);
-}
-r_obj* ffi_env_hash_table(r_obj* env) {
-  return HASHTAB(env);
-}
-
 r_obj* ffi_env_inherits(r_obj* env, r_obj* ancestor) {
   return r_lgl(r_env_inherits(env, ancestor, r_envs.empty));
 }
@@ -1031,6 +1024,16 @@ r_obj* protect_missing(r_obj* x) {
   }
 }
 
+r_obj* ffi_has_private_accessors(void) {
+#ifdef RLANG_USE_PRIVATE_ACCESSORS
+  return r_true;
+#else
+  return r_false;
+#endif
+}
+
+#ifdef RLANG_USE_PRIVATE_ACCESSORS
+
 // [[ register() ]]
 r_obj* ffi_sexp_iterate(r_obj* x, r_obj* fn) {
   struct r_dyn_array* p_out = r_new_dyn_vector(R_TYPE_list, 256);
@@ -1089,3 +1092,5 @@ r_obj* ffi_sexp_iterate(r_obj* x, r_obj* fn) {
   FREE(3);
   return r_dyn_unwrap(p_out);
 }
+
+#endif

src/internal/internal.c

@@ -167,11 +167,9 @@ static const R_CallMethodDef r_callables[] = {
   {"ffi_env_binding_types",            (DL_FUNC) &r_env_binding_types, 2},
   {"ffi_env_clone",                    (DL_FUNC) &r_env_clone, 2},
   {"ffi_env_coalesce",                 (DL_FUNC) &ffi_env_coalesce, 2},
-  {"ffi_env_frame",                    (DL_FUNC) &ffi_env_frame, 1},
   {"ffi_env_get",                      (DL_FUNC) &ffi_env_get, 5},
   {"ffi_env_get_list",                 (DL_FUNC) &ffi_env_get_list, 5},
   {"ffi_env_has",                      (DL_FUNC) &ffi_env_has, 3},
-  {"ffi_env_hash_table",               (DL_FUNC) &ffi_env_hash_table, 1},
   {"ffi_env_inherits",                 (DL_FUNC) &ffi_env_inherits, 2},
   {"ffi_env_poke",                     (DL_FUNC) &ffi_env_poke, 5},
   {"ffi_env_poke_parent",              (DL_FUNC) &ffi_env_poke_parent, 2},
@@ -189,6 +187,7 @@ static const R_CallMethodDef r_callables[] = {
   {"ffi_glue_is_here",                 (DL_FUNC) &ffi_glue_is_here, 0},
   {"ffi_has_dots_unnamed",             (DL_FUNC) &ffi_has_dots_unnamed, 1},
   {"ffi_has_local_precious_list",      (DL_FUNC) &ffi_has_local_precious_list, 0},
+  {"ffi_has_private_accessors",        (DL_FUNC) &ffi_has_private_accessors, 0},
   {"ffi_has_size_one_bool",            (DL_FUNC) &ffi_has_size_one_bool, 0},
   {"ffi_hash",                         (DL_FUNC) &ffi_hash, 1},
   {"ffi_hash_file",                    (DL_FUNC) &ffi_hash_file, 1},
@@ -289,7 +288,9 @@ static const R_CallMethodDef r_callables[] = {
   {"ffi_replace_na",                   (DL_FUNC) &ffi_replace_na, 2},
   {"ffi_run_c_test",                   (DL_FUNC) &ffi_run_c_test, 1},
   {"ffi_set_names",                    (DL_FUNC) &ffi_set_names, 4},
+#ifdef RLANG_USE_PRIVATE_ACCESSORS
   {"ffi_sexp_iterate",                 (DL_FUNC) &ffi_sexp_iterate, 2},
+#endif
   {"ffi_squash",                       (DL_FUNC) &ffi_squash, 4},
   {"ffi_standalone_check_number_1.0.7", (DL_FUNC) &ffi_standalone_check_number, 7},
   {"ffi_standalone_is_bool_1.0.7",     (DL_FUNC) &ffi_standalone_is_bool, 3},

src/rlang/rlang.c

@@ -29,8 +29,10 @@
 #include "vec-chr.c"
 #include "vec-lgl.c"
 #include "vendor.c"
-#include "walk.c"
 
+#ifdef RLANG_USE_PRIVATE_ACCESSORS
+  #include "walk.c"
+#endif
 
 // Allows long vectors to be indexed with doubles
 r_ssize r_arg_as_ssize(r_obj* n, const char* arg) {

tests/testthat/test-c-api.R

@@ -1194,6 +1194,8 @@ test_that("can push to arrays in dynamic list-of", {
 })
 
 test_that("sexp iterator visits in full order", {
+  skip_if_not(has_private_accessors())
+
   it_dirs <- function(snapshot) {
     dirs <- sapply(snapshot, `[[`, "dir")
     dirs <- table(dirs)

tests/testthat/test-env.R

@@ -405,29 +405,6 @@ test_that("env_length() gives env length", {
   expect_identical(env_length(env(a = "a")), 1L)
 })
 
-test_that("env_clone() duplicates frame", {
-  skip_silently("Would fail on non-GNU R")
-
-  e <- new.env(hash = FALSE)
-  e$x <- 1
-  c <- env_clone(e)
-  expect_false(is_reference(env_frame(e), env_frame(c)))
-})
-
-test_that("env_clone() duplicates hash table", {
-  skip_silently("Would fail on non-GNU R")
-
-  e <- env(x = 1)
-  c <- env_clone(e)
-
-  e_hash <- env_hash_table(e)
-  c_hash <- env_hash_table(c)
-  expect_false(is_reference(e_hash, c_hash))
-
-  i <- detect_index(e_hash, is_null, .p = is_false)
-  expect_false(is_reference(e_hash[[i]], c_hash[[i]]))
-})
-
 test_that("env_clone() increases refcounts (#621)", {
   e <- env(x = 1:2)
   env_bind_lazy(e, foo = 1)