Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Add r_dyn_raw_push_back() and r_dyn_chr_push_back() #1699

Merged
merged 3 commits into from
Apr 5, 2024
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
7 changes: 5 additions & 2 deletions NEWS.md
Original file line number Diff line number Diff line change
@@ -1,5 +1,8 @@
# rlang (development version)

* Added missing C level `r_dyn_raw_push_back()` and `r_dyn_chr_push_back()`
utilities (#1699).

* `last_trace()` hyperlinks now use the modern `x-r-run` format (#1678).


Expand Down Expand Up @@ -1217,7 +1220,7 @@ extensive changes to the display of error messages.

* Infix operators now stick to their LHS when deparsed by
`expr_deparse()` (#890).


# rlang 0.4.2

Expand Down Expand Up @@ -2002,7 +2005,7 @@ error reporting, tidy eval, and tidy dots.
* `env_get()` now evaluates promises and active bindings since these are
internal objects which should not be exposed at the R level (#554)

* `env_print()` calls `get_env()` on its argument, making it easier to
* `env_print()` calls `get_env()` on its argument, making it easier to
see the environment of closures and quosures (#567).

* `env_get()` now supports retrieving missing arguments when `inherit`
Expand Down
22 changes: 22 additions & 0 deletions R/c-lib.R
Original file line number Diff line number Diff line change
Expand Up @@ -287,6 +287,28 @@ dyn_list_poke <- function(x, i, value) {
invisible(.Call(ffi_dyn_list_poke, x, i, value))
}

dyn_lgl_push_back <- function(x, value) {
invisible(.Call(ffi_dyn_lgl_push_back, x, value))
}
dyn_int_push_back <- function(x, value) {
invisible(.Call(ffi_dyn_int_push_back, x, value))
}
dyn_dbl_push_back <- function(x, value) {
invisible(.Call(ffi_dyn_dbl_push_back, x, value))
}
dyn_cpl_push_back <- function(x, value) {
invisible(.Call(ffi_dyn_cpl_push_back, x, value))
}
dyn_raw_push_back <- function(x, value) {
invisible(.Call(ffi_dyn_raw_push_back, x, value))
}
dyn_chr_push_back <- function(x, value) {
invisible(.Call(ffi_dyn_chr_push_back, x, value))
}
dyn_list_push_back <- function(x, value) {
invisible(.Call(ffi_dyn_list_push_back, x, value))
}

# https://github.com/r-lib/rlang/issues/1556
has_size_one_bool <- function() {
.Call(ffi_has_size_one_bool)
Expand Down
36 changes: 36 additions & 0 deletions src/internal/exported.c
Original file line number Diff line number Diff line change
Expand Up @@ -324,6 +324,42 @@ r_obj* ffi_dyn_list_poke(r_obj* x, r_obj* i, r_obj* value) {
return r_null;
}

// [[ register() ]]
r_obj* ffi_dyn_lgl_push_back(r_obj* x, r_obj* value) {
r_dyn_lgl_push_back(r_shelter_deref(x), r_as_bool(value));
return r_null;
}
// [[ register() ]]
r_obj* ffi_dyn_int_push_back(r_obj* x, r_obj* value) {
r_dyn_int_push_back(r_shelter_deref(x), r_as_int(value));
return r_null;
}
// [[ register() ]]
r_obj* ffi_dyn_dbl_push_back(r_obj* x, r_obj* value) {
r_dyn_dbl_push_back(r_shelter_deref(x), r_as_double(value));
return r_null;
}
// [[ register() ]]
r_obj* ffi_dyn_cpl_push_back(r_obj* x, r_obj* value) {
r_dyn_cpl_push_back(r_shelter_deref(x), r_as_complex(value));
return r_null;
}
// [[ register() ]]
r_obj* ffi_dyn_raw_push_back(r_obj* x, r_obj* value) {
r_dyn_raw_push_back(r_shelter_deref(x), r_as_char(value));
return r_null;
}
// [[ register() ]]
r_obj* ffi_dyn_chr_push_back(r_obj* x, r_obj* value) {
r_dyn_chr_push_back(r_shelter_deref(x), value);
return r_null;
}
// [[ register() ]]
r_obj* ffi_dyn_list_push_back(r_obj* x, r_obj* value) {
r_dyn_list_push_back(r_shelter_deref(x), value);
return r_null;
}

// [[ register() ]]
r_obj* ffi_has_size_one_bool(void) {
return r_lgl(sizeof(bool) == 1);
Expand Down
9 changes: 8 additions & 1 deletion src/internal/init.c
Original file line number Diff line number Diff line change
Expand Up @@ -40,22 +40,29 @@ static const R_CallMethodDef r_callables[] = {
{"ffi_duplicate", (DL_FUNC) &ffi_duplicate, 2},
{"ffi_dyn_chr_get", (DL_FUNC) &ffi_dyn_chr_get, 2},
{"ffi_dyn_chr_poke", (DL_FUNC) &ffi_dyn_chr_poke, 3},
{"ffi_dyn_chr_push_back", (DL_FUNC) &ffi_dyn_chr_push_back, 2},
{"ffi_dyn_cpl_get", (DL_FUNC) &ffi_dyn_cpl_get, 2},
{"ffi_dyn_cpl_poke", (DL_FUNC) &ffi_dyn_cpl_poke, 3},
{"ffi_dyn_cpl_push_back", (DL_FUNC) &ffi_dyn_cpl_push_back, 2},
{"ffi_dyn_dbl_get", (DL_FUNC) &ffi_dyn_dbl_get, 2},
{"ffi_dyn_dbl_poke", (DL_FUNC) &ffi_dyn_dbl_poke, 3},
{"ffi_dyn_dbl_push_back", (DL_FUNC) &ffi_dyn_dbl_push_back, 2},
{"ffi_dyn_info", (DL_FUNC) &ffi_dyn_info, 1},
{"ffi_dyn_int_get", (DL_FUNC) &ffi_dyn_int_get, 2},
{"ffi_dyn_int_poke", (DL_FUNC) &ffi_dyn_int_poke, 3},
{"ffi_dyn_int_push_back", (DL_FUNC) &ffi_dyn_int_push_back, 2},
{"ffi_dyn_lgl_get", (DL_FUNC) &ffi_dyn_lgl_get, 2},
{"ffi_dyn_lgl_poke", (DL_FUNC) &ffi_dyn_lgl_poke, 3},
{"ffi_dyn_lgl_push_back", (DL_FUNC) &ffi_dyn_lgl_push_back, 2},
{"ffi_dyn_list_get", (DL_FUNC) &ffi_dyn_list_get, 2},
{"ffi_dyn_list_poke", (DL_FUNC) &ffi_dyn_list_poke, 3},
{"ffi_dyn_list_poke", (DL_FUNC) &ffi_dyn_list_poke, 3},
{"ffi_dyn_list_push_back", (DL_FUNC) &ffi_dyn_list_push_back, 2},
{"ffi_dyn_pop_back", (DL_FUNC) &ffi_dyn_pop_back, 1},
{"ffi_dyn_push_back", (DL_FUNC) &ffi_dyn_push_back, 2},
{"ffi_dyn_push_back_bool", (DL_FUNC) &ffi_dyn_push_back_bool, 2},
{"ffi_dyn_raw_get", (DL_FUNC) &ffi_dyn_raw_get, 2},
{"ffi_dyn_raw_poke", (DL_FUNC) &ffi_dyn_raw_poke, 3},
{"ffi_dyn_raw_push_back", (DL_FUNC) &ffi_dyn_raw_push_back, 2},
{"ffi_dyn_resize", (DL_FUNC) &ffi_dyn_resize, 2},
{"ffi_dyn_unwrap", (DL_FUNC) &ffi_dyn_unwrap, 1},
{"ffi_ellipsis_dots", (DL_FUNC) &ffi_ellipsis_dots, 1},
Expand Down
12 changes: 12 additions & 0 deletions src/rlang/dyn-array.h
Original file line number Diff line number Diff line change
Expand Up @@ -174,6 +174,18 @@ void r_dyn_cpl_push_back(struct r_dyn_array* p_vec, r_complex elt) {
r_dyn_cpl_poke(p_vec, loc, elt);
}
static inline
void r_dyn_raw_push_back(struct r_dyn_array* p_vec, char elt) {
r_ssize loc = r__dyn_increment(p_vec);
r_dyn_raw_poke(p_vec, loc, elt);
}
static inline
void r_dyn_chr_push_back(struct r_dyn_array* p_vec, r_obj* elt) {
KEEP(elt);
r_ssize loc = r__dyn_increment(p_vec);
r_dyn_chr_poke(p_vec, loc, elt);
FREE(1);
}
static inline
void r_dyn_list_push_back(struct r_dyn_array* p_vec, r_obj* elt) {
KEEP(elt);
r_ssize loc = r__dyn_increment(p_vec);
Expand Down
44 changes: 32 additions & 12 deletions tests/testthat/test-c-api.R
Original file line number Diff line number Diff line change
Expand Up @@ -1003,43 +1003,63 @@ test_that("can shrink and grow dynamic barrier vectors", {
expect_equal(dyn_count(arr), 2)
})

test_that("can get and poke elements", {
test_that("can get, push, and poke elements", {
arr <- new_dyn_vector("logical", 3)
dyn_push_back(arr, TRUE)
dyn_lgl_push_back(arr, TRUE)
expect_equal(dyn_lgl_get(arr, 0L), TRUE)
expect_equal(dyn_lgl_get(arr, 1L), TRUE)
dyn_lgl_poke(arr, 0L, FALSE)
expect_equal(dyn_lgl_get(arr, 0L), FALSE)
Comment on lines 1007 to 1013
Copy link
Member Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Each test here tested the generic push API, the poke API, and the get API for each type. I've just extended these tests to also test the typed push API


arr <- new_dyn_vector("integer", 3)
dyn_push_back(arr, 1L)
dyn_push_back(arr, 2L)
dyn_int_push_back(arr, 2L)
expect_equal(dyn_int_get(arr, 0L), 1L)
expect_equal(dyn_int_get(arr, 1L), 2L)
dyn_int_poke(arr, 0L, 10L)
expect_equal(dyn_int_get(arr, 0L), 10L)

arr <- new_dyn_vector("double", 3)
dyn_push_back(arr, 1.5)
dyn_dbl_poke(arr, 0L, 2.5)
expect_equal(dyn_dbl_get(arr, 0L), 2.5)
dyn_dbl_push_back(arr, 2.5)
expect_equal(dyn_dbl_get(arr, 0L), 1.5)
expect_equal(dyn_dbl_get(arr, 1L), 2.5)
dyn_dbl_poke(arr, 0L, 3.5)
expect_equal(dyn_dbl_get(arr, 0L), 3.5)

arr <- new_dyn_vector("complex", 3)
dyn_push_back(arr, 0i)
dyn_cpl_poke(arr, 0L, 1i)
expect_equal(dyn_cpl_get(arr, 0L), 1i)
dyn_cpl_push_back(arr, 1i)
expect_equal(dyn_cpl_get(arr, 0L), 0i)
expect_equal(dyn_cpl_get(arr, 1L), 1i)
dyn_cpl_poke(arr, 0L, 2i)
expect_equal(dyn_cpl_get(arr, 0L), 2i)

arr <- new_dyn_vector("raw", 3)
dyn_push_back(arr, as.raw(1))
dyn_raw_poke(arr, 0L, as.raw(2))
expect_equal(dyn_raw_get(arr, 0L), as.raw(2))
dyn_raw_push_back(arr, as.raw(2))
expect_equal(dyn_raw_get(arr, 0L), as.raw(1))
expect_equal(dyn_raw_get(arr, 1L), as.raw(2))
dyn_raw_poke(arr, 0L, as.raw(3))
expect_equal(dyn_raw_get(arr, 0L), as.raw(3))

arr <- new_dyn_vector("character", 3)
dyn_push_back(arr, chr_get("foo", 0L))
val <- chr_get("bar", 0L)
dyn_chr_poke(arr, 0L, val)
expect_true(identical(dyn_chr_get(arr, 0L), val))
foo <- chr_get("foo", 0L)
bar <- chr_get("bar", 0L)
dyn_push_back(arr, foo)
dyn_chr_push_back(arr, bar)
expect_true(identical(dyn_chr_get(arr, 0L), foo))
expect_true(identical(dyn_chr_get(arr, 1L), bar))
baz <- chr_get("bar", 0L)
dyn_chr_poke(arr, 0L, baz)
expect_true(identical(dyn_chr_get(arr, 0L), baz))

arr <- new_dyn_vector("list", 3)
dyn_push_back(arr, 1:2)
dyn_list_push_back(arr, 3:4)
expect_equal(dyn_list_get(arr, 0L), 1:2)
expect_equal(dyn_list_get(arr, 1L), 3:4)
dyn_list_poke(arr, 0L, 11:12)
expect_equal(dyn_list_get(arr, 0L), 11:12)
})
Expand Down
Loading