fix: error call in with_vertex_()/with_edge_() should report make_(), not internal helper (#2609)

Co-authored-by: copilot-swe-agent[bot] <198982749+Copilot@users.noreply.github.com>
Co-authored-by: krlmlr <1741643+krlmlr@users.noreply.github.com>
Co-authored-by: Copilot <Copilot@users.noreply.github.com>

Author: 3 people

R/attributes.R

@@ -527,20 +527,23 @@ vertex_attr <- function(graph, name, index = V(graph)) {
 #' g
 #' plot(g)
 set_vertex_attr <- function(graph, name, index = V(graph), value) {
+  call <- rlang::current_env()
   check_string(name)
   if (is_complete_iterator(index)) {
     return(i_set_vertex_attr(
       graph = graph,
       name = name,
       value = value,
-      check = FALSE
+      check = FALSE,
+      call = call
     ))
   } else {
     return(i_set_vertex_attr(
       graph = graph,
       name = name,
       index = index,
-      value = value
+      value = value,
+      call = call
     ))
   }
   graph
@@ -566,6 +569,7 @@ set_vertex_attr <- function(graph, name, index = V(graph), value) {
 #' # to set an attribute named "index" use `:=`
 #' set_vertex_attrs(g, color = "blue", index := 10, name = LETTERS[1:10])
 set_vertex_attrs <- function(graph, ..., index = V(graph)) {
+  call <- rlang::current_env()
   dots <- rlang::list2(...)
 
   if (!rlang::is_named(dots)) {
@@ -578,7 +582,8 @@ set_vertex_attrs <- function(graph, ..., index = V(graph)) {
       graph,
       name = attr_name,
       index = index,
-      value = attr_value
+      value = attr_value,
+      call = call
     )
   }
 
@@ -590,7 +595,8 @@ i_set_vertex_attr <- function(
   name,
   index = V(graph),
   value,
-  check = TRUE
+  check = TRUE,
+  call = rlang::caller_env()
 ) {
   ensure_igraph(graph)
   check_string(name)
@@ -632,7 +638,8 @@ i_set_vertex_attr <- function(
       value_in <- unname(value)
     } else {
       cli::cli_abort(
-        "Length of new attribute value must be {if (length(index) != 1) '1 or '}{length(index)}, the number of target vertices, not {length(value)}."
+        "Length of new attribute value must be {if (length(index) != 1) '1 or '}{length(index)}, the number of target vertices, not {length(value)}.",
+        call = call
       )
     }
 
@@ -830,11 +837,24 @@ edge_attr <- function(graph, name, index = E(graph)) {
 #' g
 #' plot(g)
 set_edge_attr <- function(graph, name, index = E(graph), value) {
+  call <- rlang::current_env()
   check_string(name)
   if (is_complete_iterator(index)) {
-    i_set_edge_attr(graph = graph, name = name, value = value, check = FALSE)
+    i_set_edge_attr(
+      graph = graph,
+      name = name,
+      value = value,
+      check = FALSE,
+      call = call
+    )
   } else {
-    i_set_edge_attr(graph = graph, name = name, index = index, value = value)
+    i_set_edge_attr(
+      graph = graph,
+      name = name,
+      index = index,
+      value = value,
+      call = call
+    )
   }
 }
 
@@ -843,7 +863,8 @@ i_set_edge_attr <- function(
   name,
   index = E(graph),
   value,
-  check = TRUE
+  check = TRUE,
+  call = rlang::caller_env()
 ) {
   ensure_igraph(graph)
   check_string(name)
@@ -885,7 +906,8 @@ i_set_edge_attr <- function(
       value_in <- unname(value)
     } else {
       cli::cli_abort(
-        "Length of new attribute value must be {if (length(index) != 1) '1 or '}{length(index)}, the number of target edges, not {length(value)}."
+        "Length of new attribute value must be {if (length(index) != 1) '1 or '}{length(index)}, the number of target edges, not {length(value)}.",
+        call = call
       )
     }
 

R/make.R

@@ -841,7 +841,7 @@ graph.atlas <- function(n) {
 #' @param mods The modifiers to apply
 #' @return The modified graph
 #' @dev
-.apply_modifiers <- function(graph, mods) {
+.apply_modifiers <- function(graph, mods, call = rlang::caller_env()) {
   for (m in mods) {
     if (m$id == "without_attr") {
       ## TODO: speed this up
@@ -870,7 +870,7 @@ graph.atlas <- function(n) {
         n <- names(m$args)[a]
         v <- m$args[[a]]
         stopifnot(!is.null(n))
-        graph <- set_vertex_attr(graph, n, value = v)
+        graph <- i_set_vertex_attr(graph, n, value = v, call = call)
       }
     } else if (m$id == "with_edge_") {
       m$args <- lapply(m$args, eval)
@@ -879,7 +879,7 @@ graph.atlas <- function(n) {
         n <- names(m$args)[a]
         v <- m$args[[a]]
         stopifnot(!is.null(n))
-        graph <- set_edge_attr(graph, n, value = v)
+        graph <- i_set_edge_attr(graph, n, value = v, call = call)
       }
     } else if (m$id == "with_graph_") {
       m$args <- lapply(m$args, eval)
@@ -949,7 +949,7 @@ make_ <- function(...) {
   }
 
   res <- do_call(cons$fun, cons_args, extracted$args)
-  .apply_modifiers(res, extracted$mods)
+  .apply_modifiers(res, extracted$mods, call = rlang::current_env())
 }
 
 #' Sample from a random graph model

tests/testthat/_snaps/attributes.md

@@ -3,31 +3,31 @@
     Code
       make_(from_literal(A - A:B:C, B - A:B:C), with_vertex_(color = 1:2))
     Condition
-      Error in `i_set_vertex_attr()`:
+      Error in `make_()`:
       ! Length of new attribute value must be 1 or 3, the number of target vertices, not 2.
 
 # with_edge_
 
     Code
       make_(from_literal(A - A:B:C, B - A:B:C), with_edge_(color = 1:2))
     Condition
-      Error in `i_set_edge_attr()`:
+      Error in `make_()`:
       ! Length of new attribute value must be 1 or 3, the number of target edges, not 2.
 
 # error messages work
 
     Code
       set_vertex_attr(g, "test", value = c(1, 2))
     Condition
-      Error in `i_set_vertex_attr()`:
+      Error in `set_vertex_attr()`:
       ! Length of new attribute value must be 1 or 5, the number of target vertices, not 2.
 
 ---
 
     Code
       set_edge_attr(g, "test", value = c(1, 2))
     Condition
-      Error in `i_set_edge_attr()`:
+      Error in `set_edge_attr()`:
       ! Length of new attribute value must be 1 or 10, the number of target edges, not 2.
 
 ---