refactor: standardize error snapshot testing with expect_snapshot_igraph_error()

src/rinterface_extra.c

@@ -7760,13 +7760,6 @@ SEXP Rx_igraph_create_bipartite(SEXP types, SEXP edges, SEXP directed) {
   return R_igraph_create_bipartite(types, edges, directed);
 }
 
-/* Test function to verify error formatting with file and line information */
-attribute_visible SEXP Rx_igraph_test_error_with_source(void) {
-  igraph_errorf("Test error message for verifying source location formatting",
-                __FILE__, __LINE__, IGRAPH_EINVAL);
-  return R_NilValue;
-}
-
 SEXP Rx_igraph_finalizer(void) {
   return R_igraph_finalizer();
 }

src/sources-glue-c.mk

@@ -1 +1 @@
-GLUE_C_SOURCES=rcallback.o rinterface.o rinterface_extra.o rrandom.o uuid.o
+GLUE_C_SOURCES=rcallback.o rinterface.o rinterface_extra.o rrandom.o test_error_with_source.o uuid.o

src/test_error_with_source.c

@@ -0,0 +1,33 @@
+/* -*- mode: C -*-  */
+/*
+   IGraph library R interface.
+   Copyright (C) 2013  Gabor Csardi <csardi.gabor@gmail.com>
+   334 Harvard street, Cambridge, MA 02139 USA
+
+   This program is free software; you can redistribute it and/or modify
+   it under the terms of the GNU General Public License as published by
+   the Free Software Foundation; either version 2 of the License, or
+   (at your option) any later version.
+
+   This program is distributed in the hope that it will be useful,
+   but WITHOUT ANY WARRANTY; without even the implied warranty of
+   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+   GNU General Public License for more details.
+
+   You should have received a copy of the GNU General Public License
+   along with this program; if not, write to the Free Software
+   Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+   02110-1301 USA
+
+*/
+
+#include "rinterface.h"
+
+#include <R_ext/Visibility.h>
+
+/* Test function to verify error formatting with file and line information */
+attribute_visible SEXP Rx_igraph_test_error_with_source(void) {
+  igraph_errorf("Test error message for verifying source location formatting",
+                __FILE__, __LINE__, IGRAPH_EINVAL);
+  return R_NilValue;
+}

src/test_error_with_source.dd

@@ -0,0 +1,4 @@
+# Generated by deps.mk, do not edit by hand and do not add dependencies to system headers
+test_error_with_source.o: \
+  rinterface.h \
+  test_error_with_source.c \

tests/testthat/_snaps/error-formatting.md

@@ -5,5 +5,5 @@
     Condition
       Error in `test_error_with_source()`:
       ! Test error message for verifying source location formatting. Invalid value
-      Source: rinterface_extra.c:7766
+      Source: test_error_with_source.c:31
 

tests/testthat/test-adjacency.R

