diff --git a/R/later.R b/R/later.R index a100629b..38e8f035 100644 --- a/R/later.R +++ b/R/later.R @@ -74,14 +74,12 @@ create_loop <- function(parent = current_loop()) { id <- .globals$next_id .globals$next_id <- id + 1L - if (!is.null(parent) && !inherits(parent, "event_loop")) { - stop("`parent` must be NULL or an event_loop object.") - } - if (is.null(parent)) { parent_id <- -1L - } else { + } else if (inherits(parent, "event_loop")) { parent_id <- parent$id + } else { + stop("`parent` must be NULL or an event_loop object.") } createCallbackRegistry(id, parent_id) @@ -108,10 +106,6 @@ create_loop <- function(parent = current_loop()) { } notify_r_ref_deleted <- function(loop) { - if (identical(loop, global_loop())) { - stop("Can't notify that reference to global loop is deleted.") - } - res <- notifyRRefDeleted(loop$id) if (res) { rm(list = as.character(loop$id), envir = .loops) @@ -122,10 +116,6 @@ notify_r_ref_deleted <- function(loop) { #' @rdname create_loop #' @export destroy_loop <- function(loop) { - if (identical(loop, global_loop())) { - stop("Can't destroy global loop.") - } - res <- deleteCallbackRegistry(loop$id) if (res) { rm(list = as.character(loop$id), envir = .loops) diff --git a/src/later.cpp b/src/later.cpp index fc4ae661..4e71aeb5 100644 --- a/src/later.cpp +++ b/src/later.cpp @@ -134,10 +134,10 @@ shared_ptr getGlobalRegistry() { bool deleteCallbackRegistry(int loop_id) { ASSERT_MAIN_THREAD() if (loop_id == GLOBAL_LOOP) { - Rf_error("Can't delete global loop."); + Rf_error("Can't destroy global loop."); } if (loop_id == getCurrentRegistryId()) { - Rf_error("Can't delete current loop."); + Rf_error("Can't destroy current loop."); } return callbackRegistryTable.remove(loop_id); @@ -149,10 +149,10 @@ bool deleteCallbackRegistry(int loop_id) { bool notifyRRefDeleted(int loop_id) { ASSERT_MAIN_THREAD() if (loop_id == GLOBAL_LOOP) { - Rf_error("Can't delete global loop."); + Rf_error("Can't notify that reference to global loop is deleted."); } if (loop_id == getCurrentRegistryId()) { - Rf_error("Can't delete current loop."); + Rf_error("Can't notify that reference to current loop is deleted."); } return callbackRegistryTable.notifyRRefDeleted(loop_id); diff --git a/tests/testthat/_snaps/private-loops.md b/tests/testthat/_snaps/private-loops.md index c1d21586..b0a20f16 100644 --- a/tests/testthat/_snaps/private-loops.md +++ b/tests/testthat/_snaps/private-loops.md @@ -9,17 +9,17 @@ --- Code - with_loop(l, run_now()) + run_now(loop = l) Condition - Error in `with_loop()`: - ! loop has been destroyed! + Error in `execCallbacks()`: + ! CallbackRegistry does not exist. --- Code destroy_loop(global_loop()) Condition - Error in `destroy_loop()`: + Error in `deleteCallbackRegistry()`: ! Can't destroy global loop. # Temporary event loops @@ -33,72 +33,78 @@ Error in `with_loop()`: ! loop has been destroyed! -# next_op_secs works +# list_queue Code - next_op_secs(loop) + list_queue(l) Condition - Error in `nextOpSecs()`: + Error in `list_queue_()`: ! CallbackRegistry does not exist. -# parameter validation works +# next_op_secs works Code - create_loop(parent = "invalid") + next_op_secs(loop) Condition - Error in `create_loop()`: - ! `parent` must be NULL or an event_loop object. + Error in `nextOpSecs()`: + ! CallbackRegistry does not exist. ---- +# parameter validation works Code - destroy_loop(global_loop()) + with_loop(loop, destroy_loop(loop)) Condition - Error in `destroy_loop()`: - ! Can't destroy global loop. + Error in `deleteCallbackRegistry()`: + ! Can't destroy current loop. --- Code - loop <- create_loop(parent = NULL) - destroy_loop(loop) with_loop(loop, { }) Condition Error in `with_loop()`: ! loop has been destroyed! -# esoteric error handlers +--- Code - with_loop(loop, deleteCallbackRegistry(current_loop()$id)) + loop_empty(loop) Condition - Error in `deleteCallbackRegistry()`: - ! Can't delete current loop. + Error in `idle()`: + ! CallbackRegistry does not exist. --- Code - with_loop(loop, { - .loops[[as.character(loop$id)]] <- NULL - current_loop() - }) + create_loop(parent = "invalid") Condition - Error in `current_loop()`: - ! Current loop with id 43 not found. + Error in `create_loop()`: + ! `parent` must be NULL or an event_loop object. ---- +# esoteric error handlers Code notify_r_ref_deleted(global_loop()) Condition - Error in `notify_r_ref_deleted()`: + Error in `notifyRRefDeleted()`: ! Can't notify that reference to global loop is deleted. --- Code - deleteCallbackRegistry(global_loop()$id) + with_loop(loop, notify_r_ref_deleted(loop)) Condition - Error in `deleteCallbackRegistry()`: - ! Can't delete global loop. + Error in `notifyRRefDeleted()`: + ! Can't notify that reference to current loop is deleted. + +--- + + Code + with_loop(loop, { + .loops[[as.character(loop$id)]] <- NULL + current_loop() + }) + Condition + Error in `current_loop()`: + ! Current loop with id 43 not found. diff --git a/tests/testthat/test-later-fd.R b/tests/testthat/test-later-fd.R index eed87903..413af7bf 100644 --- a/tests/testthat/test-later-fd.R +++ b/tests/testthat/test-later-fd.R @@ -110,15 +110,17 @@ test_that("later_fd() errors when passed destroyed loops", { }) test_that("later_fd C API works", { + skip_if(using_ubsan()) env <- new.env() Rcpp::cppFunction( depends = 'later', includes = ' #include + void func(int *value, void *data) {} ', code = ' int testfd() { - later::later_fd([](int *, void *){}, NULL, 0, NULL, 0, 0); + later::later_fd(func, nullptr, 0, nullptr, 0.0, 0); return 0; } ', diff --git a/tests/testthat/test-private-loops.R b/tests/testthat/test-private-loops.R index ff4391e4..095b32aa 100644 --- a/tests/testthat/test-private-loops.R +++ b/tests/testthat/test-private-loops.R @@ -60,7 +60,7 @@ test_that("Private event loops", { # Can't run later-y things with destroyed loop expect_snapshot(error = TRUE, with_loop(l, later(function() message("foo")))) - expect_snapshot(error = TRUE, with_loop(l, run_now())) + expect_snapshot(error = TRUE, run_now(loop = l)) # GC with functions in destroyed loops, even if callback isn't executed. l <- create_loop(parent = NULL) @@ -445,6 +445,9 @@ test_that("list_queue", { with_loop(l, run_now()) q <- list_queue(l) expect_equal(length(q), 0) + + destroy_loop(l) + expect_snapshot(error = TRUE, list_queue(l)) }) test_that("next_op_secs works", { @@ -465,13 +468,13 @@ test_that("next_op_secs works", { }) test_that("parameter validation works", { + loop <- create_loop(parent = NULL) + expect_snapshot(error = TRUE, with_loop(loop, destroy_loop(loop))) + expect_true(destroy_loop(loop)) + expect_false(destroy_loop(loop)) + expect_snapshot(error = TRUE, with_loop(loop, {})) + expect_snapshot(error = TRUE, loop_empty(loop)) expect_snapshot(error = TRUE, create_loop(parent = "invalid")) - expect_snapshot(error = TRUE, destroy_loop(global_loop())) - expect_snapshot(error = TRUE, { - loop <- create_loop(parent = NULL) - destroy_loop(loop) - with_loop(loop, {}) - }) }) test_that("print.event_loop works correctly", { @@ -487,15 +490,12 @@ test_that("print.event_loop works correctly", { test_that("esoteric error handlers", { loop <- create_loop(parent = NULL) - expect_snapshot(error = TRUE, { - with_loop(loop, deleteCallbackRegistry(current_loop()$id)) - }) + expect_snapshot(error = TRUE, notify_r_ref_deleted(global_loop())) + expect_snapshot(error = TRUE, with_loop(loop, notify_r_ref_deleted(loop))) expect_snapshot(error = TRUE, { with_loop(loop, { .loops[[as.character(loop$id)]] <- NULL current_loop() }) }) - expect_snapshot(error = TRUE, notify_r_ref_deleted(global_loop())) - expect_snapshot(error = TRUE, deleteCallbackRegistry(global_loop()$id)) })