diff --git a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg similarity index 97% rename from tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg rename to tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg index 49346a1c5e..1fef513fa1 100644 --- a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-m-d.svg +++ b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-m-d.svg @@ -51,6 +51,6 @@ 06/01 dx price -scale_x_date(labels = date_format("%m/%d")) +scale_x_date(labels = label_date("%m/%d")) diff --git a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg similarity index 97% rename from tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg rename to tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg index fa832b94e5..1748ed74f5 100644 --- a/tests/testthat/_snaps/scale_date/scale-x-date-labels-date-format-w-week.svg +++ b/tests/testthat/_snaps/scale_date/scale-x-date-labels-label-date-w-week.svg @@ -51,6 +51,6 @@ 22 week price -scale_x_date(labels = date_format("%W"), "week") +scale_x_date(labels = label_date("%W"), "week") diff --git a/tests/testthat/test-fortify.R b/tests/testthat/test-fortify.R index 43b7adb74c..03980c19c1 100644 --- a/tests/testthat/test-fortify.R +++ b/tests/testthat/test-fortify.R @@ -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 diff --git a/tests/testthat/test-function-args.R b/tests/testthat/test-function-args.R index 6be2567689..2a78bf9f50 100644 --- a/tests/testthat/test-function-args.R +++ b/tests/testthat/test-function-args.R @@ -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 diff --git a/tests/testthat/test-geom-dotplot.R b/tests/testthat/test-geom-dotplot.R index a095158937..69b7d65a75 100644 --- a/tests/testthat/test-geom-dotplot.R +++ b/tests/testthat/test-geom-dotplot.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)) }) diff --git a/tests/testthat/test-geom-hline-vline-abline.R b/tests/testthat/test-geom-hline-vline-abline.R index 61510a3c7c..b637cd0a2f 100644 --- a/tests/testthat/test-geom-hline-vline-abline.R +++ b/tests/testthat/test-geom-hline-vline-abline.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)) diff --git a/tests/testthat/test-geom-quantile.R b/tests/testthat/test-geom-quantile.R index 710f88436d..d9eaf84184 100644 --- a/tests/testthat/test-geom-quantile.R +++ b/tests/testthat/test-geom-quantile.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) diff --git a/tests/testthat/test-geom-smooth.R b/tests/testthat/test-geom-smooth.R index ca57bd2e38..e71df88485 100644 --- a/tests/testthat/test-geom-smooth.R +++ b/tests/testthat/test-geom-smooth.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` }) }) diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R index 58ae5051bd..b0507cf7ae 100644 --- a/tests/testthat/test-layer.R +++ b/tests/testthat/test-layer.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() + ) + ) ) }) diff --git a/tests/testthat/test-stat-bin.R b/tests/testthat/test-stat-bin.R index 24aa21ec6a..d15a19fcff 100644 --- a/tests/testthat/test-stat-bin.R +++ b/tests/testthat/test-stat-bin.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) diff --git a/tests/testthat/test-utilities-checks.R b/tests/testthat/test-utilities-checks.R index 04dbd79f52..0619ccc707 100644 --- a/tests/testthat/test-utilities-checks.R +++ b/tests/testthat/test-utilities-checks.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")),