Silence tests (tidyverse#5507)

* set dotplot binwidth

* set number of bins

* fill in smooth defaults

* silence coord replacements

* stat_summary2d has been replace by stat_summary_2d

* fill quantile formula

* suppress scale type messages

* suppress sp-related messages

* use explicit tempfiles

* Include snapshot renaming from tidyverse#5504

Author: teunbrand

tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg renamed to tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg

@@ -1,5 +1,8 @@
 test_that("spatial polygons have correct ordering", {
-  skip_if_not_installed("sp")
+  suppressPackageStartupMessages({
+    skip_if_not_installed("sp")
+  })
+
 
   make_square <- function(x = 0, y = 0, height = 1, width = 1){
     delx <- width/2
@@ -30,12 +33,14 @@ test_that("spatial polygons have correct ordering", {
   polys2_sp <- sp::SpatialPolygons(polys2)
   fake_sp2 <- sp::SpatialPolygonsDataFrame(polys2_sp, fake_data)
   lifecycle::expect_deprecated(
-    expected <- fortify(fake_sp2)
+    # supressing: Regions defined for each Polygons
+    expected <- suppressMessages(fortify(fake_sp2))
   )
   expected <- expected[order(expected$id, expected$order), ]
 
   lifecycle::expect_deprecated(
-    actual <- fortify(fake_sp)
+    # supressing: Regions defined for each Polygons
+    actual <- suppressMessages(fortify(fake_sp))
   )
 
   # the levels are different, so these columns need to be converted to character to compare

tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg renamed to tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg

@@ -50,8 +50,8 @@ test_that("stat_xxx and StatXxx$compute_panel arg defaults match", {
     stat_fun_names,
     c("stat_function", "stat_sf")
   )
-  # Remove stat_spoke as it has been deprecated
-  stat_fun_names <- setdiff(stat_fun_names, "stat_spoke")
+  # Remove deprecated stats
+  stat_fun_names <- setdiff(stat_fun_names, c("stat_spoke", "stat_summary2d"))
 
   # For each stat_xxx function and the corresponding StatXxx$compute_panel and
   # StatXxx$compute_group functions, make sure that if they have same args, that

tests/testthat/test-fortify.R

@@ -63,7 +63,7 @@ test_that("NA's result in warning from stat_bindot", {
 
 test_that("when binning on y-axis, limits depend on the panel", {
    p <- ggplot(mtcars, aes(factor(cyl), mpg)) +
-        geom_dotplot(binaxis='y')
+        geom_dotplot(binaxis='y', binwidth = 1/30 * diff(range(mtcars$mpg)))
 
    b1 <- ggplot_build(p + facet_wrap(~am))
    b2 <- ggplot_build(p + facet_wrap(~am, scales = "free_y"))
@@ -77,10 +77,10 @@ test_that("when binning on y-axis, limits depend on the panel", {
 
 test_that("weight aesthetic is checked", {
   p <- ggplot(mtcars, aes(x = mpg, weight = gear/3)) +
-    geom_dotplot()
+    geom_dotplot(binwidth = 1/30 * diff(range(mtcars$mpg)))
   expect_snapshot_warning(ggplot_build(p))
   p <- ggplot(mtcars, aes(x = mpg, weight = -gear)) +
-    geom_dotplot()
+    geom_dotplot(binwidth = 1/30 * diff(range(mtcars$mpg)))
   expect_snapshot_warning(ggplot_build(p))
 })
 

tests/testthat/test-function-args.R

@@ -9,12 +9,11 @@ test_that("check h/v/abline transformed on basic projections", {
     geom_vline(xintercept = 3, colour = "red") +
     geom_hline(yintercept = 3, colour = "blue") +
     geom_abline(intercept = 0, slope = 1, colour = "purple") +
-    labs(x = NULL, y = NULL) +
-    coord_cartesian(expand = FALSE)
+    labs(x = NULL, y = NULL)
 
   expect_doppelganger(
     "cartesian lines intersect mid-bars",
-    plot
+    plot + coord_cartesian(expand = FALSE)
   )
   expect_doppelganger(
     "flipped lines intersect mid-bars",
@@ -34,11 +33,10 @@ test_that("curved lines in map projections", {
   nzmap <- ggplot(nz, aes(long, lat, group = group)) +
     geom_path() +
     geom_hline(yintercept = -38.6) + # roughly Taupo
-    geom_vline(xintercept = 176) +
-    coord_map()
+    geom_vline(xintercept = 176)
 
   expect_doppelganger("straight lines in mercator",
-    nzmap
+    nzmap + coord_map()
   )
   expect_doppelganger("lines curved in azequalarea",
     nzmap + coord_map(projection = 'azequalarea', orientation = c(-36.92, 174.6, 0))

tests/testthat/test-geom-dotplot.R

@@ -13,7 +13,7 @@ test_that("geom_quantile matches quantile regression", {
     y = x^2 + 0.5 * rnorm(10)
   )
 
-  ps <- ggplot(df, aes(x, y)) + geom_quantile()
+  ps <- ggplot(df, aes(x, y)) + geom_quantile(formula = y ~ x)
 
   quants <- c(0.25, 0.5, 0.75)
 

tests/testthat/test-geom-hline-vline-abline.R

@@ -8,11 +8,13 @@ test_that("data is ordered by x", {
 })
 
 test_that("geom_smooth works in both directions", {
-  p <- ggplot(mpg, aes(displ, hwy)) + geom_smooth()
+  p <- ggplot(mpg, aes(displ, hwy)) +
+    geom_smooth(method = 'loess', formula = y ~ x)
   x <- layer_data(p)
   expect_false(x$flipped_aes[1])
 
-  p <- ggplot(mpg, aes(hwy, displ)) + geom_smooth(orientation = "y")
+  p <- ggplot(mpg, aes(hwy, displ)) +
+    geom_smooth(orientation = "y", method = 'loess', formula = y ~ x)
   y <- layer_data(p)
   expect_true(y$flipped_aes[1])
 
@@ -103,11 +105,11 @@ test_that("geom_smooth() works with alternative stats", {
 
   expect_doppelganger("ribbon turned on in geom_smooth", {
     ggplot(df, aes(x, y, color = fill, fill = fill)) +
-      geom_smooth(stat = "summary") # ribbon on by default
+      geom_smooth(stat = "summary", fun.data = mean_se) # ribbon on by default
   })
 
   expect_doppelganger("ribbon turned off in geom_smooth", {
     ggplot(df, aes(x, y, color = fill, fill = fill)) +
-      geom_smooth(stat = "summary", se = FALSE) # ribbon is turned off via `se = FALSE`
+      geom_smooth(stat = "summary", se = FALSE, fun.data = mean_se) # ribbon is turned off via `se = FALSE`
   })
 })

tests/testthat/test-geom-quantile.R

@@ -26,10 +26,13 @@ test_that("unknown aesthetics create warning", {
 })
 
 test_that("invalid aesthetics throws errors", {
-  p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = data))
-  expect_snapshot_error(ggplot_build(p))
-  p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = after_stat(data)))
-  expect_snapshot_error(ggplot_build(p))
+  # We want to test error and ignore the scale search message
+  suppressMessages({
+    p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = data))
+    expect_snapshot_error(ggplot_build(p))
+    p <- ggplot(mtcars) + geom_point(aes(disp, mpg, fill = after_stat(data)))
+    expect_snapshot_error(ggplot_build(p))
+  })
 })
 
 test_that("unknown NULL aesthetic doesn't create warning (#1909)", {
@@ -57,8 +60,12 @@ test_that("missing aesthetics trigger informative error", {
 
 test_that("function aesthetics are wrapped with after_stat()", {
   df <- data_frame(x = 1:10)
-  expect_snapshot_error(
-    ggplot_build(ggplot(df, aes(colour = density, fill = density)) + geom_point())
+  suppressMessages(
+    expect_snapshot_error(
+      ggplot_build(
+        ggplot(df, aes(colour = density, fill = density)) + geom_point()
+      )
+    )
   )
 })
 

tests/testthat/test-geom-smooth.R

@@ -9,11 +9,11 @@ test_that("stat_bin throws error when wrong combination of aesthetic is present"
 })
 
 test_that("stat_bin works in both directions", {
-  p <- ggplot(mpg, aes(hwy)) + stat_bin()
+  p <- ggplot(mpg, aes(hwy)) + stat_bin(bins = 30)
   x <- layer_data(p)
   expect_false(x$flipped_aes[1])
 
-  p <- ggplot(mpg, aes(y = hwy)) + stat_bin()
+  p <- ggplot(mpg, aes(y = hwy)) + stat_bin(bins = 30)
   y <- layer_data(p)
   expect_true(y$flipped_aes[1])
 
@@ -81,7 +81,7 @@ test_that("breaks are transformed by the scale", {
 
 test_that("geom_histogram() can be drawn over a 0-width range (#3043)", {
   df <- data_frame(x = rep(1, 100))
-  out <- layer_data(ggplot(df, aes(x)) + geom_histogram())
+  out <- layer_data(ggplot(df, aes(x)) + geom_histogram(bins = 30))
 
   expect_equal(nrow(out), 1)
   expect_equal(out$xmin, 0.95)

tests/testthat/test-layer.R

@@ -2,7 +2,8 @@
 test_that("check_device checks R versions correctly", {
 
   # Most widely supported device
-  withr::local_pdf()
+  file <- withr::local_tempfile(fileext = ".pdf")
+  withr::local_pdf(file)
 
   # R 4.0.0 doesn't support any new features
   with_mocked_bindings(
@@ -45,7 +46,8 @@ test_that("check_device finds device capabilities", {
     getRversion() < "4.2.0",
     "R version < 4.2.0 does doesn't have proper `dev.capabilities()`."
   )
-  withr::local_pdf()
+  file <- withr::local_tempfile(fileext = ".pdf")
+  withr::local_pdf(file)
   with_mocked_bindings(
     dev.capabilities = function() list(clippingPaths = TRUE),
     expect_true(check_device("clippingPaths")),