Skip to content

Silence tests #5507

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 13 commits into from
Dec 6, 2023
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
Loading
Sorry, something went wrong. Reload?
Sorry, we cannot display this file.
Sorry, this file is invalid so it cannot be displayed.
11 changes: 8 additions & 3 deletions tests/testthat/test-fortify.R
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions tests/testthat/test-function-args.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
6 changes: 3 additions & 3 deletions tests/testthat/test-geom-dotplot.R
Original file line number Diff line number Diff line change
Expand Up @@ -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"))
Expand All @@ -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))
})

Expand Down
10 changes: 4 additions & 6 deletions tests/testthat/test-geom-hline-vline-abline.R
Original file line number Diff line number Diff line change
Expand Up @@ -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",
Expand All @@ -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))
Expand Down
2 changes: 1 addition & 1 deletion tests/testthat/test-geom-quantile.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)

Expand Down
10 changes: 6 additions & 4 deletions tests/testthat/test-geom-smooth.R
Original file line number Diff line number Diff line change
Expand Up @@ -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])

Expand Down Expand Up @@ -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`
})
})
19 changes: 13 additions & 6 deletions tests/testthat/test-layer.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)", {
Expand Down Expand Up @@ -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()
)
)
)
})

Expand Down
6 changes: 3 additions & 3 deletions tests/testthat/test-stat-bin.R
Original file line number Diff line number Diff line change
Expand Up @@ -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])

Expand Down Expand Up @@ -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)
Expand Down
6 changes: 4 additions & 2 deletions tests/testthat/test-utilities-checks.R
Original file line number Diff line number Diff line change
Expand Up @@ -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(
Expand Down Expand Up @@ -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")),
Expand Down