Add r_dyn_raw_push_back() and r_dyn_chr_push_back() (#1699)

* Add `r_dyn_raw_push_back()` and `r_dyn_chr_push_back()`

* Test the typed push-back API

* NEWS bullet

NEWS.md

@@ -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).
 
 
@@ -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
 
@@ -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`

R/c-lib.R

@@ -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)

src/internal/exported.c

@@ -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);

src/internal/init.c

@@ -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},

src/rlang/dyn-array.h

@@ -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);

tests/testthat/test-c-api.R

@@ -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)
 
   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)
 })