Test the typed push-back API

r-lib · Mar 28, 2024 · 7274e2d · 7274e2d
1 parent 9ea718e
commit 7274e2d
Show file tree

Hide file tree

Showing 4 changed files with 98 additions and 13 deletions.
diff --git a/R/c-lib.R b/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)

diff --git a/src/internal/exported.c b/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);

diff --git a/src/internal/init.c b/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},

diff --git a/tests/testthat/test-c-api.R b/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)
 })