replace expect_error() by expect_snapshot(error = TRUE)

teunbrand · teunbrand · commit ae57ec745a85 · 2024-10-21T14:06:04.000+02:00
diff --git a/tests/testthat/test-aes-setting.R b/tests/testthat/test-aes-setting.R
@@ -7,9 +7,9 @@ test_that("aesthetic parameters match length of data", {
   }
 
   set_colours("red")
-  expect_error(set_colours(rep("red", 2)), "must be either length 1")
-  expect_error(set_colours(rep("red", 3)), "must be either length 1")
-  expect_error(set_colours(rep("red", 4)), "must be either length 1")
+  expect_snapshot(set_colours(rep("red", 2)), error = TRUE)
+  expect_snapshot(set_colours(rep("red", 3)), error = TRUE)
+  expect_snapshot(set_colours(rep("red", 4)), error = TRUE)
   set_colours(rep("red", 5))
 })
 
@@ -31,7 +31,7 @@ test_that("legend filters out aesthetics not of length 1", {
 
   # Ideally would test something in the legend data structure, but
   # that's not easily accessible currently.
-  expect_error(ggplot_gtable(ggplot_build(p)), NA)
+  expect_no_error(ggplot_gtable(ggplot_build(p)))
 })
 
 test_that("alpha affects only fill colour of solid geoms", {
diff --git a/tests/testthat/test-aes.R b/tests/testthat/test-aes.R
@@ -49,7 +49,7 @@ test_that("aes evaluated in environment where plot created", {
   p <- ggplot(df, aes(foo, y)) + geom_point()
 
   # Accessing an undefined variable should result in error
-  expect_error(get_layer_data(p), "'foo' not found")
+  expect_snapshot(get_layer_data(p), error = TRUE)
 
   # Once it's defined we should get it back
   foo <- 0
diff --git a/tests/testthat/test-coord-.R b/tests/testthat/test-coord-.R
@@ -47,10 +47,10 @@ test_that("check coord limits errors only on bad inputs", {
   expect_null(check_coord_limits(c(1,2)))
 
   # Should raise error if Scale object is passed
-  expect_error(check_coord_limits(xlim(1,2)))
+  expect_snapshot(check_coord_limits(xlim(1,2)), error = TRUE)
 
   # Should raise error if vector of wrong length is passed
-  expect_error(check_coord_limits(1:3))
+  expect_snapshot(check_coord_limits(1:3), error = TRUE)
 })
 
 test_that("coords append a column to the layout correctly", {
diff --git a/tests/testthat/test-empty-data.R b/tests/testthat/test-empty-data.R
@@ -34,7 +34,7 @@ test_that("layers with empty data are silently omitted with facet_wrap", {
   d <- ggplot(df0, aes(mpg, wt)) +
     geom_point() +
     facet_wrap(~cyl)
-  expect_error(get_layer_data(d), "must have at least one value")
+  expect_snapshot(get_layer_data(d), error = TRUE)
 
   d <- d + geom_point(data = mtcars)
   expect_equal(nrow(get_layer_data(d, 1)), 0)
@@ -45,7 +45,7 @@ test_that("layers with empty data are silently omitted with facet_grid", {
   d <- ggplot(df0, aes(mpg, wt)) +
     geom_point() +
     facet_grid(am ~ cyl)
-  expect_error(get_layer_data(d), "must have at least one value")
+  expect_snapshot(get_layer_data(d), error = TRUE)
 
   d <- d + geom_point(data = mtcars)
   expect_equal(nrow(get_layer_data(d, 1)), 0)
@@ -57,7 +57,7 @@ test_that("empty data overrides plot defaults", {
   d <- ggplot(mtcars, aes(mpg, wt)) +
     geom_point() +
     geom_point(data = data_frame())
-  expect_error(get_layer_data(d), "not found")
+  expect_snapshot(get_layer_data(d), error = TRUE)
 
   # No extra points when x and y vars don't exist but are set
   d <- ggplot(mtcars, aes(mpg, wt)) +
diff --git a/tests/testthat/test-facet-.R b/tests/testthat/test-facet-.R
@@ -43,8 +43,8 @@ test_that("as_facets_list() coerces quosures objectss", {
 })
 
 test_that("facets reject aes()", {
-  expect_error(facet_wrap(aes(foo)), "Please use `vars()` to supply facet variables", fixed = TRUE)
-  expect_error(facet_grid(aes(foo)), "Please use `vars()` to supply facet variables", fixed = TRUE)
+  expect_snapshot(facet_wrap(aes(foo)), error = TRUE)
+  expect_snapshot(facet_grid(aes(foo)), error = TRUE)
 })
 
 test_that("compact_facets() returns a quosures object with compacted", {
@@ -353,9 +353,9 @@ test_that("at least one layer must contain all facet variables in combine_vars()
 
 test_that("at least one combination must exist in combine_vars()", {
   df <- data_frame(letter = character(0))
-  expect_error(
+  expect_snapshot(
     combine_vars(list(df), vars = vars(letter = letter)),
-    "Faceting variables must have at least one value"
+    error = TRUE
   )
 })
 
@@ -463,9 +463,9 @@ test_that("eval_facet() is tolerant for missing columns (#2963)", {
   )
 
   # If the expression contains any non-existent variable, it fails
-  expect_error(
+  expect_snapshot(
     eval_facet(quo(no_such_variable * x), data_frame(foo = 1), possible_columns = c("x")),
-    "object 'no_such_variable' not found"
+    error = TRUE
   )
 })
 
diff --git a/tests/testthat/test-facet-labels.R b/tests/testthat/test-facet-labels.R
@@ -86,7 +86,7 @@ test_that("labeller() dispatches labellers", {
   # facet_wrap() shouldn't get both rows and cols
   p3 <- p + facet_wrap(~cyl, labeller = labeller(
     .cols = label_both, .rows = label_both))
-  expect_error(ggplotGrob(p3))
+  expect_snapshot(ggplotGrob(p3), error = TRUE)
 
   # facet_grid() can get both rows and cols
   p4 <- p + facet_grid(am ~ cyl, labeller = labeller(
@@ -98,7 +98,7 @@ test_that("labeller() dispatches labellers", {
   # margin-wide labeller
   p5 <- p + facet_wrap(~cyl, labeller = labeller(
     .rows = label_both, cyl = label_value))
-  expect_error(ggplotGrob(p5))
+  expect_snapshot(ggplotGrob(p5), error = TRUE)
 
   # Variables can be attributed labellers
   p6 <- p + facet_grid(am + cyl ~ ., labeller = labeller(
diff --git a/tests/testthat/test-fortify.R b/tests/testthat/test-fortify.R
@@ -67,12 +67,12 @@ test_that("fortify.default can handle healthy data-frame-like objects", {
 
   # Not even data-frame-like
 
-  expect_error(fortify(X))
-  expect_error(fortify(array(1:60, 5:3)))
+  expect_snapshot(fortify(X), error = TRUE)
+  expect_snapshot(fortify(array(1:60, 5:3)), error = TRUE)
 
   # Unhealthy data-frame-like (matrix with no colnames)
 
-  expect_error(fortify(cbind(X, Y, Z, deparse.level=0)))
+  expect_snapshot(fortify(cbind(X, Y, Z, deparse.level=0)), error = TRUE)
 
   # Healthy data-frame-like (matrix with colnames)
 
@@ -102,23 +102,23 @@ test_that("fortify.default can handle healthy data-frame-like objects", {
 
   dim.foo <- function(x) stop("oops!")
   registerS3method("dim", "foo", dim.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   dim.foo <- function(x) c(length(x), 2)
   registerS3method("dim", "foo", dim.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   dim.foo <- function(x) 5:2
   registerS3method("dim", "foo", dim.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   dim.foo <- function(x) c(length(x), NA_integer_)
   registerS3method("dim", "foo", dim.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   dim.foo <- function(x) c(length(x), -5L)
   registerS3method("dim", "foo", dim.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   # Repair dim(<foo>)
 
@@ -129,18 +129,18 @@ test_that("fortify.default can handle healthy data-frame-like objects", {
 
   dimnames.foo <- function(x) list()  # this breaks colnames(<foo>)
   registerS3method("dimnames", "foo", dimnames.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   dimnames.foo <- function(x) list(format(seq_along(x)), toupper)
   registerS3method("dimnames", "foo", dimnames.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   # Rejected by fortify.default() because behaviors of dim() and colnames()
   # don't align
 
   dimnames.foo <- function(x) list(NULL, c("X1", "X2", "X3"))
   registerS3method("dimnames", "foo", dimnames.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   # Repair colnames(<foo>)
 
@@ -151,20 +151,21 @@ test_that("fortify.default can handle healthy data-frame-like objects", {
 
   as.data.frame.foo <- function(x, row.names = NULL, ...) stop("oops!")
   registerS3method("as.data.frame", "foo", as.data.frame.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   as.data.frame.foo <- function(x, row.names = NULL, ...) "whatever"
   registerS3method("as.data.frame", "foo", as.data.frame.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 
   as.data.frame.foo <- function(x, row.names = NULL, ...) data.frame()
   registerS3method("as.data.frame", "foo", as.data.frame.foo)
-  expect_error(fortify(object))
+
+  expect_snapshot(fortify(object), error = TRUE)
 
   as.data.frame.foo <- function(x, row.names = NULL, ...) {
     key <- if (is.null(names(x))) rownames(x) else names(x)
     data.frame(oops=key, value=unname(unclass(x)))
   }
   registerS3method("as.data.frame", "foo", as.data.frame.foo)
-  expect_error(fortify(object))
+  expect_snapshot(fortify(object), error = TRUE)
 })
diff --git a/tests/testthat/test-geom-path.R b/tests/testthat/test-geom-path.R
@@ -35,7 +35,7 @@ test_that("stairstep() does not error with too few observations", {
 
 test_that("stairstep() exists with error when an invalid `direction` is given", {
   df <- data_frame(x = 1:3, y = 1:3)
-  expect_error(stairstep(df, direction="invalid"))
+  expect_snapshot(stairstep(df, direction = "invalid"), error = TRUE)
 })
 
 test_that("stairstep() output is correct for direction = 'vh'", {
diff --git a/tests/testthat/test-geom-rect.R b/tests/testthat/test-geom-rect.R
@@ -29,8 +29,5 @@ test_that("geom_rect can derive corners", {
   expect_equal(full[, corners], test[, corners])
 
   test <- full[, c("x", "y")]
-  expect_error(
-    GeomRect$setup_data(test, NULL),
-    "requires two of the following aesthetics"
-  )
+  expect_snapshot(GeomRect$setup_data(test, NULL), error = TRUE)
 })
diff --git a/tests/testthat/test-geom-sf.R b/tests/testthat/test-geom-sf.R
@@ -177,7 +177,7 @@ test_that("geom_sf draws correctly", {
   # Perform minimal tests
   pts <- sf::st_sf(a = 1:2, geometry = sf::st_sfc(sf::st_point(0:1), sf::st_point(1:2)))
   plot <- ggplot() + geom_sf(data = pts)
-  expect_error(regexp = NA, ggplot_build(plot))
+  expect_no_error(ggplot_build(plot))
 
   expect_doppelganger("North Carolina county boundaries",
     ggplot() + geom_sf(data = nc) + coord_sf(datum = 4326)
diff --git a/tests/testthat/test-geom-text.R b/tests/testthat/test-geom-text.R
@@ -30,9 +30,9 @@ test_that("geom_text() accepts mm and pt size units", {
 
 test_that("geom_text() rejects exotic units", {
   p <- ggplot(data_frame0(x = 1, y = 1, label = "A"), aes(x, y, label = label))
-  expect_error(
+  expect_snapshot(
     ggplotGrob(p + geom_text(size = 10, size.unit = "npc")),
-    "must be one of"
+    error = TRUE
   )
 })
 
diff --git a/tests/testthat/test-ggsave.R b/tests/testthat/test-ggsave.R
@@ -16,7 +16,7 @@ test_that("ggsave can create directories", {
 
   p <- ggplot(mpg, aes(displ, hwy)) + geom_point()
 
-  expect_error(ggsave(path, p))
+  expect_snapshot(ggsave(path, p), error = TRUE)
   expect_false(dir.exists(dirname(path)))
 
   # 2 messages: 1 for saving and 1 informing about directory creation
@@ -83,18 +83,12 @@ test_that("ggsave warns about empty or multiple filenames", {
     )
   })
 
-  expect_error(
-    ggsave(character(), plot),
-    "`filename` must be a single string"
-  )
+  expect_snapshot(ggsave(character(), plot), error = TRUE)
 })
 
 test_that("ggsave fails informatively for no-extension filenames", {
   plot <- ggplot(mtcars, aes(disp, mpg)) + geom_point()
-  expect_error(
-    ggsave(tempfile(), plot),
-    "Can't save to"
-  )
+  expect_snapshot(ggsave(tempfile(), plot), error = TRUE)
 })
 
 # plot_dim ---------------------------------------------------------------
@@ -112,9 +106,9 @@ test_that("uses 7x7 if no graphics device open", {
 })
 
 test_that("warned about large plot unless limitsize = FALSE", {
-  expect_error(plot_dim(c(50, 50)), "exceed 50 inches")
+  expect_snapshot(plot_dim(c(50, 50)), error = TRUE)
   expect_equal(plot_dim(c(50, 50), limitsize = FALSE), c(50, 50))
-  expect_error(plot_dim(c(15000, 15000), units = "px"), "in pixels).")
+  expect_snapshot(plot_dim(c(15000, 15000), units = "px"), error = TRUE)
 })
 
 test_that("scale multiplies height & width", {
@@ -126,8 +120,8 @@ test_that("scale multiplies height & width", {
 
 test_that("unknown device triggers error", {
   expect_snapshot_error(plot_dev(1))
-  expect_error(plot_dev("xyz"), "Unknown graphics device")
-  expect_error(plot_dev(NULL, "test.xyz"), "Unknown graphics device")
+  expect_snapshot(plot_dev("xyz"), error = TRUE)
+  expect_snapshot(plot_dev(NULL, "test.xyz"), error = TRUE)
 })
 
 
diff --git a/tests/testthat/test-guides.R b/tests/testthat/test-guides.R
@@ -381,8 +381,8 @@ test_that("get_guide_data retrieves keys appropriately", {
   # Non-existent panels
   expect_null(get_guide_data(b, "x", panel = 4))
 
-  expect_error(get_guide_data(b, 1), "must be a single string")
-  expect_error(get_guide_data(b, "x", panel = "a"), "must be a whole number")
+  expect_snapshot(get_guide_data(b, 1), error = TRUE)
+  expect_snapshot(get_guide_data(b, "x", panel = "a"), error = TRUE)
 })
 
 test_that("get_guide_data retrieves keys from exotic coords", {
diff --git a/tests/testthat/test-labels.R b/tests/testthat/test-labels.R
@@ -116,13 +116,13 @@ test_that("plot.tag.position rejects invalid input", {
   expect_snapshot_error(
     ggplotGrob(p + theme(plot.tag.position = "foobar"))
   )
-  expect_error(
+  expect_snapshot(
     ggplotGrob(p + theme(plot.tag.position = c(0, 0.5, 1))),
-    "must have length 2"
+    error = TRUE
   )
-  expect_error(
+  expect_snapshot(
     ggplotGrob(p + theme(plot.tag.position = c(0, 0), plot.tag.location = "margin")),
-    "cannot be used with `\"margin\""
+    error = TRUE
   )
 
 })
diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R
@@ -55,13 +55,13 @@ test_that("column vectors are allowed (#2609)", {
 
 test_that("missing aesthetics trigger informative error", {
   df <- data_frame(x = 1:10)
-  expect_error(
+  expect_snapshot(
     ggplot_build(ggplot(df) + geom_line()),
-    "requires the following missing aesthetics:"
+    error = TRUE
   )
-  expect_error(
+  expect_snapshot(
     ggplot_build(ggplot(df) + geom_col()),
-    "requires the following missing aesthetics:"
+    error = TRUE
   )
 })
 
@@ -154,10 +154,7 @@ test_that("layer names can be resolved", {
   expect_equal(names(p$layers), c("foo", "bar"))
 
   l <- geom_point(name = "foobar")
-  expect_error(
-    p + l + l,
-    "names are duplicated"
-  )
+  expect_snapshot(p + l + l, error = TRUE)
 })
 
 
diff --git a/tests/testthat/test-performance.R b/tests/testthat/test-performance.R
@@ -12,7 +12,7 @@ testappend <- list(
 )
 
 test_that("modifyList is masked", {
-  expect_error(modifyList(testlist, testappend))
+  expect_snapshot(modifyList(testlist, testappend), error = TRUE)
 })
 
 test_that("modify_list retains unreferenced elements", {
diff --git a/tests/testthat/test-position_dodge.R b/tests/testthat/test-position_dodge.R
@@ -51,5 +51,5 @@ test_that("position_dodge warns about missing required aesthetics", {
       mapping = aes(x = NULL)
     )
 
-  expect_error(ggplot_build(p), "requires the following missing aesthetics")
+  expect_snapshot(ggplot_build(p), error = TRUE)
 })
diff --git a/tests/testthat/test-qplot.R b/tests/testthat/test-qplot.R
@@ -46,7 +46,7 @@ test_that("qplot() evaluates layers in package environment", {
   }
 
   lifecycle::expect_deprecated(
-    expect_error(p <- qplot(1, 1, geom = "line"), NA)
+    expect_no_error(p <- qplot(1, 1, geom = "line"))
   )
 })
 
diff --git a/tests/testthat/test-scale-discrete.R b/tests/testthat/test-scale-discrete.R
diff --git a/tests/testthat/test-scale-manual.R b/tests/testthat/test-scale-manual.R
diff --git a/tests/testthat/test-scales-breaks-labels.R b/tests/testthat/test-scales-breaks-labels.R
diff --git a/tests/testthat/test-stat-bin.R b/tests/testthat/test-stat-bin.R
diff --git a/tests/testthat/test-stat-ecdf.R b/tests/testthat/test-stat-ecdf.R
diff --git a/tests/testthat/test-stats.R b/tests/testthat/test-stats.R
diff --git a/tests/testthat/test-theme.R b/tests/testthat/test-theme.R
