Test pointer handling

mrc-ide · Nov 12, 2021 · 827ca85 · 827ca85
1 parent 34cd062
commit 827ca85
Show file tree

Hide file tree

Showing 4 changed files with 37 additions and 0 deletions.
diff --git a/R/cpp11.R b/R/cpp11.R
@@ -32,6 +32,10 @@ dust_rng_pointer_sync <- function(obj, algorithm) {
   invisible(.Call(`_dust_dust_rng_pointer_sync`, obj, algorithm))
 }
 
+test_rng_pointer_get <- function(obj, n_streams) {
+  .Call(`_dust_test_rng_pointer_get`, obj, n_streams)
+}
+
 dust_rng_alloc <- function(r_seed, n_generators, deterministic, is_float) {
   .Call(`_dust_dust_rng_alloc`, r_seed, n_generators, deterministic, is_float)
 }

diff --git a/src/cpp11.cpp b/src/cpp11.cpp
@@ -62,6 +62,13 @@ extern "C" SEXP _dust_dust_rng_pointer_sync(SEXP obj, SEXP algorithm) {
     return R_NilValue;
   END_CPP11
 }
+// dust_rng_pointer.cpp
+double test_rng_pointer_get(cpp11::environment obj, int n_streams);
+extern "C" SEXP _dust_test_rng_pointer_get(SEXP obj, SEXP n_streams) {
+  BEGIN_CPP11
+    return cpp11::as_sexp(test_rng_pointer_get(cpp11::as_cpp<cpp11::decay_t<cpp11::environment>>(obj), cpp11::as_cpp<cpp11::decay_t<int>>(n_streams)));
+  END_CPP11
+}
 // dust_rng.cpp
 SEXP dust_rng_alloc(cpp11::sexp r_seed, int n_generators, bool deterministic, bool is_float);
 extern "C" SEXP _dust_dust_rng_alloc(SEXP r_seed, SEXP n_generators, SEXP deterministic, SEXP is_float) {
@@ -1192,6 +1199,7 @@ static const R_CallMethodDef CallEntries[] = {
     {"_dust_dust_walk_capabilities",            (DL_FUNC) &_dust_dust_walk_capabilities,            0},
     {"_dust_dust_walk_gpu_info",                (DL_FUNC) &_dust_dust_walk_gpu_info,                0},
     {"_dust_test_cuda_pars",                    (DL_FUNC) &_dust_test_cuda_pars,                    9},
+    {"_dust_test_rng_pointer_get",              (DL_FUNC) &_dust_test_rng_pointer_get,              2},
     {"_dust_test_xoshiro_run",                  (DL_FUNC) &_dust_test_xoshiro_run,                  1},
     {NULL, NULL, 0}
 };

diff --git a/src/dust_rng_pointer.cpp b/src/dust_rng_pointer.cpp
@@ -73,3 +73,12 @@ void dust_rng_pointer_sync(cpp11::environment obj, std::string algorithm) {
     r::rng_pointer_sync<xoshiro512plus_state>(obj);
   }
 }
+
+// This exists to check some error paths in rng_pointer_get; it is not
+// for use by users.
+[[cpp11::register]]
+double test_rng_pointer_get(cpp11::environment obj, int n_streams) {
+  using namespace dust::random;
+  auto rng = r::rng_pointer_get<xoshiro256plus_state>(obj, n_streams);
+  return random_real<double>(rng->state(0));
+}
diff --git a/tests/testthat/test-rng-interface.R b/tests/testthat/test-rng-interface.R
@@ -50,3 +50,19 @@ test_that("can't create invalid pointer types", {
     dust_rng_pointer$new(algorithm = "mt19937"),
     "Unknown algorithm 'mt19937'")
 })
+
+
+test_that("Validate pointers on fetch", {
+  obj <- dust_rng_pointer$new(algorithm = "xoshiro256starstar")
+  expect_error(
+    test_rng_pointer_get(obj, 1),
+    "Incorrect rng type: given xoshiro256starstar, expected xoshiro256plus")
+  obj <- dust_rng_pointer$new(algorithm = "xoshiro256plus", n_streams = 4)
+  expect_error(
+    test_rng_pointer_get(obj, 20),
+    "Requested a rng with 20 streams but only have 4")
+  expect_silent(
+    test_rng_pointer_get(obj, 0))
+  expect_silent(
+    test_rng_pointer_get(obj, 1))
+})