From 41558dbabae4a6fd3d0c6737489cd396e9c6c734 Mon Sep 17 00:00:00 2001 From: Claude Date: Sun, 16 Aug 2026 14:22:53 +0000 Subject: [PATCH] fix: let a callback call igraph again Every R callback igraph invokes from C could take the session down. `R_igraph_finalizer()` calls `IGRAPH_FINALLY_FREE()`, and every igraph function calls it from `on.exit()` to clean up after an algorithm that was left half-way. An igraph function reached from a callback is not that case: the "finally" stack then holds the structures of the algorithm that is still running, and freeing them leaves it working on destroyed memory. The algorithm carries on and trips over an assertion, or takes R down with it. Reaching igraph again from a callback needs no intent. `length()` on a graph calls `vcount()`, and lifecycle gets there through `rlang::trace_back()` while it assembles a backtrace, so a deprecated function used as a callback was enough: bfs(make_ring(5), root = 1, callback = function(...) { is.igraph(g); FALSE }) #> Error: At core/dqueue.pmt:120 : Assertion failed: q->stor_begin != NULL. The finalizer now stands aside while a callback is running. `Rx_igraph_eval_callback()` counts the callbacks in flight, through `R_UnwindProtect()` so that the count comes back down even when the callback raises an error and R unwinds past it. Everything that hands R code to a running algorithm goes through it: the search callbacks in `rcallback.c`, `Rx_igraph_safe_eval_in_env()` for `bfs()`, `dfs()` and the attribute combination functions, and the ARPACK multiplication. The `bfs()` test that covered this is no longer skipped. Co-Authored-By: Claude Opus 5 Claude-Session: https://claude.ai/code/session_01WJx1uH2GvN5DcqdVzDLvwW --- src/rcallback.c | 18 +-- src/rinterface.h | 2 + src/rinterface_extra.c | 69 ++++++++++- tests/testthat/_snaps/nested-igraph-calls.md | 15 +++ tests/testthat/test-nested-igraph-calls.R | 124 +++++++++++++++++++ tests/testthat/test-structural-properties.R | 2 - 6 files changed, 217 insertions(+), 13 deletions(-) create mode 100644 tests/testthat/_snaps/nested-igraph-calls.md create mode 100644 tests/testthat/test-nested-igraph-calls.R diff --git a/src/rcallback.c b/src/rcallback.c index bc0fe4369e7..094c8daae6b 100644 --- a/src/rcallback.c +++ b/src/rcallback.c @@ -60,7 +60,7 @@ igraph_error_t R_igraph_motifs_handler(const igraph_t *graph, /* Call the R function: callback(vids, isoclass) */ PROTECT(R_fcall = Rf_lang3(callback, vids_r, isoclass_r)); - PROTECT(result = Rf_eval(R_fcall, R_GlobalEnv)); + PROTECT(result = Rx_igraph_eval_callback(R_fcall, R_GlobalEnv)); /* Check if result is an error condition (from tryCatch) */ if (Rf_inherits(result, "error")) { @@ -110,7 +110,7 @@ igraph_error_t R_igraph_clique_handler(const igraph_vector_int_t *clique, void * /* Call the R function: callback(clique) */ PROTECT(R_fcall = Rf_lang2(callback, clique_r)); - PROTECT(result = Rf_eval(R_fcall, R_GlobalEnv)); + PROTECT(result = Rx_igraph_eval_callback(R_fcall, R_GlobalEnv)); /* Check if result is an error condition (from tryCatch) */ if (Rf_inherits(result, "error")) { @@ -182,7 +182,7 @@ igraph_error_t R_igraph_cycle_handler( /* Call the R function: callback(vertices, edges) */ PROTECT(R_fcall = Rf_lang3(callback, vertices_r, edges_r)); - PROTECT(result = Rf_eval(R_fcall, R_GlobalEnv)); + PROTECT(result = Rx_igraph_eval_callback(R_fcall, R_GlobalEnv)); /* Check if result is an error condition (from tryCatch) */ if (Rf_inherits(result, "error")) { @@ -242,7 +242,7 @@ igraph_error_t R_igraph_isomorphism_handler( /* Call the R function: callback(map12, map21) */ PROTECT(R_fcall = Rf_lang3(callback, map12_r, map21_r)); - PROTECT(result = Rf_eval(R_fcall, R_GlobalEnv)); + PROTECT(result = Rx_igraph_eval_callback(R_fcall, R_GlobalEnv)); /* Check if result is an error condition (from tryCatch) */ if (Rf_inherits(result, "error")) { @@ -336,7 +336,7 @@ igraph_error_t R_igraph_bfs_handler( /* Call the R callback with the converted data */ PROTECT(R_fcall = Rf_lang2(callback, args)); - PROTECT(result = Rf_eval(R_fcall, R_GlobalEnv)); + PROTECT(result = Rx_igraph_eval_callback(R_fcall, R_GlobalEnv)); /* Check if result is an error or interrupt condition */ if (Rf_inherits(result, "error")) { @@ -415,7 +415,7 @@ igraph_error_t R_igraph_dfs_handler_in( /* Call the R callback */ PROTECT(R_fcall = Rf_lang2(callback, args)); - PROTECT(result = Rf_eval(R_fcall, R_GlobalEnv)); + PROTECT(result = Rx_igraph_eval_callback(R_fcall, R_GlobalEnv)); /* Check if result is an error or interrupt condition */ if (Rf_inherits(result, "error")) { @@ -464,7 +464,7 @@ igraph_error_t R_igraph_dfs_handler_out( /* Call the R callback */ PROTECT(R_fcall = Rf_lang2(callback, args)); - PROTECT(result = Rf_eval(R_fcall, R_GlobalEnv)); + PROTECT(result = Rx_igraph_eval_callback(R_fcall, R_GlobalEnv)); /* Check if result is an error or interrupt condition */ if (Rf_inherits(result, "error")) { @@ -574,11 +574,11 @@ igraph_error_t R_igraph_levc_handler( PROTECT(l2 = R_MakeExternalPtr((void*)&cont, R_NilValue, R_NilValue)); PROTECT(l3 = R_MakeExternalPtr(arpack_extra, R_NilValue, R_NilValue)); PROTECT(R_multip_call = Rf_lang3(l1, l2, l3)); - PROTECT(s_multip = Rf_eval(R_multip_call, data->env_arp)); + PROTECT(s_multip = Rx_igraph_eval_callback(R_multip_call, data->env_arp)); /* Build the call: callback(membership, community, value, vector, multiplier, extra) */ PROTECT(R_fcall = Rx_igraph_i_lang7(callback, s_memb, s_comm, s_evalue, s_evector, s_multip, data->extra)); - PROTECT(res = Rf_eval(R_fcall, data->env)); + PROTECT(res = Rx_igraph_eval_callback(R_fcall, data->env)); /* Check if result is an error condition (from tryCatch) */ if (Rf_inherits(res, "error")) { diff --git a/src/rinterface.h b/src/rinterface.h index c1a18271c7b..19a1701c2f6 100644 --- a/src/rinterface.h +++ b/src/rinterface.h @@ -43,6 +43,8 @@ SEXP Rx_igraph_add_env(SEXP graph); void Rx_igraph_attribute_clean_preserve_list(void); void Rx_igraph_set_in_r_check(bool set); +bool Rx_igraph_callback_running(void); +SEXP Rx_igraph_eval_callback(SEXP call, SEXP rho); void Rx_igraph_error(void); void Rx_igraph_warning(void); void Rx_igraph_interrupt(void); diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index 0ffcc2f4d40..ffae131b33e 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -299,7 +299,7 @@ SEXP Rx_igraph_safe_eval_in_env(SEXP expr_call, SEXP rho, Rx_igraph_safe_eval_re SET_TAG(CDDR(CDR(try_catch_call)), Rf_install("interrupt")); /* execute the call */ - SEXP retval = PROTECT(Rf_eval(try_catch_call, rho)); + SEXP retval = PROTECT(Rx_igraph_eval_callback(try_catch_call, rho)); /* did we get an error or an interrupt? */ if (result) { @@ -2371,6 +2371,60 @@ void Rx_igraph_set_in_r_check(bool set) { Rx_igraph_in_r_check = set; } +/* How many R callbacks a running algorithm is waiting on. + * + * R code that igraph reaches from inside an algorithm -- a search callback, an + * attribute combination function, an ARPACK multiplication -- can find its way + * back into igraph without meaning to: `length()` on a graph calls `vcount()`, + * and lifecycle gets there through `rlang::trace_back()` while it assembles a + * backtrace for a deprecation warning. While that is going on the "finally" + * stack belongs to the algorithm that is still running, and the nested call + * must not unwind it (see R_igraph_finalizer()). */ +static int Rx_igraph_running_callbacks = 0; + +/* HELPER: internal C; must use IGRAPH_CHECK */ +bool Rx_igraph_callback_running(void) { + return Rx_igraph_running_callbacks > 0; +} + +typedef struct Rx_igraph_i_callback_t { + SEXP call; + SEXP rho; +} Rx_igraph_i_callback_t; + +/* HELPER: internal C; must use IGRAPH_CHECK */ +static SEXP Rx_igraph_i_eval_callback(void *data) { + Rx_igraph_i_callback_t *callback = data; + return Rf_eval(callback->call, callback->rho); +} + +/* HELPER: internal C; must use IGRAPH_CHECK */ +static void Rx_igraph_i_left_callback(void *data, Rboolean jump) { + (void) data; + (void) jump; + Rx_igraph_running_callbacks--; +} + +/* HELPER: internal C; must use IGRAPH_CHECK */ +SEXP Rx_igraph_eval_callback(SEXP call, SEXP rho) { + Rx_igraph_i_callback_t callback = { call, rho }; + SEXP continuation = PROTECT(R_MakeUnwindCont()); + SEXP result; + + Rx_igraph_running_callbacks++; + /* R_UnwindProtect() rather than a plain decrement afterwards: a callback + * that raises an error unwinds past us, and a count left standing would + * silence R_igraph_finalizer() for the rest of the session. */ + result = R_UnwindProtect( + Rx_igraph_i_eval_callback, &callback, + Rx_igraph_i_left_callback, NULL, + continuation + ); + + UNPROTECT(1); + return result; +} + /* HELPER: internal C; must use IGRAPH_CHECK */ void Rx_igraph_error(void) { Rx_igraph_errors_count = 0; @@ -2648,6 +2702,17 @@ SEXP Rx_igraph_set_verbose(SEXP verbose) { /* TOP-LEVEL: called from R via .Call; must use IGRAPH_R_CHECK */ SEXP R_igraph_finalizer(void) { + /* Every igraph function calls this on exit, to clean up after an algorithm + * that was left half-way. One reached from a callback is not that case: the + * "finally" stack then holds the structures of the algorithm that is still + * running, and freeing them leaves it working on destroyed memory -- the + * algorithm carries on and trips over an assertion, or takes R down with it. + * The algorithm cleans up after itself when it finishes, and the error path + * of the callback frees the stack before it aborts. */ + if (Rx_igraph_callback_running()) { + return R_NilValue; + } + IGRAPH_FINALLY_FREE(); int px = 0; SEXP rho; @@ -6070,7 +6135,7 @@ igraph_error_t Rx_igraph_i_arpack_callback(igraph_real_t *to, const igraph_real_ memcpy(REAL(s_from), from, sizeof(igraph_real_t) * (size_t) n); PROTECT(R_fcall = Rf_lang3(data->fun, s_from, data->extra)); - PROTECT(s_to = Rf_eval(R_fcall, data->rho)); + PROTECT(s_to = Rx_igraph_eval_callback(R_fcall, data->rho)); memcpy(to, REAL(s_to), sizeof(igraph_real_t) * (size_t) n); UNPROTECT(3); diff --git a/tests/testthat/_snaps/nested-igraph-calls.md b/tests/testthat/_snaps/nested-igraph-calls.md new file mode 100644 index 00000000000..311265b4a64 --- /dev/null +++ b/tests/testthat/_snaps/nested-igraph-calls.md @@ -0,0 +1,15 @@ +# a callback may signal a deprecation + + Code + order <- bfs(g, root = 1, callback = function(...) { + is.igraph(g) + FALSE + })$order + Condition + Warning: + `is.igraph()` was deprecated in igraph 2.0.0. + i Please use `is_igraph()` instead. + Warning: + `is.igraph()` was deprecated in igraph 2.0.0. + i Please use `is_igraph()` instead. + diff --git a/tests/testthat/test-nested-igraph-calls.R b/tests/testthat/test-nested-igraph-calls.R new file mode 100644 index 00000000000..80d361b67fb --- /dev/null +++ b/tests/testthat/test-nested-igraph-calls.R @@ -0,0 +1,124 @@ +# Reaching igraph again from inside a callback is easy to do without meaning +# to: `length()` on a graph calls `vcount()`, and lifecycle gets there through +# `rlang::trace_back()` while it assembles a backtrace for a deprecation +# warning. Every one of these used to leave the running algorithm working on +# structures that the nested call had freed, which ended in an igraph assertion +# or took R down with it. + +# The smallest nested igraph call there is. Callbacks continue on FALSE. +call_igraph_again <- function(...) { + vcount(make_ring(3)) + FALSE +} + +test_that("a search callback may call igraph again", { + g <- make_ring(5, directed = TRUE) + + expect_no_error(bfs(g, root = 1, callback = call_igraph_again)) + expect_no_error(dfs(g, root = 1, in.callback = call_igraph_again)) + expect_no_error(dfs(g, root = 1, out.callback = call_igraph_again)) +}) + +test_that("a clique callback may call igraph again", { + g <- make_full_graph(4) + + expect_no_error(cliques(g, min = 2, callback = call_igraph_again)) + expect_no_error(max_cliques(g, min = 2, callback = call_igraph_again)) +}) + +test_that("a motif callback may call igraph again", { + g <- make_ring(5, directed = TRUE) + + expect_no_error(motifs(g, 3, callback = call_igraph_again)) +}) + +test_that("a cycle callback may call igraph again", { + g <- make_ring(5, directed = TRUE) + + expect_no_error(simple_cycles(g, callback = call_igraph_again)) +}) + +test_that("an isomorphism callback may call igraph again", { + g <- make_ring(5, directed = TRUE) + h <- make_ring(5, directed = TRUE) + + expect_no_error(isomorphisms(g, h, callback = call_igraph_again)) + expect_no_error( + subgraph_isomorphisms(g, h, method = "vf2", callback = call_igraph_again) + ) +}) + +test_that("a community callback may call igraph again", { + g <- make_graph("Zachary") + + expect_no_error(cluster_leading_eigen(g, callback = call_igraph_again)) +}) + +test_that("an ARPACK multiplication may call igraph again", { + multiply <- function(x, extra) { + vcount(make_ring(3)) + x + } + + expect_no_error(arpack( + multiply, + options = list(n = 5, nev = 1, ncv = 3, which = "LM"), + sym = TRUE + )) +}) + +test_that("an attribute combination function may call igraph again", { + combine <- function(x) { + vcount(make_ring(3)) + sum(x) + } + + g <- make_graph(c(1, 2, 1, 2)) + E(g)$weight <- c(1, 2) + expect_no_error(simplify(g, edge.attr.comb = list(weight = combine))) + + h <- make_ring(5) + V(h)$size <- 1:5 + expect_no_error( + contract(h, c(1, 1, 2, 2, 3), vertex.attr.comb = list(size = combine)) + ) +}) + +test_that("a callback may signal a deprecation", { + # The motivating case: lifecycle reaches `vcount()` through the backtrace it + # assembles, so a deprecated function used as a callback took igraph down. + # Two vertices keep the snapshot short: the callback runs for each of them, + # and the "warning" verbosity a snapshot needs turns off the deduplication + # that leaves a user with one warning. + g <- make_ring(2, directed = TRUE) + rlang::local_options(lifecycle_verbosity = "warning") + + expect_snapshot({ + order <- bfs(g, root = 1, callback = function(...) { + is.igraph(g) + FALSE + })$order + }) +}) + +test_that("a callback may look at the graph it is given (#253)", { + g <- set_vertex_attr(make_tree(10), "xx", value = 10:19) + callback <- function(graph, data, extra) { + V(graph)[data[["vid"]]]$xx + format(graph) + FALSE + } + + expect_no_error(bfs(g, root = 1, mode = "out", callback = callback)) +}) + +test_that("an error in a callback still reaches the caller", { + # The nested call must not swallow the abort path along with the unwinding. + g <- make_ring(5, directed = TRUE) + callback <- function(...) { + vcount(make_ring(3)) + cli::cli_abort("from the callback") + } + + expect_error(bfs(g, root = 1, callback = callback), "from the callback") +}) diff --git a/tests/testthat/test-structural-properties.R b/tests/testthat/test-structural-properties.R index 6c4e5752024..eb75d0ed860 100644 --- a/tests/testthat/test-structural-properties.R +++ b/tests/testthat/test-structural-properties.R @@ -211,8 +211,6 @@ test_that("BFS callback does not blow up when an error is raised within the call }) test_that("BFS callback does not blow up when another igraph function is raised within the callback", { - skip("nested igraph call handling not implemented yet") - callback <- function(graph, data, extra) { neighbors(graph, 1) FALSE