@@ -787,7 +787,7 @@ test_that("sparse/dense matrices min/max/plus", {
 
 test_that("graph_from_adjacency_matrix errors for NAs", {
   A <- matrix(c(1, 1, NA, 1), 2, 2)
-  expect_snapshot(graph_from_adjacency_matrix(A), error = TRUE)
+  expect_snapshot_igraph_error(graph_from_adjacency_matrix(A))
 })
 
 test_that("graph_from_adjacency_matrix handles add.colnames and add.rownames = FALSE correctly", {

tests/testthat/test-attributes.R

@@ -436,13 +436,13 @@ test_that("adding and removing attributes", {
 
 test_that("error messages work", {
   g <- make_full_graph(5)
-  expect_snapshot(set_vertex_attr(g, "test", value = c(1, 2)), error = TRUE)
-  expect_snapshot(set_edge_attr(g, "test", value = c(1, 2)), error = TRUE)
-  expect_snapshot(delete_graph_attr(g, "a"), error = TRUE)
-  expect_snapshot(delete_vertex_attr(g, "a"), error = TRUE)
-  expect_snapshot(delete_edge_attr(g, "a"), error = TRUE)
-  expect_snapshot(assert_named_list("a"), error = TRUE)
-  expect_snapshot(assert_named_list(list("a", "b")), error = TRUE)
+  expect_snapshot_igraph_error(set_vertex_attr(g, "test", value = c(1, 2)))
+  expect_snapshot_igraph_error(set_edge_attr(g, "test", value = c(1, 2)))
+  expect_snapshot_igraph_error(delete_graph_attr(g, "a"))
+  expect_snapshot_igraph_error(delete_vertex_attr(g, "a"))
+  expect_snapshot_igraph_error(delete_edge_attr(g, "a"))
+  expect_snapshot_igraph_error(assert_named_list("a"))
+  expect_snapshot_igraph_error(assert_named_list(list("a", "b")))
 })
 
 test_that("empty returns work", {
@@ -465,7 +465,7 @@ test_that("assign data.frame attributes works", {
 
 test_that("good error message when not using character", {
   ring <- graph_from_literal(A - B - C - D - E - F - G - A)
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     set_graph_attr(ring, 1, 1)
   })
 })
@@ -476,7 +476,7 @@ test_that("set_vertex_attrs() works", {
   expect_equal(V(g)$color, rep("blue", vcount(g)))
   expect_equal(V(g)$size, rep(10, vcount(g)))
   expect_equal(V(g)$name, LETTERS[1:10])
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     set_vertex_attrs(g)
   })
 

tests/testthat/test-centrality.R

@@ -848,7 +848,7 @@ test_that("arpack() errors well", {
   expect_snapshot_igraph_error({
     arpack(f, options = list(nev = 2, ncv = 4), sym = TRUE)
   })
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     arpack(
       f,
       options = list(unknown_thing1 = 2, unknown_thing2 = 4),

tests/testthat/test-conversion.R

@@ -142,10 +142,10 @@ test_that("as_adjacency_matrix() works -- sparse + not both", {
 
 test_that("as_adjacency_matrix() errors well -- sparse", {
   g <- make_graph(c(1, 2, 2, 1, 2, 2, 3, 3, 3, 3, 3, 4, 4, 2, 4, 2, 4, 2), directed = TRUE)
-  expect_snapshot(as_adjacency_matrix(g, attr = "bla"), error = TRUE)
+  expect_snapshot_igraph_error(as_adjacency_matrix(g, attr = "bla"))
 
   E(g)$bla <- letters[1:ecount(g)]
-  expect_snapshot(as_adjacency_matrix(g, attr = "bla"), error = TRUE)
+  expect_snapshot_igraph_error(as_adjacency_matrix(g, attr = "bla"))
 })
 
 test_that("as_adjacency_matrix() works -- sparse undirected", {
@@ -197,15 +197,13 @@ test_that("as_adjacency_matrix() works -- dense", {
 
 test_that("as_adjacency_matrix() errors well -- dense", {
   g <- make_graph(c(1, 2, 2, 1, 2, 2, 3, 3, 3, 3, 3, 4, 4, 2, 4, 2, 4, 2), directed = TRUE)
-  expect_snapshot(
-    as_adjacency_matrix(g, attr = "bla", sparse = FALSE),
-    error = TRUE
+  expect_snapshot_igraph_error(
+    as_adjacency_matrix(g, attr = "bla", sparse = FALSE)
   )
 
   E(g)$bla <- letters[1:ecount(g)]
-  expect_snapshot(
-    as_adjacency_matrix(g, attr = "bla", sparse = FALSE),
-    error = TRUE
+  expect_snapshot_igraph_error(
+    as_adjacency_matrix(g, attr = "bla", sparse = FALSE)
   )
 })
 
@@ -679,7 +677,7 @@ test_that("edge names work", {
 
 test_that("graph_from_edgelist errors for NAs", {
   A <- matrix(c(1, 2, NA, 1), 2, 2)
-  expect_snapshot(graph_from_edgelist(A), error = TRUE)
+  expect_snapshot_igraph_error(graph_from_edgelist(A))
 })
 
 test_that("graph_from_data_frame works with factors", {

tests/testthat/test-error-formatting.R

@@ -1,4 +1,8 @@
 test_that("error messages include source file and line information", {
+  # Note: We use expect_snapshot(error = TRUE) here instead of
+  # expect_snapshot_igraph_error() because we need to test the actual
+  # line numbers in the error message, which expect_snapshot_igraph_error()
+  # would transform to "xx".
   expect_snapshot(
     error = TRUE,
     {

tests/testthat/test-fit.R

@@ -28,7 +28,7 @@ test_that("fit_power_law() works", {
 })
 
 test_that("fit_power_law() errors well", {
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     fit_power_law(1, implementation = "R.mle")
   })
 })

tests/testthat/test-flow.R

@@ -98,15 +98,13 @@ test_that("st_cuts() works", {
 test_that("st_cuts errors work", {
   g_path <- graph_from_literal(a -+ b -+ c -+ d -+ e)
 
-  expect_snapshot(st_cuts(g_path, source = "a", target = NULL), error = TRUE)
-  expect_snapshot(st_cuts(g_path, source = NULL, target = "a"), error = TRUE)
-  expect_snapshot(
-    st_min_cuts(g_path, source = "a", target = NULL),
-    error = TRUE
+  expect_snapshot_igraph_error(st_cuts(g_path, source = "a", target = NULL))
+  expect_snapshot_igraph_error(st_cuts(g_path, source = NULL, target = "a"))
+  expect_snapshot_igraph_error(
+    st_min_cuts(g_path, source = "a", target = NULL)
   )
-  expect_snapshot(
-    st_min_cuts(g_path, source = NULL, target = "a"),
-    error = TRUE
+  expect_snapshot_igraph_error(
+    st_min_cuts(g_path, source = NULL, target = "a")
   )
 })
 
@@ -142,7 +140,7 @@ test_that("vertex_connectivity() works", {
 
 test_that("vertex_connectivity error works", {
   g_path <- make_ring(5, circular = FALSE)
-  expect_snapshot(vertex_connectivity(g_path, source = 1), error = TRUE)
+  expect_snapshot_igraph_error(vertex_connectivity(g_path, source = 1))
 })
 
 test_that("edge_connectivity works", {
@@ -179,7 +177,7 @@ test_that("edge_connectivity works -- names", {
 
 test_that("edge_connectivity error works", {
   g_path <- make_ring(5, circular = FALSE)
-  expect_snapshot(edge_connectivity(g_path, source = 1), error = TRUE)
+  expect_snapshot_igraph_error(edge_connectivity(g_path, source = 1))
 })
 
 test_that("edge_disjoint_paths works", {
@@ -192,13 +190,11 @@ test_that("edge_disjoint_paths works", {
 
 test_that("edge_disjoint_paths error works", {
   g_path <- make_ring(5, circular = FALSE)
-  expect_snapshot(
-    edge_disjoint_paths(g_path, source = 1, target = NULL),
-    error = TRUE
+  expect_snapshot_igraph_error(
+    edge_disjoint_paths(g_path, source = 1, target = NULL)
   )
-  expect_snapshot(
-    edge_disjoint_paths(g_path, source = NULL, target = 1),
-    error = TRUE
+  expect_snapshot_igraph_error(
+    edge_disjoint_paths(g_path, source = NULL, target = 1)
   )
 })
 
@@ -212,7 +208,7 @@ test_that("vertex_disjoint_paths works", {
 
 test_that("vertex_disjoint_paths error works", {
   g_path <- make_ring(5, circular = FALSE)
-  expect_snapshot(vertex_disjoint_paths(g_path, source = 1), error = TRUE)
+  expect_snapshot_igraph_error(vertex_disjoint_paths(g_path, source = 1))
 })
 
 test_that("adhesion works", {
@@ -225,7 +221,7 @@ test_that("adhesion works", {
 
 test_that("vertex_disjoint_paths error works", {
   g_path <- make_ring(5, circular = FALSE)
-  expect_snapshot(vertex_disjoint_paths(g_path, source = 1), error = TRUE)
+  expect_snapshot_igraph_error(vertex_disjoint_paths(g_path, source = 1))
 })
 
 
@@ -252,8 +248,8 @@ test_that("dominator_tree errors work", {
     matrix(c(1, 2, 2, 3, 3, 4, 2, 5, 5, 6), byrow = TRUE, ncol = 2),
     directed = TRUE
   )
-  expect_snapshot(dominator_tree(g_tree), error = TRUE)
-  expect_snapshot(dominator_tree(g_tree, root = NULL), error = TRUE)
+  expect_snapshot_igraph_error(dominator_tree(g_tree))
+  expect_snapshot_igraph_error(dominator_tree(g_tree, root = NULL))
 })
 
 test_that("dominator_tree works -- legacy", {

tests/testthat/test-foreign.R

@@ -49,17 +49,17 @@ test_that("reading graph, unused argument", {
   lgl_path <- withr::local_tempfile(pattern = "testfile", fileext = ".lgl")
   g <- make_graph(c(1, 2, 2, 3))
   write_graph(g, lgl_path, "lgl")
-  expect_snapshot(error = TRUE, read_graph(lgl_path, "lgl", useless = 1))
+  expect_snapshot_igraph_error(read_graph(lgl_path, "lgl", useless = 1))
 })
 
 test_that("reading graph in unsupported format", {
-  expect_snapshot(error = TRUE, read_graph("bla", format = "blop"))
+  expect_snapshot_igraph_error(read_graph("bla", format = "blop"))
 })
 
 test_that("writing graph in unsupported format", {
   g <- make_graph(c(1, 2, 2, 3))
   file <- withr::local_tempfile()
-  expect_snapshot(error = TRUE, write_graph(g, file, format = "blop"))
+  expect_snapshot_igraph_error(write_graph(g, file, format = "blop"))
 })
 
 test_that("graph_from_graphdb works", {
@@ -72,13 +72,11 @@ test_that("graph_from_graphdb works", {
   skip_if(Sys.getenv("R_SANITIZER") == "true")
 
   expect_snapshot(g <- graph_from_graphdb(nodes = 1000))
-  expect_snapshot(g <- graph_from_graphdb(), error = TRUE)
-  expect_snapshot(
-    g <- graph_from_graphdb(nodes = 10, prefix = "not_existing"),
-    error = TRUE
+  expect_snapshot_igraph_error(g <- graph_from_graphdb())
+  expect_snapshot_igraph_error(
+    g <- graph_from_graphdb(nodes = 10, prefix = "not_existing")
   )
-  expect_snapshot(
-    g <- graph_from_graphdb(nodes = 10, type = "not_existing"),
-    error = TRUE
+  expect_snapshot_igraph_error(
+    g <- graph_from_graphdb(nodes = 10, type = "not_existing")
   )
 })

tests/testthat/test-hrg.R

@@ -18,14 +18,14 @@ test_that("as.hclust.igraphHRG() works", {
 })
 
 test_that("sample_hrg() checks its argument", {
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     sample_hrg(make_ring(10))
   })
 })
 
 
 test_that("hrg_tree() checks its argument", {
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     hrg_tree(make_ring(10))
   })
 })

tests/testthat/test-incidence.R

@@ -216,18 +216,18 @@ test_that("graph_from_biadjacency_matrix() errors well", {
   colnames(inc) <- letters[1:5]
   rownames(inc) <- LETTERS[1:3]
 
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     (g <- graph_from_biadjacency_matrix(inc, weight = FALSE))
   })
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     (g <- graph_from_biadjacency_matrix(inc, weight = 42))
   })
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     (g <- graph_from_biadjacency_matrix(inc, multiple = TRUE, weighted = TRUE))
   })
 })
 
 test_that("graph_from_biadjacency_matrix errors for NAs", {
   A <- matrix(c(1, 1, NA, 1), 2, 2)
-  expect_snapshot(graph_from_biadjacency_matrix(A), error = TRUE)
+  expect_snapshot_igraph_error(graph_from_biadjacency_matrix(A))
 })

tests/testthat/test-interface.R

@@ -181,7 +181,7 @@ test_that("ends works", {
 test_that("get.edge.ids() deprecation", {
   g <- make_empty_graph(10)
   expect_snapshot(get.edge.ids(g, 1:2))
-  expect_snapshot(get.edge.ids(g, 1:2, multi = TRUE), error = TRUE)
+  expect_snapshot_igraph_error(get.edge.ids(g, 1:2, multi = TRUE))
 })
 
 test_that("get_edge_id() works with data frame", {
@@ -202,15 +202,15 @@ test_that("get_edge_id() works with matrices", {
 test_that("get_edge_id() errors correctly for wrong vp", {
   g <- make_full_graph(3, directed = FALSE)
   el_g <- make_empty_graph()
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     get_edge_ids(g, el_g)
   })
   expect_error(get_edge_ids(g, NULL))
   expect_error(get_edge_ids(g, NA))
 
   V(g)$name <- letters[1:3]
   df <- data.frame(from = c("a", "b"), to = c(1, 2))
-  expect_snapshot(error = TRUE, {
+  expect_snapshot_igraph_error({
     get_edge_ids(g, df)
   })
 })

tests/testthat/test-iterators.R

@@ -444,6 +444,6 @@ test_that("edge indexes are stored as raw numbers", {
 test_that("logical indices are not recycled", {
   # https://github.com/igraph/rigraph/issues/848
   g <- make_ring(5)
-  expect_snapshot(V(g)[c(TRUE, FALSE)], error = TRUE)
-  expect_snapshot(E(g)[c(TRUE, FALSE)], error = TRUE)
+  expect_snapshot_igraph_error(V(g)[c(TRUE, FALSE)])
+  expect_snapshot_igraph_error(E(g)[c(TRUE, FALSE)])
 })