refactor: add assert_named_list() helper to assert the value is a named list with no duplicate names

Author: maelle

R/attributes.R

@@ -349,10 +349,7 @@ graph.attributes <- function(graph) {
 #' @export
 "graph.attributes<-" <- function(graph, value) {
   ensure_igraph(graph)
-  if (!is.list(value) || (length(value) > 0 && is.null(names(value))) ||
-    any(names(value) == "") || any(duplicated(names(value)))) {
-    stop("Value must be a named list with unique names")
-  }
+  assert_named_list(value)
 
   .Call(R_igraph_mybracket2_set, graph, igraph_t_idx_attr, igraph_attr_idx_graph, value)
 }
@@ -535,10 +532,8 @@ vertex.attributes <- function(graph, index = V(graph)) {
 "vertex.attributes<-" <- function(graph, index = V(graph), value) {
   ensure_igraph(graph)
 
-  if (!is.list(value) || (length(value) > 0 && is.null(names(value))) ||
-    any(names(value) == "") || any(duplicated(names(value)))) {
-    stop("Value must be a named list with unique names")
-  }
+  assert_named_list(value)
+
   if (any(sapply(value, length) != length(index))) {
     stop("Invalid attribute value length, must match number of vertices")
   }
@@ -744,10 +739,8 @@ edge.attributes <- function(graph, index = E(graph)) {
 "edge.attributes<-" <- function(graph, index = E(graph), value) {
   ensure_igraph(graph)
 
-  if (!is.list(value) || (length(value) > 0 && is.null(names(value))) ||
-    any(names(value) == "") || any(duplicated(names(value)))) {
-    stop("Value must be a named list with unique names")
-  }
+  assert_named_list(value)
+
   if (any(sapply(value, length) != length(index))) {
     stop("Invalid attribute value length, must match number of edges")
   }
@@ -1189,3 +1182,20 @@ NULL
 `$<-.igraph` <- function(x, name, value) {
   set_graph_attr(x, name, value)
 }
+
+assert_named_list <- function(value) {
+  error_msg <- "{.arg value} must be a named list with unique names"
+
+  if (!is.list(value)) {
+    rlang::abort(error_msg)
+  }
+
+  if (length(value) == 0) {
+    return()
+  }
+
+  if (!rlang::is_named(value) || anyDuplicated(names(value)) > 0) {
+
+    rlang::abort(error_msg)
+  }
+}

tests/testthat/test-attributes.R

@@ -342,3 +342,20 @@ test_that("edge attributes are destroyed when the graph is destroyed", {
   gc()
   expect_true(finalized)
 })
+
+test_that("assert_named_list() works", {
+  not_list <- 1:10
+  expect_error(assert_named_list(not_list), "named list")
+
+  expect_silent(assert_named_list(list()))
+
+  unnamed_list <- as.list(1:10)
+  expect_error(assert_named_list(unnamed_list), "named list")
+
+  empty_name <- rlang::set_names(unnamed_list, c(as.character(1:9), ""))
+  expect_error(assert_named_list(empty_name), "named list")
+
+  dups <- rlang::set_names(unnamed_list, rep("bla", 10))
+  expect_error(assert_named_list(dups), "named list")
+
+})