From 5bc6504607b4732b113f0c2a3ca0a16346703b5b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sun, 2 Jul 2023 21:55:38 +0200 Subject: [PATCH 1/7] Add tests --- tests/testthat/test-attributes.R | 80 ++++++++++++++++++++++++++++++++ 1 file changed, 80 insertions(+) diff --git a/tests/testthat/test-attributes.R b/tests/testthat/test-attributes.R index 187cf6852dd..2f291da6506 100644 --- a/tests/testthat/test-attributes.R +++ b/tests/testthat/test-attributes.R @@ -254,3 +254,83 @@ test_that("setting NULL attributes works and doesn't change the input (#466)", { expect_identical(set_edge_attr(g, "foo", value = NULL), g) expect_identical(set_edge_attr(g, "foo", 1:3, value = NULL), g) }) + +test_that("GRAPH attributes are destroyed when the graph is destroyed", { + finalized <- FALSE + finalizer <- function(e) { + finalized <<- TRUE + } + + env <- new.env(parent = emptyenv()) + reg.finalizer(env, finalizer) + + g <- make_ring(1) + g$a <- list(env) + rm(env) + gc() + expect_false(finalized) + + rm(g) + gc() + expect_true(finalized) +}) + +test_that("vertex attributes are destroyed when the graph is destroyed", { + finalized <- FALSE + finalizer <- function(e) { + finalized <<- TRUE + } + + env <- new.env(parent = emptyenv()) + reg.finalizer(env, finalizer) + + g <- make_ring(1) + V(g)$a <- list(env) + rm(env) + gc() + expect_false(finalized) + + g <- add_vertices(g, 1) + gc() + expect_false(finalized) + + g <- delete_vertices(g, 2) + gc() + expect_false(finalized) + + rm(g) + gc() + expect_true(finalized) +}) + +test_that("edge attributes are destroyed when the graph is destroyed", { + finalized <- FALSE + finalizer <- function(e) { + finalized <<- TRUE + } + + env <- new.env(parent = emptyenv()) + reg.finalizer(env, finalizer) + + g <- make_ring(2) + E(g)$a <- list(env) + rm(env) + gc() + expect_false(finalized) + + g <- add_vertices(g, 1) + gc() + expect_false(finalized) + + g <- add_edges(g, c(2, 3)) + gc() + expect_false(finalized) + + g <- delete_edges(g, 2) + gc() + expect_false(finalized) + + rm(g) + gc() + expect_true(finalized) +}) From c3b532e537ca0bb29a7e2056f82429465f22652f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Sun, 2 Jul 2023 23:31:35 +0200 Subject: [PATCH 2/7] Maintain own temporary preserve list --- src/rinterface.h | 2 ++ src/rinterface_extra.c | 65 ++++++++++++++++++++++-------------------- 2 files changed, 36 insertions(+), 31 deletions(-) diff --git a/src/rinterface.h b/src/rinterface.h index 02e016e0c17..b64a6c83fc5 100644 --- a/src/rinterface.h +++ b/src/rinterface.h @@ -27,6 +27,7 @@ SEXP R_igraph_add_env(SEXP graph); +void R_igraph_attribute_clean_preserve_list(); void R_igraph_set_in_r_check(bool set); void R_igraph_error(void); void R_igraph_warning(void); @@ -37,6 +38,7 @@ void R_igraph_interrupt(void); R_igraph_set_in_r_check(true); \ igraph_error_type_t __c = func; \ R_igraph_set_in_r_check(false); \ + R_igraph_attribute_clean_preserve_list(); \ R_igraph_warning(); \ if (__c == IGRAPH_INTERRUPTED) { R_igraph_interrupt(); } \ else if (__c != IGRAPH_SUCCESS) { R_igraph_error(); } \ diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index b8840bb379d..4421f5864ef 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -340,6 +340,31 @@ int R_SEXP_to_attr_comb(SEXP input, igraph_attribute_combination_t *comb) { return 0; } +static SEXP R_igraph_attribute_preserve_list; + +void R_igraph_attribute_add_to_preserve_list(SEXP attr) { + if (!R_igraph_attribute_preserve_list) { + // We don't care about freeing this, typically this is just a single node + R_igraph_attribute_preserve_list = Rf_cons(R_NilValue, R_NilValue); + R_PreserveObject(R_igraph_attribute_preserve_list); + } + + // Create a new node, add it to the head of the list. + SEXP node = Rf_cons(attr, CDR(R_igraph_attribute_preserve_list)); + SETCDR(R_igraph_attribute_preserve_list, node); +} + +void R_igraph_attribute_clean_preserve_list() { + if (R_igraph_attribute_preserve_list) { + // Mark the entire list available for garbage collection. + // Attributes that have been assigned to a graph object will remain protected. + // Dangling attributes will be GC-ed eventually. + SETCDR(R_igraph_attribute_preserve_list, R_NilValue); + } +} + + + static SEXP R_igraph_attribute_protected=0; static long int R_igraph_attribute_protected_size=0; @@ -378,7 +403,10 @@ int R_igraph_attribute_init(igraph_t *graph, igraph_vector_ptr_t *attr) { REAL(VECTOR_ELT(result, 0))[3] = R_igraph_attribute_protected_size; R_igraph_attribute_protected_size += 1; } else { - R_PreserveObject(result=NEW_LIST(4)); + result=NEW_LIST(4); + // The "preserve list" Will be cleared with the next invocation of IGRAPH_R_CHECK(). + // Adding to that list ensures that the attributes aren't GC-ed prematurely. + R_igraph_attribute_add_to_preserve_list(result); SET_VECTOR_ELT(result, 0, NEW_NUMERIC(3)); } REAL(VECTOR_ELT(result, 0))[0]=0; /* R objects */ @@ -445,11 +473,6 @@ int R_igraph_attribute_init(igraph_t *graph, igraph_vector_ptr_t *attr) { void R_igraph_attribute_destroy(igraph_t *graph) { SEXP attr=graph->attr; REAL(VECTOR_ELT(attr, 0))[1] -= 1; /* refcount for igraph_t */ - if (!R_igraph_attribute_protected && - REAL(VECTOR_ELT(attr, 0))[1]==0 && - REAL(VECTOR_ELT(attr, 0))[2]==1) { - R_ReleaseObject(attr); - } graph->attr=0; } @@ -465,10 +488,6 @@ int R_igraph_attribute_copy(igraph_t *to, const igraph_t *from, if (ga && va && ea) { to->attr=from->attr; REAL(VECTOR_ELT(fromattr, 0))[1] += 1; /* refcount only */ - if (!R_igraph_attribute_protected && - REAL(VECTOR_ELT(fromattr, 0))[1] == 1) { - R_PreserveObject(to->attr); - } } else { R_igraph_attribute_init(to,0); /* Sets up many things */ SEXP toattr=to->attr; @@ -592,14 +611,10 @@ SEXP R_igraph_attribute_add_vertices_dup(SEXP attr) { if (R_igraph_attribute_protected) { PROTECT(newattr); px++; } else { - R_PreserveObject(newattr); + R_igraph_attribute_add_to_preserve_list(newattr); } REAL(VECTOR_ELT(attr, 0))[1] -= 1; - if (!R_igraph_attribute_protected && - REAL(VECTOR_ELT(attr, 0))[1] == 0) { - R_ReleaseObject(attr); - } REAL(VECTOR_ELT(newattr, 0))[0] = 0; REAL(VECTOR_ELT(newattr, 0))[1] = 1; if (R_igraph_attribute_protected) { @@ -778,13 +793,9 @@ int R_igraph_attribute_permute_vertices_same(const igraph_t *graph, if (R_igraph_attribute_protected) { PROTECT(newattr); px++; } else { - R_PreserveObject(newattr); + R_igraph_attribute_add_to_preserve_list(newattr); } REAL(VECTOR_ELT(attr, 0))[1] -= 1; - if (!R_igraph_attribute_protected && - REAL(VECTOR_ELT(attr, 0))[1] == 0) { - R_ReleaseObject(attr); - } REAL(VECTOR_ELT(newattr, 0))[0] = 0; REAL(VECTOR_ELT(newattr, 0))[1] = 1; if (R_igraph_attribute_protected) { @@ -895,14 +906,10 @@ SEXP R_igraph_attribute_add_edges_dup(SEXP attr) { if (R_igraph_attribute_protected) { PROTECT(newattr); px++; } else { - R_PreserveObject(newattr); + R_igraph_attribute_add_to_preserve_list(newattr); } REAL(VECTOR_ELT(attr, 0))[1] -= 1; - if (!R_igraph_attribute_protected && - REAL(VECTOR_ELT(attr, 0))[1] == 0) { - R_ReleaseObject(attr); - } REAL(VECTOR_ELT(newattr, 0))[0] = 0; REAL(VECTOR_ELT(newattr, 0))[1] = 1; if (R_igraph_attribute_protected) { @@ -1162,13 +1169,9 @@ int R_igraph_attribute_permute_edges_same(const igraph_t *graph, if (R_igraph_attribute_protected) { PROTECT(newattr); px++; } else { - R_PreserveObject(newattr); + R_igraph_attribute_add_to_preserve_list(newattr); } REAL(VECTOR_ELT(attr, 0))[1] -= 1; - if (!R_igraph_attribute_protected && - REAL(VECTOR_ELT(attr, 0))[1] == 0) { - R_ReleaseObject(attr); - } REAL(VECTOR_ELT(newattr, 0))[0] = 0; REAL(VECTOR_ELT(newattr, 0))[1] = 1; if (R_igraph_attribute_protected) { @@ -3752,7 +3755,7 @@ int R_SEXP_to_igraph_copy(SEXP graph, igraph_t *res) { /* attributes */ REAL(VECTOR_ELT(VECTOR_ELT(graph, igraph_t_idx_attr), 0))[0] = 1; /* R objects */ REAL(VECTOR_ELT(VECTOR_ELT(graph, igraph_t_idx_attr), 0))[1] = 1; /* igraph_t objects */ - R_PreserveObject(res->attr=VECTOR_ELT(graph, igraph_t_idx_attr)); + res->attr=VECTOR_ELT(graph, igraph_t_idx_attr); return 0; } From a3f07e9df6bd5a1cf36a66f633ca8c7436f1146a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Jul 2023 01:27:20 +0200 Subject: [PATCH 3/7] Call R_igraph_attribute_clean_preserve_list() first --- src/rinterface.h | 2 +- src/rinterface_extra.c | 7 ++++++- tests/testthat/test-attributes.R | 10 ++++++++++ 3 files changed, 17 insertions(+), 2 deletions(-) diff --git a/src/rinterface.h b/src/rinterface.h index b64a6c83fc5..4e1c9f5f00a 100644 --- a/src/rinterface.h +++ b/src/rinterface.h @@ -35,10 +35,10 @@ void R_igraph_interrupt(void); #define IGRAPH_R_CHECK(func) \ do { \ + R_igraph_attribute_clean_preserve_list(); \ R_igraph_set_in_r_check(true); \ igraph_error_type_t __c = func; \ R_igraph_set_in_r_check(false); \ - R_igraph_attribute_clean_preserve_list(); \ R_igraph_warning(); \ if (__c == IGRAPH_INTERRUPTED) { R_igraph_interrupt(); } \ else if (__c != IGRAPH_SUCCESS) { R_igraph_error(); } \ diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index 4421f5864ef..46b13575ecd 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -357,8 +357,13 @@ void R_igraph_attribute_add_to_preserve_list(SEXP attr) { void R_igraph_attribute_clean_preserve_list() { if (R_igraph_attribute_preserve_list) { // Mark the entire list available for garbage collection. - // Attributes that have been assigned to a graph object will remain protected. + // Attributes that have been assigned to an R graph object will remain protected. // Dangling attributes will be GC-ed eventually. + + // This is called *before* entering an igraph function that might allocate + // attributes; after such a function returns, we need to keep preserving + // all attributes because they may be put into R graph objects + // and returned to R. SETCDR(R_igraph_attribute_preserve_list, R_NilValue); } } diff --git a/tests/testthat/test-attributes.R b/tests/testthat/test-attributes.R index 2f291da6506..2aa2a26c998 100644 --- a/tests/testthat/test-attributes.R +++ b/tests/testthat/test-attributes.R @@ -298,7 +298,12 @@ test_that("vertex attributes are destroyed when the graph is destroyed", { gc() expect_false(finalized) + # Called for the side effect of clearing the protect list + make_empty_graph() + expect_false(finalized) + rm(g) + gc() expect_true(finalized) }) @@ -330,7 +335,12 @@ test_that("edge attributes are destroyed when the graph is destroyed", { gc() expect_false(finalized) + # Called for the side effect of clearing the protect list + make_empty_graph() + expect_false(finalized) + rm(g) + gc() expect_true(finalized) }) From 5397bca09becdaec6d1f4b0047048432a3808b9d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Jul 2023 01:27:37 +0200 Subject: [PATCH 4/7] Avoid R_igraph_attribute_protected --- src/rinterface_extra.c | 25 +------------------------ tests/testthat/test-decompose.graph.R | 10 ++++++++++ 2 files changed, 11 insertions(+), 24 deletions(-) diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index 46b13575ecd..7616a788016 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -5822,10 +5822,6 @@ SEXP R_igraph_decompose(SEXP graph, SEXP pmode, SEXP pmaxcompno, SEXP result; long int i; - R_PreserveObject(R_igraph_attribute_protected=NEW_LIST(100)); - R_igraph_attribute_protected_size=0; - IGRAPH_FINALLY(R_igraph_attribute_protected_destroy, 0); - R_SEXP_to_igraph(graph, &g); igraph_vector_ptr_init(&comps, 0); IGRAPH_FINALLY(igraph_vector_ptr_destroy, &comps); @@ -5839,8 +5835,7 @@ SEXP R_igraph_decompose(SEXP graph, SEXP pmode, SEXP pmaxcompno, igraph_vector_ptr_destroy(&comps); UNPROTECT(1); - IGRAPH_FINALLY_CLEAN(2); - R_igraph_attribute_protected_destroy(0); + IGRAPH_FINALLY_CLEAN(1); return result; } @@ -7151,10 +7146,6 @@ SEXP R_igraph_neighborhood_graphs(SEXP graph, SEXP pvids, SEXP porder, igraph_integer_t mindist=INTEGER(pmindist)[0]; SEXP result; - R_PreserveObject(R_igraph_attribute_protected=NEW_LIST(100)); - R_igraph_attribute_protected_size=0; - IGRAPH_FINALLY(R_igraph_attribute_protected_destroy, 0); - R_SEXP_to_igraph(graph, &g); R_SEXP_to_igraph_vs(pvids, &g, &vids); igraph_vector_ptr_init(&res, 0); @@ -7170,8 +7161,6 @@ SEXP R_igraph_neighborhood_graphs(SEXP graph, SEXP pvids, SEXP porder, igraph_vs_destroy(&vids); UNPROTECT(1); - IGRAPH_FINALLY_CLEAN(1); - R_igraph_attribute_protected_destroy(0); return result; } @@ -9291,10 +9280,6 @@ SEXP R_igraph_graphlets(SEXP graph, SEXP weights, SEXP niter) { SEXP Mu; SEXP result, names; - R_PreserveObject(R_igraph_attribute_protected=NEW_LIST(100)); - R_igraph_attribute_protected_size=0; - IGRAPH_FINALLY(R_igraph_attribute_protected_destroy, 0); - /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } @@ -9326,8 +9311,6 @@ SEXP R_igraph_graphlets(SEXP graph, SEXP weights, SEXP niter) { SET_NAMES(result, names); UNPROTECT(4); - IGRAPH_FINALLY_CLEAN(1); - R_igraph_attribute_protected_destroy(0); return(result); } @@ -9346,10 +9329,6 @@ SEXP R_igraph_graphlets_candidate_basis(SEXP graph, SEXP weights) { SEXP result, names; - R_PreserveObject(R_igraph_attribute_protected=NEW_LIST(100)); - R_igraph_attribute_protected_size=0; - IGRAPH_FINALLY(R_igraph_attribute_protected_destroy, 0); - /* Convert input */ R_SEXP_to_igraph(graph, &c_graph); if (!Rf_isNull(weights)) { R_SEXP_to_vector(weights, &c_weights); } @@ -9380,8 +9359,6 @@ SEXP R_igraph_graphlets_candidate_basis(SEXP graph, SEXP weights) { SET_NAMES(result, names); UNPROTECT(4); - IGRAPH_FINALLY_CLEAN(1); - R_igraph_attribute_protected_destroy(0); return(result); } diff --git a/tests/testthat/test-decompose.graph.R b/tests/testthat/test-decompose.graph.R index da4321e03dc..a4a8bd82079 100644 --- a/tests/testthat/test-decompose.graph.R +++ b/tests/testthat/test-decompose.graph.R @@ -35,3 +35,13 @@ test_that("decompose keeps attributes", { expect_that(E(d[[1]])$name, equals(e1)) expect_that(E(d[[2]])$name, equals(e2)) }) + +test_that("decompose protects correctly", { + g <- make_graph(integer(), n = 10001) + V(g)$a <- 1 + + torture <- gctorture2(10001) + on.exit(gctorture2(torture)) + + length(decompose(g)) +}) From 2faccd9382d040e09c869145c4f53506fe11fecb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Jul 2023 01:38:01 +0200 Subject: [PATCH 5/7] Remove R_igraph_attribute_protected --- src/rinterface_extra.c | 139 +++-------------------------------------- 1 file changed, 9 insertions(+), 130 deletions(-) diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index 7616a788016..78263df0550 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -368,52 +368,17 @@ void R_igraph_attribute_clean_preserve_list() { } } - - -static SEXP R_igraph_attribute_protected=0; -static long int R_igraph_attribute_protected_size=0; - -void R_igraph_attribute_protected_destroy(void *dummy) { - R_ReleaseObject(R_igraph_attribute_protected); - R_igraph_attribute_protected=0; - R_igraph_attribute_protected_size=0; -} - int R_igraph_attribute_init(igraph_t *graph, igraph_vector_ptr_t *attr) { SEXP result, names, gal; long int i; long int attrno; int px = 0; - if (R_igraph_attribute_protected) { - long int ll=GET_LENGTH(R_igraph_attribute_protected); - if (ll == R_igraph_attribute_protected_size) { - SEXP newl = NEW_LIST(2*ll); - long int i; - PROTECT(newl); px++; - for (i=0; i 1) { SEXP newattr = Rf_duplicate(attr); - if (R_igraph_attribute_protected) { - PROTECT(newattr); px++; - } else { - R_igraph_attribute_add_to_preserve_list(newattr); - } + R_igraph_attribute_add_to_preserve_list(newattr); REAL(VECTOR_ELT(attr, 0))[1] -= 1; REAL(VECTOR_ELT(newattr, 0))[0] = 0; REAL(VECTOR_ELT(newattr, 0))[1] = 1; - if (R_igraph_attribute_protected) { - long int pos, alen=LENGTH(VECTOR_ELT(attr, 0)); - if (alen == 4) { - pos=REAL(VECTOR_ELT(attr, 0))[3]; - SET_VECTOR_ELT(R_igraph_attribute_protected, pos, newattr); - } else { - SEXP tmp=PROTECT(NEW_NUMERIC(4)); px++; - REAL(tmp)[0] = REAL(VECTOR_ELT(attr, 0))[0]; - REAL(tmp)[1] = REAL(VECTOR_ELT(attr, 0))[1]; - REAL(tmp)[2] = REAL(VECTOR_ELT(attr, 0))[2]; - pos = REAL(tmp)[3] = R_igraph_attribute_protected_size; - R_igraph_attribute_protected_size += 1; - SET_VECTOR_ELT(newattr, 0, tmp); - } - SET_VECTOR_ELT(R_igraph_attribute_protected, pos, newattr); - } attr=newgraph->attr=newattr; } @@ -906,35 +828,12 @@ int R_igraph_attribute_permute_vertices(const igraph_t *graph, SEXP R_igraph_attribute_add_edges_dup(SEXP attr) { SEXP newattr=Rf_duplicate(attr); - int px = 0; - - if (R_igraph_attribute_protected) { - PROTECT(newattr); px++; - } else { - R_igraph_attribute_add_to_preserve_list(newattr); - } + R_igraph_attribute_add_to_preserve_list(newattr); REAL(VECTOR_ELT(attr, 0))[1] -= 1; REAL(VECTOR_ELT(newattr, 0))[0] = 0; REAL(VECTOR_ELT(newattr, 0))[1] = 1; - if (R_igraph_attribute_protected) { - long int pos, alen=LENGTH(VECTOR_ELT(attr, 0)); - if (alen == 4) { - pos=REAL(VECTOR_ELT(attr, 0))[3]; - SET_VECTOR_ELT(R_igraph_attribute_protected, pos, newattr); - } else { - SEXP tmp=PROTECT(NEW_NUMERIC(4)); px++; - REAL(tmp)[0] = REAL(VECTOR_ELT(attr, 0))[0]; - REAL(tmp)[1] = REAL(VECTOR_ELT(attr, 0))[1]; - REAL(tmp)[2] = REAL(VECTOR_ELT(attr, 0))[2]; - pos = REAL(tmp)[3] = R_igraph_attribute_protected_size; - R_igraph_attribute_protected_size += 1; - SET_VECTOR_ELT(newattr, 0, tmp); - } - SET_VECTOR_ELT(R_igraph_attribute_protected, pos, newattr); - } - UNPROTECT(px); return newattr; } @@ -1171,30 +1070,10 @@ int R_igraph_attribute_permute_edges_same(const igraph_t *graph, /* We copy if we need to */ if (REAL(VECTOR_ELT(attr, 0))[0]+REAL(VECTOR_ELT(attr, 0))[1] > 1) { SEXP newattr=Rf_duplicate(attr); - if (R_igraph_attribute_protected) { - PROTECT(newattr); px++; - } else { - R_igraph_attribute_add_to_preserve_list(newattr); - } + R_igraph_attribute_add_to_preserve_list(newattr); REAL(VECTOR_ELT(attr, 0))[1] -= 1; REAL(VECTOR_ELT(newattr, 0))[0] = 0; REAL(VECTOR_ELT(newattr, 0))[1] = 1; - if (R_igraph_attribute_protected) { - long int pos, alen=LENGTH(VECTOR_ELT(attr, 0)); - if (alen == 4) { - pos=REAL(VECTOR_ELT(attr, 0))[3]; - SET_VECTOR_ELT(R_igraph_attribute_protected, pos, newattr); - } else { - SEXP tmp=PROTECT(NEW_NUMERIC(4)); px++; - REAL(tmp)[0] = REAL(VECTOR_ELT(attr, 0))[0]; - REAL(tmp)[1] = REAL(VECTOR_ELT(attr, 0))[1]; - REAL(tmp)[2] = REAL(VECTOR_ELT(attr, 0))[2]; - pos = REAL(tmp)[3] = R_igraph_attribute_protected_size; - R_igraph_attribute_protected_size += 1; - SET_VECTOR_ELT(newattr, 0, tmp); - } - SET_VECTOR_ELT(R_igraph_attribute_protected, pos, newattr); - } attr=newgraph->attr=newattr; } From 56fca59a6a1acbe01b9d70c39a01c2c72872508e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Jul 2023 00:55:03 +0200 Subject: [PATCH 6/7] Avoid reference counting --- src/rinterface_extra.c | 99 ++++++++---------------------------------- 1 file changed, 17 insertions(+), 82 deletions(-) diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index 78263df0550..c61b5cc2f61 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -441,8 +441,7 @@ int R_igraph_attribute_init(igraph_t *graph, igraph_vector_ptr_t *attr) { } void R_igraph_attribute_destroy(igraph_t *graph) { - SEXP attr=graph->attr; - REAL(VECTOR_ELT(attr, 0))[1] -= 1; /* refcount for igraph_t */ + // Owned by the R graph object, will be garbage-collected graph->attr=0; } @@ -457,7 +456,6 @@ int R_igraph_attribute_copy(igraph_t *to, const igraph_t *from, SEXP fromattr=from->attr; if (ga && va && ea) { to->attr=from->attr; - REAL(VECTOR_ELT(fromattr, 0))[1] += 1; /* refcount only */ } else { R_igraph_attribute_init(to,0); /* Sets up many things */ SEXP toattr=to->attr; @@ -577,11 +575,6 @@ void R_igraph_attribute_add_vertices_append(SEXP val, long int nv, SEXP R_igraph_attribute_add_vertices_dup(SEXP attr) { SEXP newattr=Rf_duplicate(attr); R_igraph_attribute_add_to_preserve_list(newattr); - - REAL(VECTOR_ELT(attr, 0))[1] -= 1; - REAL(VECTOR_ELT(newattr, 0))[0] = 0; - REAL(VECTOR_ELT(newattr, 0))[1] = 1; - return newattr; } @@ -593,10 +586,8 @@ int R_igraph_attribute_add_vertices(igraph_t *graph, long int nv, long int valno, i, origlen, nattrno, newattrs; int px = 0; - if (REAL(VECTOR_ELT(attr, 0))[0]+REAL(VECTOR_ELT(attr, 0))[1] > 1) { - SEXP newattr = PROTECT(R_igraph_attribute_add_vertices_dup(attr)); px++; - attr=graph->attr=newattr; - } + SEXP newattr = PROTECT(R_igraph_attribute_add_vertices_dup(attr)); px++; + attr=graph->attr=newattr; val=VECTOR_ELT(attr, 2); valno=GET_LENGTH(val); @@ -664,17 +655,9 @@ int R_igraph_attribute_add_vertices(igraph_t *graph, long int nv, /* SEXP attr=graph->attr; */ /* SEXP eal, val; */ /* long int valno, ealno, i; */ -/* if (REAL(VECTOR_ELT(attr, 0))[0]+REAL(VECTOR_ELT(attr, 0))[1] > 1) { */ -/* SEXP newattr; */ -/* PROTECT(newattr=Rf_duplicate(attr)); */ -/* REAL(VECTOR_ELT(attr, 0))[1] -= 1; */ -/* if (REAL(VECTOR_ELT(attr, 0))[1] == 0) { */ -/* R_ReleaseObject(attr); */ -/* } */ -/* REAL(VECTOR_ELT(newattr, 0))[0] = 0; */ -/* REAL(VECTOR_ELT(newattr, 0))[1] = 1; */ -/* attr=graph->attr=newattr; */ -/* } */ +/* SEXP newattr; */ +/* PROTECT(newattr=Rf_duplicate(attr)); */ +/* attr=graph->attr=newattr; */ /* /\* Vertices *\/ */ /* val=VECTOR_ELT(attr, 2); */ @@ -734,15 +717,9 @@ int R_igraph_attribute_permute_vertices_same(const igraph_t *graph, SEXP ss; int px = 0; - /* We copy if we need to */ - if (REAL(VECTOR_ELT(attr, 0))[0]+REAL(VECTOR_ELT(attr, 0))[1] > 1) { - SEXP newattr = Rf_duplicate(attr); - R_igraph_attribute_add_to_preserve_list(newattr); - REAL(VECTOR_ELT(attr, 0))[1] -= 1; - REAL(VECTOR_ELT(newattr, 0))[0] = 0; - REAL(VECTOR_ELT(newattr, 0))[1] = 1; - attr=newgraph->attr=newattr; - } + SEXP newattr = Rf_duplicate(attr); + R_igraph_attribute_add_to_preserve_list(newattr); + attr=newgraph->attr=newattr; val=VECTOR_ELT(attr,2); valno=GET_LENGTH(val); @@ -829,11 +806,6 @@ int R_igraph_attribute_permute_vertices(const igraph_t *graph, SEXP R_igraph_attribute_add_edges_dup(SEXP attr) { SEXP newattr=Rf_duplicate(attr); R_igraph_attribute_add_to_preserve_list(newattr); - - REAL(VECTOR_ELT(attr, 0))[1] -= 1; - REAL(VECTOR_ELT(newattr, 0))[0] = 0; - REAL(VECTOR_ELT(newattr, 0))[1] = 1; - return newattr; } @@ -952,10 +924,8 @@ int R_igraph_attribute_add_edges(igraph_t *graph, if (igraph_vector_init(&news, 0)) Rf_error("Out of memory"); IGRAPH_FINALLY(igraph_vector_destroy, &news); - if (REAL(VECTOR_ELT(attr, 0))[0] + REAL(VECTOR_ELT(attr, 0))[1] > 1) { - SEXP newattr = PROTECT(R_igraph_attribute_add_edges_dup(attr)); px++; - attr=graph->attr=newattr; - } + SEXP newattr = PROTECT(R_igraph_attribute_add_edges_dup(attr)); px++; + attr=graph->attr=newattr; eal=VECTOR_ELT(attr, 3); ealno=GET_LENGTH(eal); @@ -1020,17 +990,9 @@ int R_igraph_attribute_add_edges(igraph_t *graph, /* SEXP attr=graph->attr; */ /* SEXP eal; */ /* long int ealno, i; */ -/* if (REAL(VECTOR_ELT(attr, 0))[0]+REAL(VECTOR_ELT(attr, 0))[1] > 1) { */ -/* SEXP newattr; */ -/* PROTECT(newattr=Rf_duplicate(attr)); */ -/* REAL(VECTOR_ELT(attr, 0))[1] -= 1; */ -/* if (REAL(VECTOR_ELT(attr, 0))[1] == 0) { */ -/* R_ReleaseObject(attr); */ -/* } */ -/* REAL(VECTOR_ELT(newattr, 0))[0] = 0; */ -/* REAL(VECTOR_ELT(newattr, 0))[1] = 1; */ -/* attr=graph->attr=newattr; */ -/* } */ +/* SEXP newattr; */ +/* PROTECT(newattr=Rf_duplicate(attr)); */ +/* attr=graph->attr=newattr; */ /* eal=VECTOR_ELT(attr, 3); */ /* ealno=GET_LENGTH(eal); */ @@ -1067,15 +1029,9 @@ int R_igraph_attribute_permute_edges_same(const igraph_t *graph, SEXP ss; int px = 0; - /* We copy if we need to */ - if (REAL(VECTOR_ELT(attr, 0))[0]+REAL(VECTOR_ELT(attr, 0))[1] > 1) { - SEXP newattr=Rf_duplicate(attr); - R_igraph_attribute_add_to_preserve_list(newattr); - REAL(VECTOR_ELT(attr, 0))[1] -= 1; - REAL(VECTOR_ELT(newattr, 0))[0] = 0; - REAL(VECTOR_ELT(newattr, 0))[1] = 1; - attr=newgraph->attr=newattr; - } + SEXP newattr=Rf_duplicate(attr); + R_igraph_attribute_add_to_preserve_list(newattr); + attr=newgraph->attr=newattr; eal=VECTOR_ELT(attr,3); ealno=GET_LENGTH(eal); @@ -1960,10 +1916,6 @@ int R_igraph_attribute_combine_vertices(const igraph_t *graph, } } - /* Not safe to UNPROTECT attributes */ - REAL(VECTOR_ELT(attr, 0))[2]=0; - REAL(VECTOR_ELT(toattr, 0))[2]=0; - PROTECT(res=NEW_LIST(keepno)); px++; PROTECT(newnames=NEW_CHARACTER(keepno)); px++; for (i=0, j=0; iattr); - REAL(VECTOR_ELT(graph->attr, 0))[0] += 1; /* Environment for vertex/edge seqs */ SET_VECTOR_ELT(result, igraph_t_idx_env, R_NilValue); @@ -3605,8 +3544,6 @@ int R_SEXP_to_igraph(SEXP graph, igraph_t *res) { R_igraph_get_is(graph, &res->is); /* attributes */ - REAL(VECTOR_ELT(VECTOR_ELT(graph, igraph_t_idx_attr), 0))[0] = 1; /* R objects refcount */ - REAL(VECTOR_ELT(VECTOR_ELT(graph, igraph_t_idx_attr), 0))[1] = 0; /* igraph_t objects */ res->attr=VECTOR_ELT(graph, igraph_t_idx_attr); return 0; @@ -3637,8 +3574,6 @@ int R_SEXP_to_igraph_copy(SEXP graph, igraph_t *res) { igraph_vector_copy(&res->is, &is); /* attributes */ - REAL(VECTOR_ELT(VECTOR_ELT(graph, igraph_t_idx_attr), 0))[0] = 1; /* R objects */ - REAL(VECTOR_ELT(VECTOR_ELT(graph, igraph_t_idx_attr), 0))[1] = 1; /* igraph_t objects */ res->attr=VECTOR_ELT(graph, igraph_t_idx_attr); return 0; From c68b9be10047dfcb56647a246e5269dc898165da Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Kirill=20M=C3=BCller?= Date: Mon, 3 Jul 2023 01:05:28 +0200 Subject: [PATCH 7/7] Breaking: Remove reference counting --- src/rinterface_extra.c | 4 ---- 1 file changed, 4 deletions(-) diff --git a/src/rinterface_extra.c b/src/rinterface_extra.c index c61b5cc2f61..9535ae2a9c2 100644 --- a/src/rinterface_extra.c +++ b/src/rinterface_extra.c @@ -378,10 +378,6 @@ int R_igraph_attribute_init(igraph_t *graph, igraph_vector_ptr_t *attr) { // The "preserve list" Will be cleared with the next invocation of IGRAPH_R_CHECK(). // Adding to that list ensures that the attributes aren't GC-ed prematurely. R_igraph_attribute_add_to_preserve_list(result); - SET_VECTOR_ELT(result, 0, NEW_NUMERIC(3)); - REAL(VECTOR_ELT(result, 0))[0]=0; /* R objects */ - REAL(VECTOR_ELT(result, 0))[1]=1; /* igraph_t objects */ - REAL(VECTOR_ELT(result, 0))[2]=1; /* whether the graph is safe */ for (i=1; i<3; i++) { SET_VECTOR_ELT(result, i+1, NEW_LIST(0)); /* gal, val, eal */ }