From 2713fb2ffff4b99ca33a48993134c7f2b7f018a2 Mon Sep 17 00:00:00 2001 From: Lionel Henry Date: Thu, 27 Jun 2024 11:49:23 +0200 Subject: [PATCH] Remove private environment accessors --- NEWS.md | 4 ++++ R/c-lib.R | 6 +++++- R/obj.R | 6 ------ src/internal/exported.c | 19 ++++++++++++------- src/internal/init.c | 5 +++-- src/rlang/rlang.c | 4 +++- tests/testthat/test-c-api.R | 2 ++ tests/testthat/test-env.R | 23 ----------------------- 8 files changed, 29 insertions(+), 40 deletions(-) diff --git a/NEWS.md b/NEWS.md index d88a55d41..70d347798 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,9 @@ # rlang (development version) +* 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. Make sure to use an up-to-date version of pkgload (>= 1.4.0) following this change. diff --git a/R/c-lib.R b/R/c-lib.R index 265053a6b..042d4d382 100644 --- a/R/c-lib.R +++ b/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)) } diff --git a/R/obj.R b/R/obj.R index 93b1dd109..e0ef952a6 100644 --- a/R/obj.R +++ b/R/obj.R @@ -50,12 +50,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) diff --git a/src/internal/exported.c b/src/internal/exported.c index 889977b3f..6f96972eb 100644 --- a/src/internal/exported.c +++ b/src/internal/exported.c @@ -475,13 +475,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)); } @@ -1067,6 +1060,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); @@ -1125,3 +1128,5 @@ r_obj* ffi_sexp_iterate(r_obj* x, r_obj* fn) { FREE(3); return r_dyn_unwrap(p_out); } + +#endif diff --git a/src/internal/init.c b/src/internal/init.c index 01f71bf87..2955eab47 100644 --- a/src/internal/init.c +++ b/src/internal/init.c @@ -77,11 +77,9 @@ static const R_CallMethodDef r_callables[] = { {"ffi_env_browse", (DL_FUNC) &ffi_env_browse, 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_is_browsed", (DL_FUNC) &ffi_env_is_browsed, 1}, {"ffi_env_poke", (DL_FUNC) &ffi_env_poke, 5}, @@ -100,6 +98,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}, @@ -201,7 +200,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}, diff --git a/src/rlang/rlang.c b/src/rlang/rlang.c index 935cd9ef3..70b444b33 100644 --- a/src/rlang/rlang.c +++ b/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) { diff --git a/tests/testthat/test-c-api.R b/tests/testthat/test-c-api.R index d9863a527..006062591 100644 --- a/tests/testthat/test-c-api.R +++ b/tests/testthat/test-c-api.R @@ -1164,6 +1164,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) diff --git a/tests/testthat/test-env.R b/tests/testthat/test-env.R index f1e38a24d..217b23b27 100644 --- a/tests/testthat/test-env.R +++ b/tests/testthat/test-env.R @@ -390,29 +390,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)